GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-04-23 11:42:49 -06:00
Code Issues Packages Projects Releases Wiki Activity

edit command ct pos1 pos2; fixed undo bug

Browse Source
This commit is contained in:
aarne
2005-08-17 14:13:55 +00:00
parent dfba9956ae
commit b235391d51
3 changed files with 14 additions and 12 deletions
Download Patch File Download Diff File Expand all files Collapse all files

6
src/GF/Shell/CommandL.hs
View File

@@ -5,9 +5,9 @@
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date: 2005/08/17 14:43:50 $ -- > CVS $Date: 2005/08/17 15:13:55 $
-- > CVS $Author: aarne $ -- > CVS $Author: aarne $
-- > CVS $Revision: 1.20 $ -- > CVS $Revision: 1.21 $
-- --
-- (Description of the module) -- (Description of the module)
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
@@ -110,7 +110,7 @@ pCommandMsg s = (m,pCommandWords $ words c) where
"'" : _ -> CTop "'" : _ -> CTop
"+" : _ -> CLast "+" : _ -> CLast
"mp" : p -> CMovePosition (readIntList (unwords p)) "mp" : p -> CMovePosition (readIntList (unwords p))
"ct" : p -> CCopyPosition (readIntList (unwords p)) "ct" : p:q:_ -> CCopyPosition (readIntList p) (readIntList q)
"r" : f : _ -> CRefineWithAtom f "r" : f : _ -> CRefineWithAtom f
"w" : f:i : _ -> CWrapWithFun (f, readIntArg i) "w" : f:i : _ -> CWrapWithFun (f, readIntArg i)
"ch": f : _ -> CChangeHead f "ch": f : _ -> CChangeHead f

13
src/GF/Shell/Commands.hs
View File

@@ -5,9 +5,9 @@
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date: 2005/08/17 14:43:50 $ -- > CVS $Date: 2005/08/17 15:13:55 $
-- > CVS $Author: aarne $ -- > CVS $Author: aarne $
-- > CVS $Revision: 1.40 $ -- > CVS $Revision: 1.41 $
-- --
-- temporary hacks for GF 2.0 -- temporary hacks for GF 2.0
-- --
@@ -76,7 +76,7 @@ data Command =
| CTop | CTop
| CLast | CLast
| CMovePosition [Int] | CMovePosition [Int]
| CCopyPosition [Int] | CCopyPosition [Int] [Int]
| CRefineWithTree String | CRefineWithTree String
| CRefineWithClip Int | CRefineWithClip Int
| CRefineWithAtom String | CRefineWithAtom String
@@ -257,12 +257,13 @@ execECommand env c = case c of
in (case et of in (case et of
Ok t -> refineByTrees der cgr [t] s Ok t -> refineByTrees der cgr [t] s
Bad m -> changeMsg [m] s) Bad m -> changeMsg [m] s)
CCopyPosition p -> action2command $ \s -> do CCopyPosition p q -> action2command $ \s -> do
s1 <- goPosition p s s1 <- goPosition p s
let t = actTree s1 let t = actTree s1
let compat = actVal s1 == actVal s s2 <- goPosition q s1
let compat = actVal s1 == actVal s2
if compat if compat
then refineWithTree der cgr t s then refineWithTree der cgr t s2
else return s else return s
CRefineParse str -> \s -> CRefineParse str -> \s ->

7
src/GF/UseGrammar/Session.hs
View File

@@ -5,9 +5,9 @@
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date: 2005/06/11 20:27:05 $ -- > CVS $Date: 2005/08/17 15:13:55 $
-- > CVS $Author: aarne $ -- > CVS $Author: aarne $
-- > CVS $Revision: 1.11 $ -- > CVS $Revision: 1.12 $
-- --
-- (Description of the module) -- (Description of the module)
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
@@ -88,6 +88,7 @@ removeClip n ss@((s,(ts,cb),(i,b)):_) = (s,(ts, drop n cb),(i,b)) : ss
changeMsg :: [String] -> ECommand changeMsg :: [String] -> ECommand
changeMsg m ((s,ts,(_,b)):ss) = (s,ts,(m,b)) : ss -- just change message changeMsg m ((s,ts,(_,b)):ss) = (s,ts,(m,b)) : ss -- just change message
changeMsg m _ = (s,ts,(m,b)) : [] where [(s,ts,(_,b))] = initSState
changeView :: ECommand changeView :: ECommand
changeView ((s,ts,(m,(v,b))):ss) = (s,ts,(m,(v+1,b))) : ss -- toggle view changeView ((s,ts,(m,(v,b))):ss) = (s,ts,(m,(v+1,b))) : ss -- toggle view
@@ -126,7 +127,7 @@ undoCommand :: Int -> ECommand
undoCommand n ss = undoCommand n ss =
let k = length ss in let k = length ss in
if k < n if k < n
then changeMsg ["cannot go all the way back"] [] then changeMsg ["cannot go all the way back"] [last ss]
else changeMsg ["successful undo"] (drop n ss) else changeMsg ["successful undo"] (drop n ss)
selectCand :: CGrammar -> Int -> ECommand selectCand :: CGrammar -> Int -> ECommand