2 % (c) The GRASP/AQUA Project, Glasgow University, 1995
4 % Last Modified: Wed Jul 19 13:04:53 1995
5 % Darren J Moffat <moffatd@dcs.gla.ac.uk>
6 \section[Readline]{GNU Readline Library Bindings}
8 This module attempts to provide a better line based editing facility
9 for Haskell programmers by providing access to the GNU Readline
10 library. Related to this are bindings for the GNU History library
11 which can be found in History.
19 rlBindKey, rlAddDefun,
20 RlCallbackFunction(..),
22 rlGetLineBuffer, rlSetLineBuffer,
23 rlGetPoint, rlSetPoint,
29 rlPrompt, rlTerminalName, rlSetReadlineName, rlGetReadlineName
31 -- rlInStream, rlOutStream
42 --#include <readline/readline.h>
46 type RlCallbackFunction =
47 (Int -> -- Numeric Argument
48 KeyCode -> -- KeyCode of pressed Key
52 %***************************************************************************
54 \subsection[Readline-Functions]{Main Readline Functions}
56 %***************************************************************************
59 readline :: String -> -- Prompt String
60 IO String -- Returned line
62 --ToDo: Get the "Live register in _casm_GC_ " bug fixed
63 -- this stops us passing the prompt string to readline directly :-(
64 -- _casm_GC_ ``%r = readline %0;'' prompt `thenPrimIO` \ litstr ->
66 _casm_ ``rl_prompt_hack = (char*)realloc(rl_prompt_hack, %1);
67 strcpy (rl_prompt_hack,%0);''
68 prompt (length prompt) `thenPrimIO` \ () ->
69 _casm_GC_ ``%r = readline (rl_prompt_hack);'' `thenPrimIO` \ litstr ->
70 if (litstr == ``NULL'') then
71 fail "Readline has read EOF"
73 let str = _unpackPS (_packCString litstr) in
74 _casm_ ``free %0;'' litstr `thenPrimIO` \ () ->
79 addHistory :: String -> -- String to enter in history
81 addHistory str = primIOToIO (_ccall_ add_history str)
84 rlBindKey :: KeyCode -> -- Key to Bind to
85 RlCallbackFunction -> -- Function to exec on execution
88 if (0 > key) || (key > 255) then
89 fail "Invalid ASCII Key Code, must be in range 0.255"
91 addCbackEntry (key,cback) `seqPrimIO`
92 _casm_ `` rl_bind_key((KeyCode)%0,&genericRlCback); ''
93 key `thenPrimIO` \ () ->
98 i.e. add the (KeyCode,RlCallbackFunction) key to the assoc. list and register
99 the generic callback for this KeyCode.
101 The entry point that $genericRlCback$ calls would then read the
102 global variables $current\_i$ and $current\_kc$ and do a lookup:
105 rlAddDefun :: String -> -- Function Name
106 RlCallbackFunction -> -- Function to call
107 KeyCode -> -- Key to bind to, or -1 for no bind
109 rlAddDefun name cback key =
110 if (0 > key) || (key > 255) then
111 fail "Invalid ASCII Key Code, must be in range 0..255"
113 addCbackEntry (key, cback) `seqPrimIO`
114 _casm_ ``rl_add_defun (%0, &genericRlCback, (KeyCode)%1);''
115 name key `thenPrimIO` \ () ->
121 The C function $genericRlCallback$ puts the callback arguments into
122 global variables and enters the Haskell world through the
123 $haskellRlEntry$ function. Before exiting, the Haskell function will
124 deposit its result in the global varariable $rl\_return$.
126 In the Haskell action that is invoked via $enterStablePtr$, a match
127 between the Keycode in $current\_kc$ and the Haskell callback needs to
128 be made. To essentially keep the same assoc. list of (KeyCode,cback
129 function) as Readline does, we make use of yet another global variable
134 createCbackList :: [(KeyCode,RlCallbackFunction)] -> PrimIO ()
136 #ifndef __PARALLEL_HASKELL__
137 makeStablePtr ls `thenPrimIO` \ stable_ls ->
138 _casm_ `` cbackList=(StgStablePtr)%0; '' stable_ls
140 error "createCbackList: not available for Parallel Haskell"
143 getCbackList :: PrimIO [(KeyCode,RlCallbackFunction)]
145 #ifndef __PARALLEL_HASKELL__
146 _casm_ `` %r=(StgStablePtr)cbackList; '' `thenPrimIO` \ stable_ls ->
147 deRefStablePtr stable_ls
149 error "getCbackList: not available for Parallel Haskell"
152 setCbackList :: [(KeyCode,RlCallbackFunction)] -> PrimIO ()
154 #ifndef __PARALLEL_HASKELL__
155 _casm_ `` %r=(StgStablePtr)cbackList; '' `thenPrimIO` \ old_stable_ls ->
156 freeStablePtr old_stable_ls `seqPrimIO`
159 error "setCbackList: not available for Parallel Haskell"
162 addCbackEntry :: (KeyCode,RlCallbackFunction) -> PrimIO ()
163 addCbackEntry entry =
164 getCbackList `thenPrimIO` \ ls ->
165 setCbackList (entry:ls)
169 The above functions allows us to query and augment the assoc. list in
175 invokeRlCback :: PrimIO ()
177 _casm_ `` %r=(KeyCode)current_kc; '' `thenPrimIO` \ kc ->
178 _casm_ `` %r=(int)current_narg; '' `thenPrimIO` \ narg ->
179 getCbackList `thenPrimIO` \ ls ->
180 (case (dropWhile (\ (key,_) -> kc/=key) ls) of
184 ioToPrimIO (cback narg kc)
185 ) `thenPrimIO` \ ret_val ->
186 _casm_ `` rl_return=(int)%0; '' ret_val `thenPrimIO` \ () ->
191 Finally, we need to initialise this whole, ugly machinery:
195 initRlCbacks :: PrimIO ()
197 #ifndef __PARALLEL_HASKELL__
198 createCbackList [] `seqPrimIO`
199 makeStablePtr (invokeRlCback) `thenPrimIO` \ stable_f ->
200 _casm_ `` haskellRlEntry=(StgStablePtr)%0; '' stable_f `thenPrimIO` \ () ->
203 error "initRlCbacks: not available for Parallel Haskell"
209 %***************************************************************************
211 \subsection[Readline-Globals]{Global Readline Variables}
213 %***************************************************************************
215 These are the global variables required by the readline lib. Need to
216 find a way of making these read/write from the Haskell side. Should
217 they be in the IO Monad, should they be Mutable Variables?
221 rlGetLineBuffer :: IO String
223 _casm_ ``%r = rl_line_buffer;'' `thenPrimIO` \ litstr ->
224 return (_unpackPS (_packCString litstr))
226 rlSetLineBuffer :: String -> IO ()
227 rlSetLineBuffer str = primIOToIO (_casm_ ``rl_line_buffer = %0;'' str)
231 rlGetPoint = primIOToIO (_casm_ ``%r = rl_point;'')
233 rlSetPoint :: Int -> IO ()
234 rlSetPoint point = primIOToIO (_casm_ ``rl_point = %0;'' point)
237 rlGetEnd = primIOToIO (_casm_ ``%r = rl_end;'')
239 rlSetEnd :: Int -> IO ()
240 rlSetEnd end = primIOToIO (_casm_ ``rl_end = %0;'' end)
243 rlGetMark = primIOToIO (_casm_ ``%r = rl_mark;'')
245 rlSetMark :: Int -> IO ()
246 rlSetMark mark = primIOToIO (_casm_ ``rl_mark = %0;'' mark)
248 rlSetDone :: Bool -> IO ()
249 rlSetDone True = primIOToIO (_casm_ ``rl_done = %0;'' 1)
250 rlSetDone False = primIOToIO (_casm_ ``rl_done = %0;'' 0)
252 rlPendingInput :: KeyCode -> IO ()
253 rlPendingInput key = primIOToIO (_casm_ ``rl_pending_input = %0;'' key)
255 rlPrompt :: IO String
257 _casm_ ``%r = rl_readline_name;'' `thenPrimIO` \ litstr ->
258 return (_unpackPS (_packCString litstr))
260 rlTerminalName :: IO String
262 _casm_ ``%r = rl_terminal_name;'' `thenPrimIO` \ litstr ->
263 return (_unpackPS (_packCString litstr))
266 rlGetReadlineName :: IO String
268 _casm_ ``%r = rl_readline_name;'' `thenPrimIO` \ litstr ->
269 return (_unpackPS (_packCString litstr))
271 rlSetReadlineName :: String -> IO ()
272 rlSetReadlineName str = primIOToIO (
273 _casm_ ``rl_readline_name = %0;'' str)
279 -- The following two were taken from PreludeStdIO stdin/stdout
282 rlInStream = unsafePerformPrimIO (
283 newMVar `thenPrimIO` \ handle ->
284 _ccall_ getLock (``rl_instream''::_Addr) 0 `thenPrimIO` \ rc ->
286 0 -> putMVar handle _ClosedHandle
287 1 -> putMVar handle (_ReadHandle ``rl_instream'' Nothing False)
288 _ -> _constructError `thenPrimIO` \ ioError ->
289 putMVar handle (_ErrorHandle ioError)
295 rlOutStream :: Handle
296 rlOutStream = unsafePerformPrimIO (
297 newMVar `thenPrimIO` \ handle ->
298 _ccall_ getLock (``rl_outstream''::_Addr) 1 `thenPrimIO` \ rc ->
300 0 -> putMVar handle _ClosedHandle
301 1 -> putMVar handle (_WriteHandle ``rl_outstream'' Nothing False)
302 _ -> _constructError `thenPrimIO` \ ioError ->
303 putMVar handle (_ErrorHandle ioError)
313 -- rlStartupHook :: RlCallBackFunction -> IO ()
315 rlInitialize :: IO ()
317 getProgName >>= \ pname ->
318 rlSetReadlineName pname >>
319 _casm_ ``rl_prompt_hack = (char*)malloc(1);'' `thenPrimIO` \ () ->
320 primIOToIO (initRlCbacks)