readline-1.0.3.0: System/Console/Readline.hsc
{-# LANGUAGE ForeignFunctionInterface #-}
-----------------------------------------------------------------------------
-- |
-- Module : System.Console.Readline
-- Copyright : (c) unknown
-- License : GPL (depends on libreadline, which is GPL)
--
-- Maintainer : libraries@haskell.org
-- Stability : provisional
-- Portability : non-portable (requires libreadline)
--
-- A Haskell binding to the GNU readline library. The GNU Readline
-- library provides a set of functions for use by applications that
-- allow users to edit command lines as they are typed in. By
-- default, the line editing commands are similar to those of
-- emacs. A vi-style line editing interface is also available.
--
-- An example of a typical use of readline with history functionality
-- is illustrated in the following read, eval, print loop:
--
-- @
-- readEvalPrintLoop :: IO ()
-- readEvalPrintLoop = do
-- maybeLine <- readline \"% \"
-- case maybeLine of
-- Nothing -> return () -- EOF \/ control-d
-- Just \"exit\" -> return ()
-- Just line -> do addHistory line
-- putStrLn $ \"The user input: \" ++ (show line)
-- readEvalPrintLoop
-- @
--
-----------------------------------------------------------------------------
#include "HsReadline.h"
#include "HsReadlineConfig.h"
module System.Console.Readline (
--------------------------------------------------------------------
-- Basic Behavior.
readline, -- :: String -> IO (Maybe String)
addHistory, -- :: String -> IO ()
--------------------------------------------------------------------
-- Readline Variables.
getLineBuffer, -- :: IO String
#if HAVE_READLINE_4
setLineBuffer, -- :: String -> IO ()
#endif
-- Functions involving point positions are meaningful only when string
-- conversion between Haskell and C preserves the length.
getPoint, -- :: IO Int
setPoint, -- :: Int -> IO ()
getEnd, -- :: IO Int
setEnd, -- :: Int -> IO ()
getMark, -- :: IO Int
setMark, -- :: Int -> IO ()
setDone, -- :: Bool -> IO ()
setPendingInput, -- :: Char -> IO ()
#if HAVE_READLINE_4
setEraseEmptyLine, -- :: Bool -> IO ()
#endif
getPrompt, -- :: IO String
#if HAVE_READLINE_4
setAlreadyPrompted, -- :: Bool -> IO ()
#endif
getLibraryVersion, -- :: IO String
getTerminalName, -- :: IO String
setReadlineName, -- :: String -> IO ()
getInStream, -- :: IO Handle
getOutStream, -- :: IO Handle
setStartupHook, -- :: Maybe (IO ()) -> IO ()
#if HAVE_READLINE_4
setPreInputHook, -- :: Maybe (IO ()) -> IO ()
#endif
setEventHook, -- :: Maybe (IO ()) -> IO ()
-- rl_getc_function wrapper is not provided because it uses FILE *
-- and it would be too expensive to convert FILE * to Handle
-- for each character.
setRedisplayFunction, -- :: Maybe (IO ()) -> IO ()
-- Nothing means the original: rl_redisplay.
--------------------------------------------------------------------
-- Selecting a Keymap.
-- Keymaps are not garbage collected. They must be explicitly freed
-- using freeKeymap.
Keymap, -- data Keymap
newBareKeymap, -- :: IO Keymap
copyKeymap, -- :: Keymap -> IO Keymap
newKeymap, -- :: IO Keymap
freeKeymap, -- :: Keymap -> IO ()
getKeymap, -- :: IO Keymap
setKeymap, -- :: Keymap -> IO ()
getKeymapByName, -- :: String -> IO Keymap
getKeymapName, -- :: Keymap -> IO (Maybe String)
getExecutingKeymap, -- :: IO Keymap
getBindingKeymap, -- :: IO Keymap
--------------------------------------------------------------------
-- Binding Keys.
Callback, -- type Callback = Int -> Char -> IO Int
addDefun, -- :: String -> Callback -> Maybe Char -> IO ()
bindKey, -- :: Char -> Callback -> IO ()
bindKeyInMap, -- :: Char -> Callback -> Keymap -> IO ()
unbindKey, -- :: Char -> IO ()
unbindKeyInMap, -- :: Char -> Keymap -> IO ()
-- rl_unbind_function_in_map is not provided because Haskell functions
-- have no identity.
unbindCommandInMap, -- :: String -> Keymap -> IO ()
Entry(..), -- data Entry
-- = Function Callback
-- | Macro String
-- | Keymap Keymap
genericBind, -- :: String -> Entry -> Keymap -> IO ()
parseAndBind, -- :: String -> IO ()
readInitFile, -- :: String -> IO ()
--------------------------------------------------------------------
-- Associating Function Names and Bindings.
namedFunction, -- :: String -> IO (Maybe Callback)
functionOfKeyseq, -- :: String -> Maybe Keymap -> IO Entry
-- rl_invoking_keyseqs and rl_invoking_keyseqs_in_map are not provided
-- because Haskell functions have no identity.
functionDumper, -- :: Bool -> IO ()
listFunmapNames, -- :: IO ()
#if HAVE_READLINE_4
funmapNames, -- :: IO [String]
#endif
--------------------------------------------------------------------
-- Allowing Undoing.
beginUndoGroup, endUndoGroup, -- :: IO ()
UndoCode(..), -- data UndoCode
-- = UndoDelete
-- | UndoInsert
-- | UndoBegin
-- | UndoEnd
addUndo, -- :: UndoCode -> Int -> Int -> String -> IO ()
freeUndoList, -- :: IO ()
doUndo, -- :: IO Bool
modifying, -- :: Int -> Int -> IO ()
--------------------------------------------------------------------
-- Redisplay.
redisplay, -- :: IO ()
forcedUpdateDisplay, -- :: IO ()
onNewLine, -- :: IO ()
#if HAVE_READLINE_4
onNewLineWithPrompt, -- :: IO ()
#endif
resetLineState, -- :: IO ()
message, -- :: String -> IO ()
clearMessage, -- :: IO ()
#if HAVE_READLINE_4
savePrompt, -- :: IO ()
restorePrompt, -- :: IO ()
#endif
--------------------------------------------------------------------
-- Modifying Text.
insertText, -- :: String -> IO ()
deleteText, -- :: Int -> Int -> IO ()
copyText, -- :: Int -> Int -> IO String
killText, -- :: Int -> Int -> IO ()
--------------------------------------------------------------------
-- Utility functions.
readKey, -- :: IO Char
stuffChar, -- :: Char -> IO Bool
initialize, -- :: IO ()
resetTerminal, -- :: Maybe String -> IO ()
ding, -- :: IO Bool
#if HAVE_READLINE_4
displayMatchList, -- :: [String] -> IO ()
#endif
--------------------------------------------------------------------
-- Alternate Interface.
callbackHandlerInstall, -- :: String -> (String -> IO ()) -> IO (IO ())
-- Returns the cleanup action.
callbackReadChar, -- :: IO ()
--------------------------------------------------------------------
-- Readline Signal Handling.
#if HAVE_READLINE_4
setCatchSignals, -- :: Bool -> IO ()
getCatchSignals, -- :: IO Bool
setCatchSigwinch, -- :: Bool -> IO ()
getCatchSigwinch, -- :: IO Bool
cleanupAfterSignal, -- :: IO ()
freeLineState, -- :: IO ()
resetAfterSignal, -- :: IO ()
resizeTerminal, -- :: IO ()
#endif
setSignals, -- :: IO ()
clearSignals, -- :: IO ()
--------------------------------------------------------------------
-- Completion functions.
completeInternal, -- :: Char -> IO ()
complete, -- :: Int -> Char -> IO Int
possibleCompletions, -- :: Int -> Char -> IO Int
insertCompletions, -- :: Int -> Char -> IO Int
-- readline uses functions that are called multiple times and
-- return an entry at a time, maintaining their state at which
-- point they are. This is silly in a functional language so here
-- we work with functions String -> IO [String].
completionMatches,
-- :: String -> (String -> IO [String]) -> IO (Maybe (String, [String]))
filenameCompletionFunction, -- :: String -> IO [String]
usernameCompletionFunction, -- :: String -> IO [String]
setCompletionEntryFunction,
-- :: Maybe (String -> IO [String]) -> IO ()
setAttemptedCompletionFunction,
-- :: Maybe (String -> Int -> Int -> IO (Maybe (String, [String]))) -> IO ()
setFilenameQuotingFunction,
-- :: Maybe (String -> Bool -> Ptr CChar -> IO String) -> IO ()
quoteFilename,
-- :: String -> Bool -> Ptr CChar -> IO String
setFilenameDequotingFunction,
-- :: Maybe (String -> Maybe Char -> IO String) -> IO ()
setCharIsQuotedP,
-- :: Maybe (String -> Int -> IO Bool) -> IO ()
getCompletionQueryItems, -- :: IO Int
setCompletionQueryItems, -- :: Int -> IO ()
getBasicWordBreakCharacters, -- :: IO String
setBasicWordBreakCharacters, -- :: String -> IO ()
getBasicQuoteCharacters, -- :: IO String
setBasicQuoteCharacters, -- :: String -> IO ()
getCompleterWordBreakCharacters, -- :: IO String
setCompleterWordBreakCharacters, -- :: String -> IO ()
getCompleterQuoteCharacters, -- :: IO String
setCompleterQuoteCharacters, -- :: String -> IO ()
getFilenameQuoteCharacters, -- :: IO String
setFilenameQuoteCharacters, -- :: String -> IO ()
getSpecialPrefixes, -- :: IO String
setSpecialPrefixes, -- :: String -> IO ()
getCompletionAppendCharacter, -- :: IO (Maybe Char)
setCompletionAppendCharacter, -- :: Maybe Char -> IO ()
setIgnoreCompletionDuplicates, -- :: Bool -> IO ()
getIgnoreCompletionDuplicates, -- :: IO Bool
setFilenameCompletionDesired, -- :: Bool -> IO ()
getFilenameCompletionDesired, -- :: IO Bool
setFilenameQuotingDesired, -- :: Bool -> IO ()
getFilenameQuotingDesired, -- :: IO Bool
setInhibitCompletion, -- :: Bool -> IO ()
getInhibitCompletion, -- :: IO Bool
setAttemptedCompletionOver, -- :: Bool -> IO ()
getAttemptedCompletionOver, -- :: IO Bool
setIgnoreSomeCompletionsFunction,
-- :: Maybe ([String] -> IO [String]) -> IO ()
-- The function may not make the list longer!
setDirectoryCompletionHook
-- :: Maybe (String -> IO String) -> IO ()
#if HAVE_READLINE_5
,
setCompletionWordBreakHook
-- :: Maybe (IO (Maybe String)) -> IO ()
#endif
#if HAVE_READLINE_4
,
setCompletionDisplayMatchesHook
-- :: Maybe ([String] -> IO ()) -> IO ()
#endif
)
where
------------------------------------------------------------------------
import Control.Monad ( liftM, when, unless )
import Data.Char ( chr, ord )
import Data.Maybe ( fromMaybe )
import System.IO ( Handle )
import System.IO.Unsafe ( unsafePerformIO )
import Data.IORef ( newIORef, readIORef, writeIORef )
import Foreign.Ptr ( Ptr, nullPtr, castPtr, castFunPtrToPtr,
FunPtr, nullFunPtr, freeHaskellFunPtr )
import Foreign.Storable ( Storable(..) )
import Foreign.Marshal.Utils ( maybePeek, maybeWith, withMany )
import Foreign.Marshal.Alloc ( alloca, free )
import Foreign.Marshal.Array ( mallocArray, peekArray0, pokeArray0, withArray0 )
import Foreign.C.Types ( CChar, CFile )
import Foreign.C.String ( newCString, peekCString, withCString,
castCharToCChar, castCCharToChar )
import GHC.IO.Handle.FD ( fdToHandle )
#if (__GLASGOW_HASKELL__>=705)
import Foreign.C.Types(CInt(..))
#else
import Foreign.C.Types(CInt)
#endif
{-# CFILES HsReadline_cbits.c #-}
------------------------------------------------------------------------
-- Basic Behavior.
-- | readline is similar to 'System.IO.getLine', but with rich edit
-- functionality and history capability. readline will read a line
-- from the terminal and return it, using /prompt/ as a prompt. If
-- prompt is the empty string, no prompt is issued. The line returned
-- has the final newline removed, so only the text of the line
-- remains. A blank line returns the empty string. If EOF is
-- encountered while reading a line, and the line is empty, Nothing is
-- returned. If an EOF is read with a non-empty line, it is treated
-- as a newline.
readline :: String-- ^prompt
-> IO (Maybe String) -- ^returns the line the user input, or Nothing if EOF is encountered.
readline prompt = do
ptr <- withCString prompt readlineC
flip maybePeek ptr $ \ptr' -> do
line <- peekCString ptr'
free ptr'
return line
foreign import ccall "readline" readlineC :: Ptr CChar -> IO (Ptr CChar)
-- |Add this command to the history. This allows users to search backward
-- through history with C-r and step through with up and down arrows, among
-- other things.
addHistory :: String -> IO ()
addHistory line = withCString line add_history
foreign import ccall unsafe add_history :: Ptr CChar -> IO ()
------------------------------------------------------------------------
-- Readline Variables.
getLineBuffer :: IO String
getLineBuffer = peek rl_line_buffer >>= peekCString
#if HAVE_READLINE_4
setLineBuffer :: String -> IO ()
setLineBuffer line = do
-- TODO: Fix the next line when text conversions are available!
let lineC = map castCharToCChar line
rl_extend_line_buffer (fromIntegral (length lineC))
ptr <- peek rl_line_buffer
pokeArray0 0 (castPtr ptr) lineC
#endif
foreign import ccall "&"
rl_line_buffer :: Ptr (Ptr CChar)
#if HAVE_READLINE_4
-- The readline docs claim that rl_extend_line_buffer returns CInt,
-- but the header and source both say that it returns void.
foreign import ccall unsafe rl_extend_line_buffer :: CInt -> IO ()
#endif
-- Functions involving point positions are meaningful only when string
-- conversion between Haskell and C preserves the length.
getPoint :: IO Int
getPoint = liftM fromIntegral (peek rl_point)
setPoint :: Int -> IO ()
setPoint p = poke rl_point (fromIntegral p)
foreign import ccall "&" rl_point :: Ptr CInt
getEnd :: IO Int
getEnd = liftM fromIntegral (peek rl_end)
setEnd :: Int -> IO ()
setEnd p = poke rl_end (fromIntegral p)
foreign import ccall "&" rl_end :: Ptr CInt
getMark :: IO Int
getMark = liftM fromIntegral (peek rl_mark)
setMark :: Int -> IO ()
setMark p = poke rl_mark (fromIntegral p)
foreign import ccall "&" rl_mark :: Ptr CInt
setDone :: Bool -> IO ()
setDone done = poke rl_done (if done then 1 else 0)
foreign import ccall "&" rl_done :: Ptr CInt
setPendingInput :: Char -> IO ()
setPendingInput key = poke rl_pending_input (fromIntegral (ord key))
foreign import ccall "&" rl_pending_input :: Ptr CInt
#if HAVE_READLINE_4
setEraseEmptyLine :: Bool -> IO ()
setEraseEmptyLine erase = poke rl_erase_empty_line (if erase then 1 else 0)
foreign import ccall "&" rl_erase_empty_line :: Ptr CInt
#endif
getPrompt :: IO String
getPrompt = peek rl_prompt >>= peekCString
foreign import ccall "&" rl_prompt :: Ptr (Ptr CChar)
#if HAVE_READLINE_4
setAlreadyPrompted :: Bool -> IO ()
setAlreadyPrompted pr = poke rl_already_prompted (if pr then 1 else 0)
foreign import ccall "&" rl_already_prompted :: Ptr CInt
#endif
getLibraryVersion :: IO String
getLibraryVersion = peek rl_library_version >>= peekCString
foreign import ccall "&" rl_library_version :: Ptr (Ptr CChar)
getTerminalName :: IO String
getTerminalName = peek rl_terminal_name >>= peekCString
foreign import ccall "&" rl_terminal_name :: Ptr (Ptr CChar)
setReadlineName :: String -> IO ()
setReadlineName name = newCString name >>= poke rl_readline_name
-- The memory for name will never be freed. Otherwise we would
-- have to recognize the original value which is a static string
-- literal. This function is usually called only once anyway.
foreign import ccall "&" rl_readline_name :: Ptr (Ptr CChar)
getInStream :: IO Handle
getInStream = peek rl_instream >>= hs_fileno >>= fdToHandle . fromIntegral
foreign import ccall "&" rl_instream :: Ptr (Ptr CFile)
getOutStream :: IO Handle
getOutStream = peek rl_outstream >>= hs_fileno >>= fdToHandle . fromIntegral
foreign import ccall "&" rl_outstream :: Ptr (Ptr CFile)
foreign import ccall unsafe "__hscore_hs_fileno"
hs_fileno :: Ptr CFile -> IO CInt
setStartupHook :: Maybe (IO ()) -> IO ()
setStartupHook hook = setFunPtr rl_startup_hook hook exportHookInt
foreign import ccall "&" rl_startup_hook :: Ptr (FunPtr (IO CInt))
#if HAVE_READLINE_4
setPreInputHook :: Maybe (IO ()) -> IO ()
setPreInputHook hook = setFunPtr rl_pre_input_hook hook exportHookInt
foreign import ccall "&" rl_pre_input_hook :: Ptr (FunPtr (IO CInt))
#endif
setEventHook :: Maybe (IO ()) -> IO ()
setEventHook hook = setFunPtr rl_event_hook hook exportHookInt
foreign import ccall "&" rl_event_hook :: Ptr (FunPtr (IO CInt))
-- rl_getc_function wrapper is not provided because it uses FILE *
-- and it would be too expensive to convert FILE * to Handle
-- for each character.
setRedisplayFunction :: Maybe (IO ()) -> IO ()
-- Nothing means the original: rl_redisplay.
setRedisplayFunction fun = do
oldPtr <- peek rl_redisplay_function
when (oldPtr /= nullFunPtr && oldPtr /= rl_redisplay) $
freeHaskellFunPtr oldPtr
newPtr <- case fun of
Nothing -> return rl_redisplay
Just f -> exportHookVoid f
poke rl_redisplay_function newPtr
foreign import ccall "&" rl_redisplay_function :: Ptr (FunPtr (IO ()))
foreign import ccall "&" rl_redisplay :: FunPtr (IO ())
-- rl_redisplay_function can never be NULL.
exportHookInt :: IO () -> IO (FunPtr (IO CInt))
exportHookInt hook = exportHookIntC (hook >> return 0)
foreign import ccall "wrapper"
exportHookIntC :: IO CInt -> IO (FunPtr (IO CInt))
foreign import ccall "wrapper"
exportHookVoid :: IO () -> IO (FunPtr (IO ()))
setFunPtr_freeIf :: (FunPtr a -> Bool)
-> Ptr (FunPtr a)
-> Maybe b
-> (b -> IO (FunPtr a))
-> IO ()
setFunPtr_freeIf pred variable newFun makeNewFun = do
oldPtr <- peek variable
when (pred oldPtr) $ freeHaskellFunPtr oldPtr
newPtr <- case newFun of
Nothing -> return nullFunPtr
Just f -> makeNewFun f
poke variable newPtr
setFunPtr :: Ptr (FunPtr a)
-> Maybe b
-> (b -> IO (FunPtr a))
-> IO ()
setFunPtr = setFunPtr_freeIf (/= nullFunPtr)
------------------------------------------------------------------------
-- Selecting a Keymap.
-- Keymaps are not garbage collected. They must be explicitly freed
-- using freeKeymap.
data KeymapTag = KeymapTag
newtype Keymap = MkKeymap (Ptr KeymapTag)
foreign import ccall unsafe "rl_make_bare_keymap" newBareKeymap :: IO Keymap
foreign import ccall unsafe "rl_copy_keymap" copyKeymap :: Keymap -> IO Keymap
foreign import ccall unsafe "rl_make_keymap" newKeymap :: IO Keymap
freeKeymap :: Keymap -> IO ()
freeKeymap k@(MkKeymap km) = do
rl_discard_keymap k
free km
foreign import ccall unsafe "rl_discard_keymap"
rl_discard_keymap :: Keymap -> IO ()
foreign import ccall unsafe "rl_get_keymap"
getKeymap :: IO Keymap
foreign import ccall unsafe "rl_set_keymap"
setKeymap :: Keymap -> IO ()
getKeymapByName :: String -> IO Keymap
getKeymapByName name = withCString name rl_get_keymap_by_name
foreign import ccall unsafe
rl_get_keymap_by_name :: Ptr CChar -> IO Keymap
getKeymapName :: Keymap -> IO (Maybe String)
getKeymapName km = do
ptr <- rl_get_keymap_name km
maybePeek peekCString ptr
foreign import ccall unsafe "rl_get_keymap_name"
rl_get_keymap_name :: Keymap -> IO (Ptr CChar)
getExecutingKeymap :: IO Keymap
getExecutingKeymap = liftM MkKeymap $ peek rl_executing_keymap
foreign import ccall "&" rl_executing_keymap :: Ptr (Ptr KeymapTag)
getBindingKeymap :: IO Keymap
getBindingKeymap = liftM MkKeymap $ peek rl_binding_keymap
foreign import ccall "&" rl_binding_keymap :: Ptr (Ptr KeymapTag)
------------------------------------------------------------------------
-- Binding Keys.
type Callback = Int -> Char -> IO Int
type CallbackC = CInt -> CInt -> IO CInt
addDefun :: String -> Callback -> Maybe Char -> IO ()
addDefun name cb key = do
namePtr <- newCString name
-- rl_add_defun does *not* make a copy of the function name.
cbPtr <- exportCallback cb
-- The memory will never be freed. But readline does not provide
-- removing defuns anyway.
rl_add_defun namePtr cbPtr (maybe (-1) (fromIntegral . ord) key)
return ()
foreign import ccall unsafe "rl_add_defun"
rl_add_defun :: Ptr CChar -> FunPtr CallbackC -> CInt -> IO CInt
bindKey :: Char -> Callback -> IO ()
bindKey key cb = do
cbPtr <- exportCallback cb
-- The memory will never be freed. We should provide a way to
-- free it, but it's complicated because of multiple keymaps.
-- It should probably be done explicitly.
rl_bind_key (fromIntegral (ord key)) cbPtr
return ()
foreign import ccall unsafe "rl_bind_key"
rl_bind_key :: CInt -> FunPtr CallbackC -> IO CInt
bindKeyInMap :: Char -> Callback -> Keymap -> IO ()
bindKeyInMap key cb km = do
cbPtr <- exportCallback cb
rl_bind_key_in_map (fromIntegral (ord key)) cbPtr km
return ()
foreign import ccall unsafe "rl_bind_key_in_map"
rl_bind_key_in_map :: CInt -> FunPtr CallbackC -> Keymap -> IO CInt
unbindKey :: Char -> IO ()
unbindKey key = do
rl_unbind_key (fromIntegral (ord key))
return ()
foreign import ccall unsafe rl_unbind_key :: CInt -> IO CInt
unbindKeyInMap :: Char -> Keymap -> IO ()
unbindKeyInMap key km = do
rl_unbind_key_in_map (fromIntegral (ord key)) km
return ()
foreign import ccall unsafe "rl_unbind_key_in_map"
rl_unbind_key_in_map :: CInt -> Keymap -> IO CInt
-- rl_unbind_function_in_map is not provided because Haskell functions
-- have no identity.
unbindCommandInMap :: String -> Keymap -> IO ()
unbindCommandInMap comm km = do
withCString comm $ \commPtr -> rl_unbind_command_in_map commPtr km
return ()
foreign import ccall unsafe "rl_unbind_command_in_map"
rl_unbind_command_in_map :: Ptr CChar -> Keymap -> IO CInt
data Entry
= Function Callback
| Macro String
| Keymap Keymap
genericBind :: String -> Entry -> Keymap -> IO ()
genericBind keys (Function cb) km = do
cbPtr <- exportCallback cb
genericBind' (#const ISFUNC) keys (castFunPtrToPtr cbPtr) km
genericBind keys (Macro s) km =
withCString s $ \ptr -> genericBind' (#const ISMACR) keys ptr km
genericBind keys (Keymap (MkKeymap km')) km =
genericBind' (#const ISKMAP) keys (castPtr km') km
genericBind' :: CInt -> String -> Ptr CChar -> Keymap -> IO ()
genericBind' typ keys dat km = do
withCString keys $ \keysPtr -> rl_generic_bind typ keysPtr dat km
return ()
foreign import ccall unsafe "rl_generic_bind"
rl_generic_bind :: CInt -> Ptr CChar -> Ptr CChar -> Keymap -> IO CInt
parseAndBind :: String -> IO ()
parseAndBind s = do
ok <- withCString s rl_parse_and_bind
unless (ok == 0) $ ioError (userError "Parse error")
foreign import ccall unsafe "rl_parse_and_bind"
rl_parse_and_bind :: Ptr CChar -> IO CInt
readInitFile :: String -> IO ()
readInitFile name = do
ok <- withCString name rl_read_init_file
unless (ok == 0) $ ioError (userError "Can't read file")
foreign import ccall unsafe "rl_read_init_file"
rl_read_init_file :: Ptr CChar -> IO CInt
------------------------------------------------------------------------
-- Associating Function Names and Bindings.
namedFunction :: String -> IO (Maybe Callback)
namedFunction name = do
ptr <- withCString name rl_named_function
return $ if ptr == nullFunPtr then Nothing else Just (importCallback ptr)
foreign import ccall unsafe "rl_named_function"
rl_named_function :: Ptr CChar -> IO (FunPtr CallbackC)
functionOfKeyseq :: String -> Maybe Keymap -> IO Entry
functionOfKeyseq keys km =
withCString keys $ \keysPtr -> alloca $ \typPtr -> do
dat <- rl_function_of_keyseq keysPtr (fromMaybe (MkKeymap nullPtr) km) typPtr
typ <- peek typPtr
case typ of
(#const ISFUNC) ->
return (Function (importCallback dat))
(#const ISMACR) ->
liftM Macro (peekCString (castFunPtrToPtr dat))
(#const ISKMAP) ->
return (Keymap (MkKeymap (castFunPtrToPtr dat)))
_ -> error "functionOfKeyseq: unknown type"
foreign import ccall unsafe "rl_function_of_keyseq"
rl_function_of_keyseq :: Ptr CChar -> Keymap -> Ptr CInt -> IO (FunPtr CallbackC)
-- rl_invoking_keyseqs and rl_invoking_keyseqs_in_map are not provided
-- because Haskell functions have no identity.
functionDumper :: Bool -> IO ()
functionDumper readable = rl_function_dumper (if readable then 1 else 0)
foreign import ccall unsafe "rl_function_dumper"
rl_function_dumper :: CInt -> IO ()
foreign import ccall unsafe "rl_list_funmap_names" listFunmapNames :: IO ()
#if HAVE_READLINE_4
funmapNames :: IO [String]
funmapNames = do
namesPtr <- rl_funmap_names
namePtrs <- peekArray0 nullPtr namesPtr
free namesPtr
mapM peekCString namePtrs
foreign import ccall unsafe "rl_funmap_names"
rl_funmap_names :: IO (Ptr (Ptr CChar))
#endif
exportCallback :: Callback -> IO (FunPtr CallbackC)
exportCallback cb =
exportCallbackC $ \n key ->
liftM fromIntegral (cb (fromIntegral n) (chr (fromIntegral key)))
foreign import ccall "wrapper"
exportCallbackC :: CallbackC -> IO (FunPtr CallbackC)
importCallback :: FunPtr CallbackC -> Callback
importCallback ptr n key =
liftM fromIntegral $
importCallbackC ptr (fromIntegral n) (fromIntegral (ord key))
foreign import ccall "dynamic"
importCallbackC :: FunPtr CallbackC -> CallbackC
------------------------------------------------------------------------
-- Allowing Undoing.
beginUndoGroup :: IO ()
beginUndoGroup = do rl_begin_undo_group; return ()
foreign import ccall unsafe "rl_begin_undo_group"
rl_begin_undo_group :: IO CInt
endUndoGroup :: IO ()
endUndoGroup = do rl_end_undo_group; return ()
foreign import ccall unsafe "rl_end_undo_group"
rl_end_undo_group :: IO CInt
data UndoCode = UndoDelete | UndoInsert | UndoBegin | UndoEnd
addUndo :: UndoCode -> Int -> Int -> String -> IO ()
addUndo uc start end text =
withCString text $ \textPtr ->
rl_add_undo uc' (fromIntegral start) (fromIntegral end) textPtr
where
uc' = case uc of
UndoDelete -> #const UNDO_DELETE
UndoInsert -> #const UNDO_INSERT
UndoBegin -> #const UNDO_BEGIN
UndoEnd -> #const UNDO_END
foreign import ccall unsafe
rl_add_undo :: CInt -> CInt -> CInt -> Ptr CChar -> IO ()
#if HAVE_READLINE_4_2
foreign import ccall unsafe "rl_free_undo_list" freeUndoList :: IO ()
#else
foreign import ccall unsafe "free_undo_list" freeUndoList :: IO ()
#endif
doUndo :: IO Bool
doUndo = liftM (/= 0) rl_do_undo
foreign import ccall unsafe "rl_do_undo"
rl_do_undo :: IO CInt
modifying :: Int -> Int -> IO ()
modifying start end = do
rl_modifying (fromIntegral start) (fromIntegral end)
return ()
foreign import ccall unsafe "rl_modifying"
rl_modifying :: CInt -> CInt -> IO CInt
------------------------------------------------------------------------
-- Redisplay.
foreign import ccall unsafe "rl_redisplay" redisplay :: IO ()
forcedUpdateDisplay :: IO ()
forcedUpdateDisplay = do rl_forced_update_display; return ()
foreign import ccall unsafe "rl_forced_update_display"
rl_forced_update_display :: IO CInt
onNewLine :: IO ()
onNewLine = do rl_on_new_line; return ()
foreign import ccall unsafe "rl_on_new_line"
rl_on_new_line :: IO CInt
#if HAVE_READLINE_4
onNewLineWithPrompt :: IO ()
onNewLineWithPrompt = do rl_on_new_line_with_prompt; return ()
foreign import ccall unsafe "rl_on_new_line_with_prompt"
rl_on_new_line_with_prompt :: IO CInt
#endif
resetLineState :: IO ()
resetLineState = do rl_reset_line_state; return ()
foreign import ccall unsafe "rl_reset_line_state"
rl_reset_line_state :: IO CInt
message :: String -> IO ()
message s = withCString s hs_rl_message
foreign import ccall unsafe "hs_rl_message"
hs_rl_message :: Ptr CChar -> IO ()
clearMessage :: IO ()
clearMessage = do rl_clear_message; return ()
foreign import ccall unsafe "rl_clear_message"
rl_clear_message :: IO CInt
#if HAVE_READLINE_4
foreign import ccall unsafe "rl_save_prompt" savePrompt :: IO ()
foreign import ccall unsafe "rl_restore_prompt" restorePrompt :: IO ()
#endif
------------------------------------------------------------------------
-- Modifying Text.
insertText :: String -> IO ()
insertText s = do withCString s rl_insert_text; return ()
foreign import ccall unsafe "rl_insert_text"
rl_insert_text :: Ptr CChar -> IO CInt
deleteText :: Int -> Int -> IO ()
deleteText start end = do
rl_delete_text (fromIntegral start) (fromIntegral end)
return ()
foreign import ccall unsafe "rl_delete_text"
rl_delete_text :: CInt -> CInt -> IO CInt
copyText :: Int -> Int -> IO String
copyText start end = do
ptr <- rl_copy_text (fromIntegral start) (fromIntegral end)
text <- peekCString ptr
free ptr
return text
foreign import ccall unsafe "rl_copy_text"
rl_copy_text :: CInt -> CInt -> IO (Ptr CChar)
killText :: Int -> Int -> IO ()
killText start end = do
rl_kill_text (fromIntegral start) (fromIntegral end)
return ()
foreign import ccall unsafe "rl_kill_text"
rl_kill_text :: CInt -> CInt -> IO CInt
------------------------------------------------------------------------
-- Utility functions.
readKey :: IO Char
readKey = liftM (chr . fromIntegral) rl_read_key
foreign import ccall unsafe "rl_read_key"
rl_read_key :: IO CInt
stuffChar :: Char -> IO Bool
stuffChar key = liftM (/= 0) (rl_stuff_char (fromIntegral (ord key)))
foreign import ccall unsafe "rl_stuff_char"
rl_stuff_char :: CInt -> IO CInt
initialize :: IO ()
initialize = do rl_initialize; return ()
foreign import ccall unsafe "rl_initialize"
rl_initialize :: IO CInt
resetTerminal :: Maybe String -> IO ()
resetTerminal name = do
maybeWith withCString name rl_reset_terminal
return ()
foreign import ccall unsafe "rl_reset_terminal"
rl_reset_terminal :: Ptr CChar -> IO CInt
ding :: IO Bool
ding = liftM (== 0) rl_ding
#if HAVE_READLINE_4_2
foreign import ccall unsafe "rl_ding" rl_ding :: IO CInt
#else
foreign import ccall unsafe "ding" rl_ding :: IO CInt
#endif
#if HAVE_READLINE_4
displayMatchList :: [String] -> IO ()
displayMatchList matches =
withMany withCString matches $ \matchPtrs ->
withArray0 nullPtr (nullPtr:matchPtrs) $ \matchesPtr ->
rl_display_match_list
matchesPtr
(fromIntegral (length matches))
(fromIntegral (maximum (map length matches)))
foreign import ccall unsafe "rl_display_match_list"
rl_display_match_list :: Ptr (Ptr CChar) -> CInt -> CInt -> IO ()
#endif
------------------------------------------------------------------------
-- Alternate Interface.
type Handler = Ptr CChar -> IO ()
callbackHandlerInstall :: String -> (String -> IO ()) -> IO (IO ())
callbackHandlerInstall prompt lhandler = do
lhandlerPtr <- exportHandler $ \linePtr -> peekCString linePtr >>= lhandler
withCString prompt $ \promptPtr -> do
rl_callback_handler_install promptPtr lhandlerPtr
return (do rl_callback_handler_remove; freeHaskellFunPtr lhandlerPtr)
foreign import ccall "wrapper"
exportHandler :: Handler -> IO (FunPtr Handler)
foreign import ccall unsafe "rl_callback_handler_install"
rl_callback_handler_install :: Ptr CChar -> FunPtr Handler -> IO ()
foreign import ccall unsafe "rl_callback_handler_remove"
rl_callback_handler_remove :: IO ()
foreign import ccall "rl_callback_read_char"
callbackReadChar :: IO ()
------------------------------------------------------------------------
-- Readline Signal Handling.
#if HAVE_READLINE_4
setCatchSignals :: Bool -> IO ()
setCatchSignals cat = poke rl_catch_signals (if cat then 1 else 0)
getCatchSignals :: IO Bool
getCatchSignals = liftM (/= 0) (peek rl_catch_signals)
foreign import ccall "&" rl_catch_signals :: Ptr CInt
setCatchSigwinch :: Bool -> IO ()
setCatchSigwinch cat = poke rl_catch_sigwinch (if cat then 1 else 0)
getCatchSigwinch :: IO Bool
getCatchSigwinch = liftM (/= 0) (peek rl_catch_sigwinch)
foreign import ccall "&" rl_catch_sigwinch :: Ptr CInt
foreign import ccall unsafe "rl_cleanup_after_signal" cleanupAfterSignal :: IO ()
foreign import ccall unsafe "rl_free_line_state" freeLineState :: IO ()
foreign import ccall unsafe "rl_reset_after_signal" resetAfterSignal :: IO ()
foreign import ccall unsafe "rl_resize_terminal" resizeTerminal :: IO ()
#endif
setSignals :: IO ()
setSignals = do rl_set_signals; return ()
foreign import ccall unsafe "rl_set_signals"
rl_set_signals :: IO CInt
clearSignals :: IO ()
clearSignals = do rl_clear_signals; return ()
foreign import ccall unsafe "rl_clear_signals"
rl_clear_signals :: IO CInt
------------------------------------------------------------------------
-- Completion functions.
completeInternal :: Char -> IO ()
completeInternal what = do
rl_complete_internal (fromIntegral (ord what))
return ()
foreign import ccall "rl_complete_internal"
rl_complete_internal :: CInt -> IO CInt
complete :: Int -> Char -> IO Int
complete n key =
liftM fromIntegral $
rl_complete (fromIntegral n) (fromIntegral (ord key))
foreign import ccall "rl_complete"
rl_complete :: CInt -> CInt -> IO CInt
possibleCompletions :: Int -> Char -> IO Int
possibleCompletions n key =
liftM fromIntegral $
rl_possible_completions (fromIntegral n) (fromIntegral (ord key))
foreign import ccall "rl_possible_completions"
rl_possible_completions :: CInt -> CInt -> IO CInt
insertCompletions :: Int -> Char -> IO Int
insertCompletions n key =
liftM fromIntegral $
rl_insert_completions (fromIntegral n) (fromIntegral (ord key))
foreign import ccall "rl_insert_completions"
rl_insert_completions :: CInt -> CInt -> IO CInt
type Generator = Ptr CChar -> CInt -> IO (Ptr CChar)
singleToWhole :: Generator -> String -> IO [String]
singleToWhole f text =
withCString text $ \textPtr -> let
loop n = do
ptr <- f textPtr n
if ptr == nullPtr
then return []
else do
str <- peekCString ptr
free ptr
rest <- loop (n+1)
return (str:rest)
in loop 0
wholeToSingle :: (String -> IO [String]) -> IO Generator
wholeToSingle f = do
ref <- newIORef []
return $ \textPtr state -> do
when (state == 0) $ peekCString textPtr >>= f >>= writeIORef ref
next <- readIORef ref
case next of
[] -> return nullPtr
x:xs -> do
writeIORef ref xs
newCString x
completionMatches
:: String -> (String -> IO [String]) -> IO (Maybe (String, [String]))
completionMatches text entry =
withCString text $ \textPtr -> do
entryPtr <- wholeToSingle entry >>= exportGenerator
matchesPtr <- rl_completion_matches textPtr entryPtr
freeHaskellFunPtr entryPtr
if matchesPtr == nullPtr then return Nothing else do
matchPtrs <- peekArray0 nullPtr matchesPtr
(text':matches) <- mapM peekCString matchPtrs
mapM_ free matchPtrs
free matchesPtr
return (Just (text', matches))
#if HAVE_READLINE_4_2
foreign import ccall "rl_completion_matches"
rl_completion_matches :: Ptr CChar -> FunPtr Generator -> IO (Ptr (Ptr CChar))
#else
foreign import ccall "completion_matches"
rl_completion_matches :: Ptr CChar -> FunPtr Generator -> IO (Ptr (Ptr CChar))
#endif
filenameCompletionFunction :: String -> IO [String]
filenameCompletionFunction = singleToWhole rl_filename_completion_function
#if HAVE_READLINE_4_2
foreign import ccall unsafe "rl_filename_completion_function"
rl_filename_completion_function :: Generator
#else
foreign import ccall unsafe "filename_completion_function"
rl_filename_completion_function :: Generator
#endif
usernameCompletionFunction :: String -> IO [String]
usernameCompletionFunction = singleToWhole rl_username_completion_function
#if HAVE_READLINE_4_2
foreign import ccall unsafe "rl_username_completion_function"
rl_username_completion_function :: Generator
#else
foreign import ccall unsafe "username_completion_function"
rl_username_completion_function :: Generator
#endif
setCompletionEntryFunction :: Maybe (String -> IO [String]) -> IO ()
setCompletionEntryFunction fun =
setFunPtr rl_completion_entry_function fun $ \f ->
wholeToSingle f >>= exportGenerator
foreign import ccall "&" rl_completion_entry_function :: Ptr (FunPtr Generator)
foreign import ccall "wrapper"
exportGenerator :: Generator -> IO (FunPtr Generator)
type Completer = Ptr CChar -> CInt -> CInt -> IO (Ptr (Ptr CChar))
setAttemptedCompletionFunction
:: Maybe (String -> Int -> Int -> IO (Maybe (String, [String]))) -> IO ()
setAttemptedCompletionFunction fun =
setFunPtr rl_attempted_completion_function fun $ \f ->
exportCompleter $ \textPtr start end -> do
text <- peekCString textPtr
found <- f text (fromIntegral start) (fromIntegral end)
case found of
Nothing -> return nullPtr
Just (text', matches) -> do
matchPtrs <- mapM newCString (text':matches)
matchesPtr <- mallocArray (length matchPtrs + 1)
pokeArray0 nullPtr matchesPtr matchPtrs
return matchesPtr
foreign import ccall "&" rl_attempted_completion_function :: Ptr (FunPtr Completer)
foreign import ccall "wrapper"
exportCompleter :: Completer -> IO (FunPtr Completer)
#if HAVE_READLINE_5
type StringFunc = IO (Ptr CChar)
foreign import ccall "&" rl_completion_word_break_hook
:: Ptr (FunPtr StringFunc)
foreign import ccall "wrapper"
exportStringFunc :: StringFunc -> IO (FunPtr StringFunc)
setCompletionWordBreakHook
:: Maybe (IO (Maybe String)) -> IO ()
setCompletionWordBreakHook fun =
setFunPtr rl_completion_word_break_hook fun $ \f ->
exportStringFunc $ do
wordBreaks <- f
case wordBreaks of
Nothing -> return nullPtr
Just wordBreaksString -> newCString wordBreaksString
#endif
type Quoter = Ptr CChar -> CInt -> Ptr CChar -> IO (Ptr CChar)
setFilenameQuotingFunction
:: Maybe (String -> Bool -> Ptr CChar -> IO String) -> IO ()
setFilenameQuotingFunction fun =
setFunPtr_freeIf
(\oldPtr -> oldPtr /= nullFunPtr && oldPtr /= rl_quote_filename)
rl_filename_quoting_function fun $ \f ->
exportQuoter $ \textPtr typ qp -> do
text <- peekCString textPtr
s <- f text (typ == (#const MULT_MATCH)) qp
newCString s
foreign import ccall "&" rl_filename_quoting_function :: Ptr (FunPtr Quoter)
foreign import ccall "wrapper"
exportQuoter :: Quoter -> IO (FunPtr Quoter)
-- We must not freeHaskellFunPtr the original value of the
-- rl_filename_quoting_function variable, because it's a native C
-- function. But this value, rl_quote_filename, is a static function,
-- not exported by readline. So we read it from the variable at the
-- beginning and store it in a Haskell's global variable. We also
-- export its Haskell translation to be able to restore its behavior
-- by setFilenameQuotingFunction.
{-# NOINLINE rl_quote_filename #-}
rl_quote_filename :: FunPtr Quoter
rl_quote_filename = unsafePerformIO $ peek rl_filename_quoting_function
quoteFilename :: String -> Bool -> Ptr CChar -> IO String
quoteFilename text typ qp = do
ptr <- withCString text $ \textPtr ->
importQuoter rl_quote_filename
textPtr
(if typ then (#const SINGLE_MATCH) else (#const MULT_MATCH))
qp
s <- peekCString ptr
free ptr
return s
foreign import ccall "dynamic" importQuoter :: FunPtr Quoter -> Quoter
type Dequoter = Ptr CChar -> CInt -> IO (Ptr CChar)
setFilenameDequotingFunction :: Maybe (String -> Maybe Char -> IO String) -> IO ()
setFilenameDequotingFunction fun =
setFunPtr rl_filename_dequoting_function fun $ \f ->
exportDequoter $ \textPtr qc -> do
text <- peekCString textPtr
s <- f text (if qc==0 then Nothing else Just (chr (fromIntegral qc)))
newCString s
foreign import ccall "&"rl_filename_dequoting_function :: Ptr (FunPtr Dequoter)
foreign import ccall "wrapper"
exportDequoter :: Dequoter -> IO (FunPtr Dequoter)
type IsQuoted = Ptr CChar -> CInt -> IO CInt
setCharIsQuotedP :: Maybe (String -> Int -> IO Bool) -> IO ()
setCharIsQuotedP fun =
setFunPtr rl_char_is_quoted_p fun $ \f ->
exportIsQuoted $ \textPtr index -> do
text <- peekCString textPtr
quoted <- f text (fromIntegral index)
return (if quoted then 1 else 0)
foreign import ccall "&" rl_char_is_quoted_p :: Ptr (FunPtr IsQuoted)
foreign import ccall "wrapper"
exportIsQuoted :: IsQuoted -> IO (FunPtr IsQuoted)
getCompletionQueryItems :: IO Int
getCompletionQueryItems =
liftM fromIntegral (peek rl_completion_query_items)
setCompletionQueryItems :: Int -> IO ()
setCompletionQueryItems items =
poke rl_completion_query_items (fromIntegral items)
foreign import ccall "&" rl_completion_query_items :: Ptr CInt
getBasicWordBreakCharacters :: IO String
getBasicWordBreakCharacters = getCharacters rl_basic_word_break_characters
setBasicWordBreakCharacters :: String -> IO ()
setBasicWordBreakCharacters =
setCharacters_freeIf
(/= orig_rl_basic_word_break_characters)
rl_basic_word_break_characters
foreign import ccall "&" rl_basic_word_break_characters :: Ptr (Ptr CChar)
-- Similarly to rl_quote_filename, we must be able to detect the
-- original pointer to a static char array.
{-# NOINLINE orig_rl_basic_word_break_characters #-}
orig_rl_basic_word_break_characters :: Ptr CChar
orig_rl_basic_word_break_characters = unsafePerformIO $
peek rl_basic_word_break_characters
getBasicQuoteCharacters :: IO String
getBasicQuoteCharacters = getCharacters rl_basic_quote_characters
setBasicQuoteCharacters :: String -> IO ()
setBasicQuoteCharacters =
setCharacters_freeIf
(/= orig_rl_basic_quote_characters)
rl_basic_quote_characters
foreign import ccall "&" rl_basic_quote_characters :: Ptr (Ptr CChar)
{-# NOINLINE orig_rl_basic_quote_characters #-}
orig_rl_basic_quote_characters :: Ptr CChar
orig_rl_basic_quote_characters = unsafePerformIO $
peek rl_basic_quote_characters
getCompleterWordBreakCharacters :: IO String
getCompleterWordBreakCharacters = getCharacters rl_completer_word_break_characters
setCompleterWordBreakCharacters :: String -> IO ()
setCompleterWordBreakCharacters =
setCharacters_freeIf
(\oldPtr -> oldPtr /= nullPtr &&
oldPtr /= orig_rl_basic_word_break_characters)
rl_completer_word_break_characters
foreign import ccall "&" rl_completer_word_break_characters :: Ptr (Ptr CChar)
getCompleterQuoteCharacters :: IO String
getCompleterQuoteCharacters = getCharacters rl_completer_quote_characters
setCompleterQuoteCharacters :: String -> IO ()
setCompleterQuoteCharacters cs = do
oldPtr <- peek rl_completer_quote_characters
when (oldPtr /= nullPtr) $ free oldPtr
-- I think that rl_completer_quote_characters should never be empty
-- but can be NULL.
newPtr <- if null cs
then return nullPtr
else do
ptr <- mallocArray (length cs + 1)
pokeArray0 0 ptr (map castCharToCChar cs)
return ptr
poke rl_completer_quote_characters newPtr
foreign import ccall "&" rl_completer_quote_characters :: Ptr (Ptr CChar)
getFilenameQuoteCharacters :: IO String
getFilenameQuoteCharacters = getCharacters rl_filename_quote_characters
setFilenameQuoteCharacters :: String -> IO ()
setFilenameQuoteCharacters = setCharacters rl_filename_quote_characters
foreign import ccall "&" rl_filename_quote_characters :: Ptr (Ptr CChar)
getSpecialPrefixes :: IO String
getSpecialPrefixes = getCharacters rl_special_prefixes
setSpecialPrefixes :: String -> IO ()
setSpecialPrefixes = setCharacters rl_special_prefixes
foreign import ccall "&" rl_special_prefixes :: Ptr (Ptr CChar)
getCompletionAppendCharacter :: IO (Maybe Char)
getCompletionAppendCharacter = do
ch <- peek rl_completion_append_character
return $ if ch == 0 then Nothing else Just (chr (fromIntegral ch))
setCompletionAppendCharacter :: Maybe Char -> IO ()
setCompletionAppendCharacter ch =
poke rl_completion_append_character (maybe 0 (fromIntegral . ord) ch)
foreign import ccall "&" rl_completion_append_character :: Ptr CInt
setIgnoreCompletionDuplicates :: Bool -> IO ()
setIgnoreCompletionDuplicates ign =
poke rl_ignore_completion_duplicates (if ign then 1 else 0)
getIgnoreCompletionDuplicates :: IO Bool
getIgnoreCompletionDuplicates =
liftM (/= 0) (peek rl_ignore_completion_duplicates)
foreign import ccall "&" rl_ignore_completion_duplicates :: Ptr CInt
setFilenameCompletionDesired :: Bool -> IO ()
setFilenameCompletionDesired comp =
poke rl_filename_completion_desired (if comp then 1 else 0)
getFilenameCompletionDesired :: IO Bool
getFilenameCompletionDesired =
liftM (/= 0) (peek rl_filename_completion_desired)
foreign import ccall "&" rl_filename_completion_desired :: Ptr CInt
setFilenameQuotingDesired :: Bool -> IO ()
setFilenameQuotingDesired quot =
poke rl_filename_quoting_desired (if quot then 1 else 0)
getFilenameQuotingDesired :: IO Bool
getFilenameQuotingDesired =
liftM (/= 0) (peek rl_filename_quoting_desired)
foreign import ccall "&" rl_filename_quoting_desired :: Ptr CInt
setInhibitCompletion :: Bool -> IO ()
setInhibitCompletion inh = poke rl_inhibit_completion (if inh then 1 else 0)
getInhibitCompletion :: IO Bool
getInhibitCompletion = liftM (/= 0) (peek rl_inhibit_completion)
foreign import ccall "&" rl_attempted_completion_over :: Ptr CInt
getAttemptedCompletionOver :: IO Bool
getAttemptedCompletionOver =
liftM (/=0) (peek rl_attempted_completion_over)
setAttemptedCompletionOver :: Bool -> IO ()
setAttemptedCompletionOver over =
poke rl_attempted_completion_over (if over then 1 else 0)
foreign import ccall "&" rl_inhibit_completion :: Ptr CInt
type Ignorer = Ptr (Ptr CChar) -> IO CInt
setIgnoreSomeCompletionsFunction :: Maybe ([String] -> IO [String]) -> IO ()
-- The function may not make the list longer!
setIgnoreSomeCompletionsFunction fun =
setFunPtr rl_ignore_some_completions_function fun $ \f ->
exportIgnorer $ \matchesPtr -> do
matchPtrs <- peekArray0 nullPtr matchesPtr
matches <- mapM peekCString matchPtrs
mapM_ free matchPtrs
f matches >>= mapM newCString >>= pokeArray0 nullPtr matchesPtr
return 0
foreign import ccall "&" rl_ignore_some_completions_function :: Ptr (FunPtr Ignorer)
foreign import ccall "wrapper"
exportIgnorer :: Ignorer -> IO (FunPtr Ignorer)
type DirCompleter = Ptr (Ptr CChar) -> IO CInt
setDirectoryCompletionHook :: Maybe (String -> IO String) -> IO ()
setDirectoryCompletionHook fun =
setFunPtr rl_directory_completion_hook fun $ \f ->
exportDirCompleter $ \dirPtrPtr -> do
oldDirPtr <- peek dirPtrPtr
oldDir <- peekCString oldDirPtr
free oldDirPtr
newDirPtr <- f oldDir >>= newCString
poke dirPtrPtr newDirPtr
return 0
foreign import ccall "&" rl_directory_completion_hook :: Ptr (FunPtr DirCompleter)
foreign import ccall "wrapper"
exportDirCompleter :: DirCompleter -> IO (FunPtr DirCompleter)
#if HAVE_READLINE_4
type Displayer = Ptr (Ptr CChar) -> CInt -> CInt -> IO ()
setCompletionDisplayMatchesHook :: Maybe ([String] -> IO ()) -> IO ()
setCompletionDisplayMatchesHook fun =
setFunPtr rl_completion_display_matches_hook fun $ \f ->
exportDisplayHook $ \matchesPtr _ _ ->
peekArray0 nullPtr matchesPtr >>= mapM peekCString >>= f
foreign import ccall "&" rl_completion_display_matches_hook :: Ptr (FunPtr Displayer)
foreign import ccall "wrapper"
exportDisplayHook :: Displayer -> IO (FunPtr Displayer)
#endif
setCharacters_freeIf :: (Ptr CChar -> Bool) -> Ptr (Ptr CChar) -> String -> IO ()
setCharacters_freeIf pred variable chars = do
oldPtr <- peek variable
when (pred oldPtr) $ free oldPtr
newPtr <- mallocArray (length chars + 1)
pokeArray0 0 newPtr (map castCharToCChar chars)
poke variable newPtr
setCharacters :: Ptr (Ptr CChar) -> String -> IO ()
setCharacters = setCharacters_freeIf (/= nullPtr)
getCharacters :: Ptr (Ptr CChar) -> IO String
getCharacters variable = do
ptr <- peek variable
if ptr == nullPtr then return "" else do
cs <- peekArray0 0 ptr
return (map castCCharToChar cs)