msyds/gf-core
1
0
Fork 0
forked from GitHub/gf-core
Code Pull Requests Activity

always use Haskeline. drop Readline & Editline

Browse Source
This commit is contained in:
krasimir
2010-04-19 15:12:52 +00:00
parent 0b6b30d4a8
commit c11064bfad
7 changed files with 40 additions and 238 deletions
Download Patch File Download Diff File Expand all files Collapse all files

33
GF.cabal
View File

@@ -6,18 +6,6 @@ license: GPL
license-file: LICENSE
synopsis: Grammatical Framework
flag haskeline
Description: Enable Haskeline in the shell
Default: True
flag readline
Description: Enable Readline in the shell
Default: True
flag editline
Description: Enable Editline in the shell
Default: True
flag interrupt
Description: Enable Ctrl+Break in the shell
Default: True
@@ -74,7 +62,8 @@ executable gf
old-time,
process,
pretty,
mtl
mtl,
haskeline
build-tools: happy, alex
if os(windows)
build-depends: Win32
@@ -142,7 +131,6 @@ executable gf
GF.Compile.PGFtoProlog
GF.Compile.PGFtoJS
GF.Compile
GF.System.Readline
GF.Quiz
PGF
PGF.CId
@@ -161,23 +149,6 @@ executable gf
GFC
GFI
if flag(haskeline)
build-depends: haskeline
cpp-options: -DUSE_HASKELINE
other-modules: GF.System.UseHaskeline
else
if flag(readline)
build-depends: readline
cpp-options: -DUSE_READLINE
other-modules: GF.System.UseReadline
else
if flag(editline)
build-depends: editline
cpp-options: -DUSE_EDITLINE
other-modules: GF.System.UseEditline
else
other-modules: GF.System.NoReadline
if flag(interrupt)
cpp-options: -DUSE_INTERRUPT
other-modules: GF.System.UseSignal

33
src/compiler/GF/System/NoReadline.hs
View File

@@ -1,33 +0,0 @@
----------------------------------------------------------------------
-- |
-- Module : GF.System.NoReadline
-- Maintainer : BB
-- Stability : (stable)
-- Portability : (portable)
--
-- > CVS $Date: 2005/05/10 15:04:01 $
-- > CVS $Author: bringert $
-- > CVS $Revision: 1.1 $
--
-- Do not use readline.
-----------------------------------------------------------------------------
module GF.System.NoReadline (fetchCommand, setCompletionFunction, filenameCompletionFunction) where
import System.IO.Error (try)
import System.IO (stdout,hFlush)
fetchCommand :: String -> IO (String)
fetchCommand s = do
putStr s
hFlush stdout
res <- try getLine
case res of
Left e -> return "q"
Right l -> return l
setCompletionFunction :: Maybe (String -> String -> Int -> IO [String]) -> IO ()
setCompletionFunction _ = return ()
filenameCompletionFunction :: String -> IO [String]
filenameCompletionFunction _ = return []

35
src/compiler/GF/System/Readline.hs
View File

@@ -1,35 +0,0 @@
{-# OPTIONS -cpp #-}
----------------------------------------------------------------------
-- |
-- Module : GF.System.Readline
-- Maintainer : BB
-- Stability : (stable)
-- Portability : (portable)
--
-- > CVS $Date: 2005/05/10 15:04:01 $
-- > CVS $Author: bringert $
-- > CVS $Revision: 1.2 $
--
-- Uses the right readline library to read user input.
-----------------------------------------------------------------------------
module GF.System.Readline (fetchCommand, setCompletionFunction, filenameCompletionFunction) where
#ifdef USE_HASKELINE
import GF.System.UseHaskeline
#elif USE_READLINE
import GF.System.UseReadline
#elif USE_EDITLINE
import GF.System.UseEditline
#else
import GF.System.NoReadline
#endif

36
src/compiler/GF/System/UseEditline.hs
View File

@@ -1,36 +0,0 @@
----------------------------------------------------------------------
-- |
-- Module : GF.System.UseReadline
-- Maintainer : BB
-- Stability : (stable)
-- Portability : (portable)
--
-- > CVS $Date: 2005/05/10 15:04:01 $
-- > CVS $Author: bringert $
-- > CVS $Revision: 1.1 $
--
-- Use GNU readline
-----------------------------------------------------------------------------
module GF.System.UseEditline (fetchCommand, setCompletionFunction, filenameCompletionFunction) where
import System.Console.Editline.Readline
fetchCommand :: String -> IO (String)
fetchCommand s = do
setCompletionAppendCharacter Nothing
--setBasicQuoteCharacters ""
res <- readline s
case res of
Nothing -> return "q"
Just s -> do addHistory s
return s
setCompletionFunction :: Maybe (String -> String -> Int -> IO [String]) -> IO ()
setCompletionFunction Nothing = setCompletionEntryFunction Nothing
setCompletionFunction (Just fn) = setCompletionEntryFunction (Just my_fn)
where
my_fn prefix = do
s <- getLineBuffer
p <- getPoint
fn s prefix p

43
src/compiler/GF/System/UseHaskeline.hs
View File

@@ -1,43 +0,0 @@
----------------------------------------------------------------------
-- |
-- Module : GF.System.UseReadline
-- Maintainer : BB
-- Stability : (stable)
-- Portability : (portable)
--
-- > CVS $Date: 2005/05/10 15:04:01 $
-- > CVS $Author: bringert $
-- > CVS $Revision: 1.1 $
--
-- Use GNU readline
-----------------------------------------------------------------------------
module GF.System.UseHaskeline (fetchCommand, setCompletionFunction, filenameCompletionFunction) where
import System.Console.Haskeline
import System.Directory
fetchCommand :: String -> IO (String)
fetchCommand s = do
settings <- getGFSettings
res <- runInputT settings (getInputLine s)
case res of
Nothing -> return "q"
Just s -> return s
getGFSettings :: IO (Settings IO)
getGFSettings = do
path <- getAppUserDataDirectory "gf_history"
return $
Settings {
complete = completeFilename,
historyFile = Just path,
autoAddHistory = True
}
setCompletionFunction :: Maybe (String -> String -> Int -> IO [String]) -> IO ()
setCompletionFunction _ = return ()
filenameCompletionFunction :: String -> IO [String]
filenameCompletionFunction _ = return []

36
src/compiler/GF/System/UseReadline.hs
View File

@@ -1,36 +0,0 @@
----------------------------------------------------------------------
-- |
-- Module : GF.System.UseReadline
-- Maintainer : BB
-- Stability : (stable)
-- Portability : (portable)
--
-- > CVS $Date: 2005/05/10 15:04:01 $
-- > CVS $Author: bringert $
-- > CVS $Revision: 1.1 $
--
-- Use GNU readline
-----------------------------------------------------------------------------
module GF.System.UseReadline (fetchCommand, setCompletionFunction, filenameCompletionFunction) where
import System.Console.Readline
fetchCommand :: String -> IO (String)
fetchCommand s = do
setCompletionAppendCharacter Nothing
setBasicQuoteCharacters ""
res <- readline s
case res of
Nothing -> return "q"
Just s -> do addHistory s
return s
setCompletionFunction :: Maybe (String -> String -> Int -> IO [String]) -> IO ()
setCompletionFunction Nothing = setCompletionEntryFunction Nothing
setCompletionFunction (Just fn) = setCompletionEntryFunction (Just my_fn)
where
my_fn prefix = do
s <- getLineBuffer
p <- getPoint
fn s prefix p

62
src/compiler/GFI.hs
View File

@@ -19,7 +19,7 @@ import GF.Infra.CheckM
import GF.Infra.UseIO
import GF.Infra.Option
import GF.Infra.Modules (greatestResource, modules, emptyModInfo)
import GF.System.Readline
import qualified System.Console.Haskeline as Haskeline
import GF.Compile.Coding
@@ -79,11 +79,9 @@ loop opts gfenv0 = do
let ifv act = if isv then act else return ()
let env = commandenv gfenv0
let sgr = sourcegrammar gfenv0
setCompletionFunction (Just (wordCompletion gfenv0))
let fetch = case flag optMode opts of
ModeRun -> tryGetLine
_ -> fetchCommand (prompt env)
s0 <- fetch
s0 <- case flag optMode opts of
ModeRun -> tryGetLine
_ -> fetchCommand gfenv0
let gfenv = gfenv0 {history = s0 : history gfenv0}
let
pwords = case words s0 of
@@ -204,6 +202,20 @@ loop opts gfenv0 = do
gfenv' <- either (\e -> (print e >> return gfenv)) return r
loop opts gfenv'
fetchCommand :: GFEnv -> IO String
fetchCommand gfenv = do
path <- getAppUserDataDirectory "gf_history"
let settings =
Haskeline.Settings {
Haskeline.complete = wordCompletion gfenv,
Haskeline.historyFile = Just path,
Haskeline.autoAddHistory = True
}
res <- Haskeline.runInputT settings (Haskeline.getInputLine (prompt (commandenv gfenv)))
case res of
Nothing -> return "q"
Just s -> return s
importInEnv :: GFEnv -> Options -> [FilePath] -> IO GFEnv
importInEnv gfenv opts files
| flag optRetainResource opts =
@@ -262,34 +274,37 @@ emptyGFEnv = do
decode _ = id -- decodeUnicode . coding
wordCompletion gfenv line prefix p =
case wc_type (take p line) of
wordCompletion gfenv (left,right) = do
case wc_type (reverse left) of
CmplCmd pref
-> ret ' ' [name | name <- Map.keys (commands cmdEnv), isPrefixOf pref name]
CmplStr (Just (Command _ opts _)) s
-> ret (length pref) [Haskeline.simpleCompletion name | name <- Map.keys (commands cmdEnv), isPrefixOf pref name]
CmplStr (Just (Command _ opts _)) s0
-> do mb_state0 <- try (evaluate (initState pgf (optLang opts) (optType opts)))
case mb_state0 of
Right state0 -> let ws = words (take (length s - length prefix) s)
Right state0 -> let (rprefix,rs) = break isSpace (reverse s0)
s = reverse rs
prefix = reverse rprefix
ws = words s
in case loop state0 ws of
Nothing -> ret ' ' []
Nothing -> ret 0 []
Just state -> let compls = getCompletions state prefix
in ret ' ' (Map.keys compls)
Left (_ :: SomeException) -> ret ' ' []
in ret (length prefix) (map (\x -> Haskeline.simpleCompletion x) (Map.keys compls))
Left (_ :: SomeException) -> ret 0 []
CmplOpt (Just (Command n _ _)) pref
-> case Map.lookup n (commands cmdEnv) of
Just inf -> do let flg_compls = ['-':flg | (flg,_) <- flags inf, isPrefixOf pref flg]
opt_compls = ['-':opt | (opt,_) <- options inf, isPrefixOf pref opt]
ret (if null flg_compls then ' ' else '=')
Just inf -> do let flg_compls = [Haskeline.Completion ('-':flg++"=") ('-':flg) False | (flg,_) <- flags inf, isPrefixOf pref flg]
opt_compls = [Haskeline.Completion ('-':opt) ('-':opt) True | (opt,_) <- options inf, isPrefixOf pref opt]
ret (length pref+1)
(flg_compls++opt_compls)
Nothing -> ret ' ' []
Nothing -> ret (length pref) []
CmplIdent (Just (Command "i" _ _)) _ -- HACK: file name completion for command i
-> filenameCompletionFunction prefix
-> Haskeline.completeFilename (left,right)
CmplIdent _ pref
-> do mb_abs <- try (evaluate (abstract pgf))
case mb_abs of
Right abs -> ret ' ' [name | cid <- Map.keys (funs abs), let name = showCId cid, isPrefixOf pref name]
Left (_ :: SomeException) -> ret ' ' []
_ -> ret ' ' []
Right abs -> ret (length pref) [Haskeline.simpleCompletion name | cid <- Map.keys (funs abs), let name = showCId cid, isPrefixOf pref name]
Left (_ :: SomeException) -> ret (length pref) []
_ -> ret 0 []
where
pgf = multigrammar cmdEnv
cmdEnv = commandenv gfenv
@@ -305,8 +320,7 @@ wordCompletion gfenv line prefix p =
Left es -> Nothing
Right ps -> loop ps ts
ret c [x] = return [x++[c]]
ret _ xs = return xs
ret len xs = return (drop len left,xs)
data CompletionType