summaryrefslogtreecommitdiff
path: root/src/exper/EditShell.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/exper/EditShell.hs')
-rw-r--r--src/exper/EditShell.hs46
1 files changed, 38 insertions, 8 deletions
diff --git a/src/exper/EditShell.hs b/src/exper/EditShell.hs
index a50317d47..b00256478 100644
--- a/src/exper/EditShell.hs
+++ b/src/exper/EditShell.hs
@@ -3,6 +3,7 @@ module Main where
import PGF.Editor
import PGF
+import Data.Char
import System (getArgs)
main = do
@@ -15,25 +16,54 @@ main = do
editLoop :: PGF -> Dict -> State -> IO State
editLoop pgf dict st = do
- putStrLn ("I want something of type " ++ prCId (focusType st))
+ putStrLn $ "I want something of type " ++ showType (focusType st) ++
+ " (0 - " ++ show (length (refineMenu dict st)-1) ++ ")"
c <- getLine
st' <- interpret pgf dict st c
- let t = etree2tree (tree st')
- putStrLn (unlines ([
- "Now I have",
- showTree t] ++
- linearizeAll pgf t))
editLoop pgf dict st'
interpret :: PGF -> Dict -> State -> String -> IO State
interpret pgf dict st c = case words c of
"r":f:_ -> do
- return $ goNextMeta (refine dict (mkCId f) st)
+ let st' = goNext (refine dict (mkCId f) st)
+ prState pgf st'
+ return st'
+ "p":ws -> do
+ let tts = parseAll pgf (focusType st) (dropWhile (not . isSpace) c)
+ st' <- selectReplace dict (concat tts) st >>= return . goNext
+ prState pgf st'
+ return st'
"m":_ -> do
- putStrLn (unwords (map (prCId . fst) (refineMenu dict st)))
+ putStrLn (unwords (map prCId (refineMenu dict st)))
return st
+ d : _ | all isDigit d -> do
+ let f = refineMenu dict st !! read d
+ let st' = goNextMeta (refine dict f st)
+ prState pgf st'
+ return st'
+ ">":_ -> return (goNext st)
_ -> do
putStrLn "command not understood"
return st
+prState pgf st = do
+ let t = stateTree st
+ putStrLn (unlines ([
+ "Now I have",
+ showTree t] ++
+ linearizeAll pgf t))
+
+-- prompt selection from list of trees, such as ambiguous choice
+selectReplace :: Dict -> [Tree] -> State -> IO State
+selectReplace dict ts st = case ts of
+ [] -> putStrLn "no results" >> return st
+ [t] -> return $ replace dict t st
+ _ -> do
+ mapM_ putStrLn $ "choose tree" :
+ [show i ++ " : " ++ showTree t | (i,t) <- zip [0..] ts]
+ d <- getLine
+ let t = ts !! read d
+ return $ replace dict t st
+
+