The new tree position annotation, and the corresponding command.

4 files changed, 23 insertions, 2 deletions

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"