2 % (c) The GRASP/AQUA Project, Glasgow University, 1995-1996
4 \section[Readline]{GNU Readline Library Bindings}
6 This module attempts to provide a better line based editing facility
7 for Haskell programmers by providing access to the GNU Readline
8 library. Related to this are bindings for the GNU History library
9 which can be found in History.
13 {-# OPTIONS -#include "cbits/ghcReadline.h" #-}
19 rlBindKey, rlAddDefun,
22 rlGetLineBuffer, rlSetLineBuffer,
23 rlGetPoint, rlSetPoint,
29 rlPrompt, rlTerminalName, rlSetReadlineName, rlGetReadlineName
34 import CString ( unpackCStringIO )
39 --#include <readline/readline.h>
43 type RlCallbackFunction =
44 (Int -> -- Numeric Argument
45 KeyCode -> -- KeyCode of pressed Key
49 %***************************************************************************
51 \subsection[Readline-Functions]{Main Readline Functions}
53 %***************************************************************************
56 readline :: String -> -- Prompt String
57 IO String -- Returned line
59 --ToDo: Get the "Live register in _casm_GC_ " bug fixed
60 -- this stops us passing the prompt string to readline directly :-(
61 -- litstr <- _casm_GC_ ``%r = readline(%0);'' prompt
62 _casm_ ``rl_prompt_hack = (char*)realloc(rl_prompt_hack, %1);
63 strcpy (rl_prompt_hack,%0);''
64 prompt (length prompt)
65 litstr <- _casm_GC_ ``%r = readline (rl_prompt_hack);''
66 if (litstr == ``NULL'')
67 then fail (userError "Readline has read EOF")
69 str <- unpackCStringIO litstr
73 addHistory :: String -- String to enter in history
75 addHistory str = _ccall_ add_history str
78 rlBindKey :: KeyCode -- Key to Bind to
79 -> RlCallbackFunction -- Function to exec on execution
82 if (0 > key) || (key > 255) then
83 fail (userError "Invalid ASCII Key Code, must be in range 0.255")
85 addCbackEntry (key,cback)
86 _casm_ `` rl_bind_key((KeyCode)%0,&genericRlCback); '' key
90 i.e. add the (KeyCode,RlCallbackFunction) key to the assoc. list and register
91 the generic callback for this KeyCode.
93 The entry point that $genericRlCback$ calls would then read the
94 global variables $current\_i$ and $current\_kc$ and do a lookup:
97 rlAddDefun :: String -> -- Function Name
98 RlCallbackFunction -> -- Function to call
99 KeyCode -> -- Key to bind to, or -1 for no bind
101 rlAddDefun name cback key =
102 if (0 > key) || (key > 255) then
103 fail (userError "Invalid ASCII Key Code, must be in range 0..255")
105 addCbackEntry (key, cback)
106 _casm_ ``rl_add_defun (%0, &genericRlCback, (KeyCode)%1);'' name key
111 The C function $genericRlCallback$ puts the callback arguments into
112 global variables and enters the Haskell world through the
113 $haskellRlEntry$ function. Before exiting, the Haskell function will
114 deposit its result in the global varariable $rl\_return$.
116 In the Haskell action that is invoked via $enterStablePtr$, a match
117 between the Keycode in $current\_kc$ and the Haskell callback needs to
118 be made. To essentially keep the same assoc. list of (KeyCode,cback
119 function) as Readline does, we make use of yet another global variable
124 createCbackList :: [(KeyCode,RlCallbackFunction)] -> PrimIO ()
126 #ifndef __PARALLEL_HASKELL__
127 makeStablePtr ls >>= \ stable_ls ->
128 _casm_ `` cbackList=(StgStablePtr)%0; '' stable_ls
130 error "createCbackList: not available for Parallel Haskell"
133 getCbackList :: PrimIO [(KeyCode,RlCallbackFunction)]
135 #ifndef __PARALLEL_HASKELL__
136 _casm_ `` %r=(StgStablePtr)cbackList; '' >>= \ stable_ls ->
137 deRefStablePtr stable_ls
139 error "getCbackList: not available for Parallel Haskell"
142 setCbackList :: [(KeyCode,RlCallbackFunction)] -> PrimIO ()
144 #ifndef __PARALLEL_HASKELL__
145 _casm_ `` %r=(StgStablePtr)cbackList; '' >>= \ old_stable_ls ->
146 freeStablePtr old_stable_ls >>
149 error "setCbackList: not available for Parallel Haskell"
152 addCbackEntry :: (KeyCode,RlCallbackFunction) -> IO ()
153 addCbackEntry entry = do
155 setCbackList (entry:ls)
158 The above functions allows us to query and augment the assoc. list in
163 invokeRlCback :: IO ()
165 kc <- _casm_ `` %r=(KeyCode)current_kc; ''
166 narg <- _casm_ `` %r=(int)current_narg; ''
169 (case (dropWhile (\ (key,_) -> kc/=key) ls) of
171 ((_,cback):_) -> cback narg kc
173 _casm_ `` rl_return=(int)%0; '' ret_val
177 Finally, we need to initialise this whole, ugly machinery:
180 initRlCbacks :: PrimIO ()
183 #ifndef __PARALLEL_HASKELL__
184 createCbackList [] >>
185 makeStablePtr (invokeRlCback) >>= \ stable_f ->
186 _casm_ `` haskellRlEntry=(StgStablePtr)%0; '' stable_f >>= \ () ->
189 error "initRlCbacks: not available for Parallel Haskell"
194 %***************************************************************************
196 \subsection[Readline-Globals]{Global Readline Variables}
198 %***************************************************************************
200 These are the global variables required by the readline lib. Need to
201 find a way of making these read/write from the Haskell side. Should
202 they be in the IO Monad, should they be Mutable Variables?
206 rlGetLineBuffer :: IO String
208 litstr <- _casm_ ``%r = rl_line_buffer;''
209 unpackCStringIO litstr
211 rlSetLineBuffer :: String -> IO ()
212 rlSetLineBuffer str = _casm_ ``rl_line_buffer = %0;'' str
216 rlGetPoint = _casm_ ``%r = rl_point;''
218 rlSetPoint :: Int -> IO ()
219 rlSetPoint point = _casm_ ``rl_point = %0;'' point
222 rlGetEnd = _casm_ ``%r = rl_end;''
224 rlSetEnd :: Int -> IO ()
225 rlSetEnd end = _casm_ ``rl_end = %0;'' end
228 rlGetMark = _casm_ ``%r = rl_mark;''
230 rlSetMark :: Int -> IO ()
231 rlSetMark mark = _casm_ ``rl_mark = %0;'' mark
233 rlSetDone :: Bool -> IO ()
234 rlSetDone True = _casm_ ``rl_done = %0;'' 1
235 rlSetDone False = _casm_ ``rl_done = %0;'' 0
237 rlPendingInput :: KeyCode -> IO ()
238 rlPendingInput key = primIOToIO (_casm_ ``rl_pending_input = %0;'' key)
240 rlPrompt :: IO String
242 litstr <- _casm_ ``%r = rl_readline_name;''
243 unpackCStringIO litstr
245 rlTerminalName :: IO String
247 litstr <- _casm_ ``%r = rl_terminal_name;''
248 unpackCStringIO litstr
251 rlGetReadlineName :: IO String
252 rlGetReadlineName = do
253 litstr <- _casm_ ``%r = rl_readline_name;''
254 unpackCStringIO litstr
256 rlSetReadlineName :: String -> IO ()
257 rlSetReadlineName str = _casm_ ``rl_readline_name = %0;'' str
262 -- The following two were taken from PreludeStdIO stdin/stdout
265 rlInStream = unsafePerformPrimIO (
266 newMVar >>= \ handle ->
267 _ccall_ getLock (``rl_instream''::Addr) 0 >>= \ rc ->
269 0 -> putMVar handle ClosedHandle
270 1 -> putMVar handle (ReadHandle ``rl_instream'' Nothing False)
271 _ -> constructError >>= \ ioError ->
272 putMVar handle (ErrorHandle ioError)
278 rlOutStream :: Handle
279 rlOutStream = unsafePerformPrimIO (
280 newMVar >>= \ handle ->
281 _ccall_ getLock (``rl_outstream''::Addr) 1 >>= \ rc ->
283 0 -> putMVar handle ClosedHandle
284 1 -> putMVar handle (WriteHandle ``rl_outstream'' Nothing False)
285 _ -> constructError >>= \ ioError ->
286 putMVar handle (ErrorHandle ioError)
296 -- rlStartupHook :: RlCallBackFunction -> IO ()
298 rlInitialize :: IO ()
301 rlSetReadlineName pname
302 _casm_ ``rl_prompt_hack = (char*)malloc(1);''