[undo and redo functionality added Paolo Veronelli **20080205195727] { hunk ./Editor.hs 1 -{-# LANGUAGE MultiParamTypeClasses,NoMonomorphismRestriction #-} +{-# LANGUAGE MultiParamTypeClasses,NoMonomorphismRestriction,FlexibleContexts #-} hunk ./Editor.hs 29 --- | push a new file (data 'Engine' instance) in the core State +liftStatoE = lift . lift +-- | push a new file (data 'Engine' instance) in the core State, pushing the old state in the undo stack +hputfile x = get >>= \y -> liftStatoE $ hput y {file = x} hunk ./Editor.hs 43 -class (Engine w , Monad m) => Ctx m w +class (Engine w , Monad m, HCtx m (Stato w) ) => Ctx m w hunk ./Editor.hs 58 + | NoMoreUndo -- ^ reached the first state remembered + | NoMoreRedo -- ^ reached the last state remembered hunk ./Editor.hs 112 + -- | Revert the last change if ever + | UndoChange + -- | Restore via the last change + | RedoChange hunk ./Eval.hs 12 +import Undo hunk ./Eval.hs 57 +eval (CC UndoChange _) = liftStatoE undo >>= bool (return ()) (throwError NoMoreUndo) +eval (CC RedoChange _) = liftStatoE redo >>= bool (return ()) (throwError NoMoreRedo) + +bool x y b = if b then x else y hunk ./Hedi.cabal 1 -Name: Hedi -Version: 0.1 -Cabal-Version: >= 1.2 -Description: Haskell line editor. Cloned from ed manual. -Synopsis: Line editor -License: BSD3 -Author: Paolo Veronelli -Maintainer: paolo.veronelli@gmail.com -Build-type: Simple +Name: Hedi +Version: 0.1 +Cabal-Version: >= 1.2 +Description: Haskell line editor. Cloned from ed manual. +Synopsis: Line editor +License: BSD3 +Author: Paolo Veronelli +Maintainer: paolo.veronelli@gmail.com +Build-type: Simple hunk ./Hedi.cabal 13 - Build-Depends: base,mtl,parsec,regex-posix,readline,QuickCheck,process - Main-is: Main.hs - extensions: MultiParamTypeClasses + Build-Depends: base,mtl,parsec,regex-posix,readline,QuickCheck,process + Main-is: Main.hs + extensions: NoMonomorphismRestriction,MultiParamTypeClasses, + FlexibleContexts,FlexibleInstances, + GeneralizedNewtypeDeriving hunk ./Main.hs 1 -{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE MultiParamTypeClasses,FlexibleInstances #-} hunk ./Main.hs 16 +import Undo hunk ./Main.hs 18 +instance HCtx IO (Stato InsideAppend) hunk ./Offset.hs 51 -editOffset o = doOffset o putfile +editOffset o = doOffset o hputfile hunk ./Offset.hs 65 -editRange r = doRange r putfile +editRange r = doRange r hputfile hunk ./Parser.hs 70 +defaultOR UndoChange = ORN +defaultOR RedoChange = ORN hunk ./Parser.hs 108 + undo = char 'u' >> rconst UndoChange + redo = char 'R' >> rconst RedoChange hunk ./Parser.hs 112 - ,writen,write,setfn,getfn]) <|> nocomm + ,writen,write,setfn,getfn,undo,redo]) <|> nocomm hunk ./docs/Editor.html 149 -> w, Monad m) => w, Monad m, HCtx m (Stato w)) => | NoMoreUndo| NoMoreRedo| UndoChange| RedoChangeHCtx IO (Stato InsideAppend) w, Monad m) => w, Monad m, HCtx m (Stato w)) => instance) in the core State +> instance) in the core State, pushing the old state in the undo stack hunk ./docs/Editor.html 1158 +>NoMoreUndoreached the first state remembered +NoMoreRedoreached the last state remembered +UndoChangeRevert the last change if ever +RedoChangeRestore via the last change +show/hide Instances
HCtx IO (Stato InsideAppend)
EditorBufferBufferEditorboolEvalhputfileEditorliftStatoEEditorNoMoreRedoEditorNoMoreUndoEditorRedoChangeEditorUndoChangeEditor