diff --git a/src/GF/Data/Zipper.hs b/src/GF/Data/Zipper.hs index d498c5a56..a696f1cae 100644 --- a/src/GF/Data/Zipper.hs +++ b/src/GF/Data/Zipper.hs @@ -100,6 +100,16 @@ goLast :: Loc a -> Err (Loc a) goLast = rep goAhead where rep f s = err (const (return s)) (rep f) (f s) +goPosition :: [Int] -> Loc a -> Err (Loc a) +goPosition p = go p . goRoot where + go [] s = return s + go (p:ps) s = goDown s >>= apply p goRight >>= go ps + +apply :: Monad m => Int -> (a -> m a) -> a -> m a +apply n f a = case n of + 0 -> return a + _ -> f a >>= apply (n-1) f + -- added some utilities traverseCollect :: Path a -> [a] diff --git a/src/GF/Shell/CommandL.hs b/src/GF/Shell/CommandL.hs index 463b3d4e4..d1ba0f7ba 100644 --- a/src/GF/Shell/CommandL.hs +++ b/src/GF/Shell/CommandL.hs @@ -63,6 +63,7 @@ pCommand = pCommandWords . words where "<<" : _ -> CPrevMeta "'" : _ -> CTop "+" : _ -> CLast + "mp" : p -> CMovePosition (readIntList (unwords p)) "r" : f : _ -> CRefineWithAtom f "w" : f:i : _ -> CWrapWithFun (strings2Fun f, readIntArg i) "ch": f : _ -> CChangeHead (strings2Fun f) @@ -133,3 +134,9 @@ initEditMsgEmpty env = initEditMsg env +++++ unlines ( showCurrentState env' state' = unlines (tr ++ ["",""] ++ msg ++ ["",""] ++ map fst menu) where (tr,msg,menu) = displaySStateIn env' state' + +-- to read position; borrowed from Prelude; should be elsewhere +readIntList :: String -> [Int] +readIntList s = case [x | (x,t) <- reads s, ("","") <- lex t] of + [x] -> x + _ -> [] diff --git a/src/GF/Shell/Commands.hs b/src/GF/Shell/Commands.hs index f0bb8c4f4..2f7efa517 100644 --- a/src/GF/Shell/Commands.hs +++ b/src/GF/Shell/Commands.hs @@ -42,7 +42,9 @@ import Random (newStdGen) --- temporary hacks for GF 2.0 --- abstract command language for syntax editing. AR 22/8/2001 +-- Abstract command language for syntax editing. AR 22/8/2001 +-- Most arguments are strings, to make it easier to receive them from e.g. Java. +-- See CommandsL for a parser of a command language. data Command = CNewCat G.Cat @@ -53,6 +55,7 @@ data Command = | CPrevMeta | CTop | CLast + | CMovePosition [Int] | CRefineWithTree String | CRefineWithAtom String | CRefineParse String @@ -206,6 +209,7 @@ execECommand env c = case c of CBack n -> action2command (goBackN n) CTop -> action2command $ return . goRoot CLast -> action2command $ goLast + CMovePosition p -> action2command $ goPosition p CNextMeta -> action2command goNextNewMeta CPrevMeta -> action2command goPrevNewMeta CRefineWithAtom s -> action2commandNext $ \x -> do diff --git a/src/Today.hs b/src/Today.hs index a1580bc1a..de75a980c 100644 --- a/src/Today.hs +++ b/src/Today.hs @@ -1 +1 @@ -module Today where today = "Wed Sep 24 17:15:34 CEST 2003" +module Today where today = "Thu Sep 25 14:28:54 CEST 2003"