{-# OPTIONS_GHC -cpp #-}------------------------------------------------------------------------------- |-- Module : System.Console.SimpleLineEditor-- Copyright : (c) 2000,2003, Malcolm Wallace-- License : GPL (if it depends on readline, which is GPL)-- BSD (otherwise)---- Maintainer : libraries@haskell.org-- Stability : experimental-- Portability : non-portable (unix-specific at the moment)---- A simple line editor, using the GNU readline library if available,-- or a small emulation otherwise.-------------------------------------------------------------------------------moduleSystem.Console.SimpleLineEditor(initialise-- :: IO (),restore-- :: IO (),getLineEdited-- :: String -> IO (Maybe String),delChars-- :: String -> IO ())whereimportSystem.IO(stdin,stdout,BufferMode(..),hSetBuffering)importControl.Monad(when)importData.Char(isSpace)importData.Maybe(isJust,fromJust)#if USE_READLINEimportSystem.Console.Readline#elseimportData.IORef(IORef,newIORef,readIORef,writeIORef)importSystem.Cmd(system)importSystem.IO(hGetChar)importSystem.IO.Unsafe(unsafePerformIO)#endif-- | Set up the environment so that the terminal passes characters directly-- into the Haskell program, for immediate interpretation by the line editor.initialise::IO()initialise=dohSetBufferingstdoutNoBufferinghSetBufferingstdinNoBuffering#if USE_READLINEinitialize#else-- The following call is probably non-portable. Better suggestions?-- Note, we turn OFF terminal echoing of input characterssystem("stty -icanon min 1 -echo")return()#endif-- | Restore the environment so that the terminal is usable in normal-- mode once again.restore::IO()restore=dohSetBufferingstdoutLineBufferinghSetBufferingstdinLineBuffering#if ! USE_READLINE-- The following call is probably non-portable. Better suggestions?-- We assume the terminal should echo input characters after restorationsystem("stty icanon echo")return()#endif-- | Remove the given string from immediately behind (to the left of) the-- current cursor position.delChars::String->IO()delChars[]=return()delChars(_:xs)=doputStr"\BS \BS"delCharsxs-- | 'getLineEdited p' uses the string @p@ as a prompt, and returns a line-- of input from the user. The user can edit the line in-place before-- completion, using common readline-like command keys. (The real readline-- is used when available, or otherwise a simplified emulation.)#if USE_READLINEgetLineEdited::String->IO(MaybeString)getLineEditedprompt=doms<-readlinepromptcasemsofNothing->returnmsJusts->when(not(allisSpaces))(addHistorys)>>returnms#else-- nasty imperative state holds the command historyhistory::IORef[String]history=unsafePerformIO(newIORef[])getLineEdited::String->IO(MaybeString)getLineEditedprompt=doputStrpromptprevious<-readIORefhistoryms<-gl""0([],previous)casemsofNothing->returnmsJusts->dowhen(not(allisSpaces))(writeIORefhistory(reverses:previous))returnmswheregls0hist=do-- s is accumulated line (in reverse)-- 0 is cursor position FROM THE END of the stringcmd<-lineCmdcasecmdofCharc->putCharc>>gl(c:s)0histAccept->return(Just(reverses))Cancel->returnNothingDeleteL->ifnullsthengls0histelsedelChars"_">>gl(tails)0histDeleteBegin->delCharss>>gl""0histMoveL->ifnot(nulls)thenputStr("\BS")>>gls1histelsegls0histHistory->casehistof(_fut,[])->gls0hist(fut,p:past)->dodelCharssputStr(reversep)glp0(s:fut,past)Future->casehistof([],_past)->gls0hist(f:fut,past)->dodelCharssputStr(reversef)glf0(fut,s:past)_->gls0histglsnhist=do-- s is accumulated line, n(/=0) is cursor positioncmd<-lineCmdcasecmdofCharc->doputStr(c:reverse(takens))putStr(replicaten'\BS')gl(takens++c:dropns)nhistAccept->return(Just(reverses))Cancel->returnNothingMoveR->doletn1=n-1putStr(reverse(takens)++" ")putStr(replicaten'\BS')glsn1histDeleteR->doletn1=n-1putStr(reverse(taken1s)++" ")putStr(replicate(n1+1)'\BS')gl(taken1s++dropns)n1histMoveL->doletn1=n+1ifn1<=lengthsthendoputStr('\BS':reverse(taken1s))putStr(replicaten1'\BS')glsn1histelsedoputStr(reverses++" ")putStr(replicaten1'\BS')glsnhistDeleteL->doletn1=n+1ifn1<=lengthsthendoputStr('\BS':reverse(takens)++" ")putStr(replicaten1'\BS')gl(takens++dropn1s)nhistelsedoputStr(reverses++" ")putStr(replicaten1'\BS')glsnhistHistory->casehistof(_fut,[])->glsnhist(fut,p:past)->doputStr(replicaten' ')delCharssputStr(reversep)glp0(s:fut,past)Future->casehistof([],_past)->glsnhist(f:fut,past)->doputStr(replicaten' ')delCharssputStr(reversef)glf0(fut,s:past)_->glsnhist-- Define a mini-command language, to separate the lexing of input-- commands from their interpretation. Note there is room for expansion-- here, e.g. commands include word-at-a-time movement, but we don't-- currently have a key binding for that.dataLineCmd=CharChar|MoveCursor|DeleteCursor|Accept|Cancel|History|Future|NoOpdataCursor=L|R|Begin|End-- not implemented yet: | WordL | WordR-- This little lexer for keystrokes does a reasonable job, but there-- are plenty of problems. E.g. the backspace key might generate a-- ^H character and not display it, which results in a mismatched cursor-- position. Behaviour is highly dependent on terminal settings I imagine.lineCmd::IOLineCmdlineCmd=doc1<-hGetCharstdincasec1of'\n'->putChar'\n'>>returnAccept'\^K'->putChar'\n'>>returnCancel'\DEL'->return(DeleteL)'\BS'->return(DeleteL)'\^L'->return(MoveR)'\^['->doc2<-hGetCharstdincasec2of'k'->returnHistory'j'->returnFuture'['->doc3<-hGetCharstdincasec3of'D'->return(MoveL)'C'->return(MoveR)'A'->returnHistory'B'->returnFuture'3'->doc<-hGetCharstdincasecof'~'->return(DeleteR)_->returnNoOp'4'->doc<-hGetCharstdincasecof'~'->return(MoveEnd)_->returnNoOp'1'->doc<-hGetCharstdincasecof'~'->return(MoveBegin)_->returnNoOp_->returnNoOp'O'->doc3<-hGetCharstdincasec3of'D'->return(MoveL)'C'->return(MoveR)'A'->returnHistory'B'->returnFuture_->returnNoOp_->returnNoOp_->return(Charc1)#endif /* USE_READLINE */{-
-- | A simple interactive test for the line-editing functionality.
-- (This illustrates the necessary use of 'initialise' and 'restore'
-- as brackets around the editing loop.)
testIt :: IO ()
testIt = initialise >> loop >> restore
where loop = do l <- getLineEdited "prompt> "
when (isJust l) (putStrLn (fromJust l))
when (l/=Just "quit") loop
-}