module Yavie.Editor (
Editor
, Pos
, initialSaveToEditor
, saveToEditor
, saveToFile
, saveToTmpFile
, isBoxCursor
, cursorPosOfDpy
, displayLines
, displayVisualLines
, fileName
, cursorPos
, resizeDisplay
, cursorToXY
, cursorUp
, cursorDown
, cursorToTop
, cursorToLine
, cursorToLinePercent
, cursorToHead
, cursorToMiddle
, cursorToLast
, cursorLeft
, cursorRight
, cursorTopOfLine
, cursorTopOfLineNotSpace
, cursorEndOfLine
, cursorFindChar
, cursorFindCharBack
, cursorWord
, cursorWordEnd
, cursorBackWord
, cursorSearchStr
, cursorNextSearchStr
, cursorSearchStrBack
, cursorNextSearchStrBack
, resetStrForSearch
, addStrForSearch
, scrollUp
, scrollDown
, scrollUpPage
, scrollDownPage
, scrollUpHPage
, scrollDownHPage
, scrollForCursorHead
, scrollForCursorMiddle
, scrollForCursorLast
, deleteUp
, deleteDown
, deleteLine
, deleteInLargeVmode
, concatTwoLines
, deleteLeft
, deleteRight
, deleteChar
, deleteCursorToEnd
, deleteCursorToBegin
, deleteFind
, deleteFindMore
, deleteFindBack
, deleteWord
, deleteWordEnd
, deleteBackWord
, insertString
, insertStringAfter
, insertChar
, insertNL
, flipCase
, inInsertMode
, outInsertMode
, replaceModeOn
, replaceModeOff
, resetYank
, yankLines
, yankInLargeVmode
, pasteYanked
, pasteYankedAfter
, saveToHistory
, undo
, redo
, isModified
, resetModified
, setVisualBeginY
, resetVisualmode
, resetStatus
, setStatus
, addStatus
, bsStatus
, resetExCmd
, addExCmd
, getExCmd
, bsExCmd
, multi
, resetTimes
, addTimes
, resetIOAction
, setIOAction
, runIOAction
, needDeleteThisEditor
, deleteThisEditor
, getOtherValue
, setOtherValue
, modifyOtherValue
) where
import Yavie.EditorCore hiding
( runIOAction, saveToHistory, setIOAction, insertNL, insertChar,
inInsertMode, linesForDisplay, resetYank, concatTwoLines,
outInsertMode, pasteYanked, pasteYankedAfter, flipCase,
undo, redo, resetStatus, setStatus, addStatus, bsStatus,
isModified, resetModified, resizeMonitor,
getFileName, resetIOAction,
saveToTmpFile )
import qualified Yavie.EditorCore as C
( runIOAction, saveToHistory, setIOAction, insertNL, insertChar,
inInsertMode, linesForDisplay, resetYank, concatTwoLines,
outInsertMode, pasteYanked, pasteYankedAfter, flipCase,
undo, redo, resetStatus, setStatus, addStatus, bsStatus,
isModified, resetModified, resizeMonitor,
getFileName, resetIOAction,
saveToTmpFile )
import Yavie.Tools
import Data.List ( elemIndices, findIndex )
import Data.Char ( isDigit, isControl, isSpace )
import Data.Maybe ( fromMaybe )
import System.Directory
type Pos = ( Int, Int )
cursorToXY :: Int -> Int -> Editor c -> Editor c
cursorToXY cx cy = cursorToX cx . cursorToLineN cy
resetIOAction :: Editor c -> Editor c
resetIOAction = C.resetIOAction
fileName :: Editor c -> FilePath
fileName = C.getFileName
cursorPos :: Editor c -> Pos
cursorPos ed = ( getCursX ed, getCursY ed )
resizeDisplay :: Int -> Int -> Editor c -> Editor c
resizeDisplay = C.resizeMonitor
isModified :: Editor c -> Bool
isModified = C.isModified
resetModified :: Editor c -> Editor c
resetModified = C.resetModified
resetStatus, bsStatus :: Editor c -> Editor c
resetStatus = C.resetStatus; bsStatus = C.bsStatus
setStatus :: String -> Editor c -> Editor c
setStatus = C.setStatus
addStatus :: Char -> Editor c -> Editor c
addStatus = C.addStatus
undo, redo :: Editor c -> Editor c
undo = C.undo; redo = C.redo
flipCase :: Editor c -> Editor c
flipCase = C.flipCase
pasteYankedAfter :: Editor c -> Editor c
pasteYankedAfter = C.pasteYankedAfter
pasteYanked :: Editor c -> Editor c
pasteYanked = C.pasteYanked
outInsertMode :: Editor c -> Editor c
outInsertMode = C.outInsertMode
concatTwoLines :: Editor c -> Editor c
concatTwoLines = C.concatTwoLines
resetYank :: Editor c -> Editor c
resetYank = C.resetYank
inInsertMode :: Editor c -> Editor c
inInsertMode = C.inInsertMode
insertChar :: Char -> Editor c -> Editor c
insertChar = C.insertChar
insertNL :: Editor c -> Editor c
insertNL = C.insertNL
insertString, insertStringGen :: String -> Editor c -> Editor c
insertString str = insertStringGen str . saveToHistory
insertStringGen "" = id
insertStringGen ( '\n' : cs ) = insertStringGen cs . insertNL
insertStringGen ( c : cs ) = insertStringGen cs . cursorRight . insertChar c
insertStringAfter :: String -> Editor c -> Editor c
insertStringAfter str =
outInsertMode . insertString str . cursorRight . inInsertMode
saveToHistory :: Editor c -> Editor c
saveToHistory = C.saveToHistory
setIOAction :: ( Editor c -> IO ( Editor c ) ) -> Editor c -> Editor c
setIOAction = C.setIOAction
runIOAction :: Editor c -> IO ( Editor c )
runIOAction = C.runIOAction
type Editor c = EditorC ( Container c )
data Container c = Container {
cExCmd :: String ,
cStrForSearch :: String ,
cTimes :: Int ,
cVisualBeginY :: Maybe Int ,
cDeleteSelf :: Bool ,
cReplaceMode :: Bool ,
cOther :: Maybe c
}
initContainer :: Container c
initContainer = Container {
cExCmd = "" ,
cStrForSearch = "" ,
cTimes = 0 ,
cVisualBeginY = Nothing ,
cDeleteSelf = False ,
cReplaceMode = False ,
cOther = Nothing
}
cursorUp , cursorDown :: Editor c -> Editor c
cursorToTop , cursorToLine , cursorToLinePercent :: Editor c -> Editor c
cursorToHead, cursorToMiddle, cursorToLast :: Editor c -> Editor c
cursorUp = moveToLine $ const3 (+ (1))
cursorDown = moveToLine $ const3 (+ 1)
cursorToTop = moveToLine $ const4 0
cursorToLine = scrollForCursorMiddle .
moveToLineT ( \n -> const2 . flip addIfMinus ( n 1 ) )
cursorToLinePercent = scrollForCursorMiddle .
moveToLineT ( \n -> const2 . (`div` 100) . (* n) )
cursorToHead = moveToLineT $ \n -> const2 (+ ( intoLargerEq 1 n 1 ))
cursorToMiddle = moveToLine $ const $ \mh -> const . (+ mh `div` 2)
cursorToLast = moveToLineT $ \n _ mh -> (+ ( mh intoLargerEq 1 n ))
cursorToLineN :: Int -> Editor c -> Editor c
cursorToLineN n = moveToLine ( \_ _ _ _ -> n )
moveToLineT :: ( Int -> Int -> Int -> Int -> Int ) -> Editor c -> Editor c
moveToLineT f ed = let n = getTimes ed
ned = resetTimes ed
in moveToLine ( \bs mh my -> const $ f n bs mh my ) ned
cursorToX :: Int -> Editor c -> Editor c
cursorToX x = moveInlineSimple $ const2 x
cursorLeft , cursorRight :: Editor c -> Editor c
cursorTopOfLine, cursorTopOfLineNotSpace, cursorEndOfLine :: Editor c -> Editor c
cursorWord , cursorWordEnd , cursorBackWord :: Editor c -> Editor c
cursorFindChar , cursorFindCharBack :: Char -> Editor c -> Editor c
cursorLeft = moveInlineSimple $ const (+ (1))
cursorRight = moveInlineSimple $ const (+ 1)
cursorEndOfLine = moveInlineSimple $ const . (+ (1)) . length
cursorTopOfLine = moveInlineSimple $ const2 0
cursorTopOfLineNotSpace =
moveInlineSimple $
\ln -> const $ fromMaybe ( lastIndex ln ) $ findIndex ( not . isSpace ) ln
cursorWord = scrollForCursorIn .
outInsertMode .
moveToChar False False ( const $ not . isSpace ) .
moveToChar False False ( const isSpace ) .
inInsertMode
cursorWordEnd = scrollForCursorIn .
outInsertMode .
moveToChar True False ( const isSpace ) .
moveToChar True False ( const $ not . isSpace ) .
inInsertMode
cursorBackWord = scrollForCursorIn .
outInsertMode .
moveToChar True True ( const isSpace ) .
moveToChar True True ( const $ not . isSpace ) .
inInsertMode
cursorFindChar = moveInline False False False . findChar
cursorFindCharBack = moveInline False False False . findCharBack
moveInlineSimple :: ( String -> Int -> Int ) -> Editor c -> Editor c
moveInlineSimple f =
moveInline False False False ( \ln -> Just . f ln )
findChar, findCharMore, findCharBack :: Char -> String -> Int -> Maybe Int
findChar ch ln cx = let nxs = filter (> cx) $ elemIndices ch ln
in Just $ if null nxs then cx else head nxs
findCharMore ch ln cx = let nxs = filter (> cx) $ elemIndices ch ln
in Just $ if null nxs then cx else head nxs + 1
findCharBack ch ln cx = let nxs = filter (< cx) $ elemIndices ch ln
in Just $ if null nxs then cx else last nxs
cursorNextSearchStr, cursorSearchStr :: Editor c -> Editor c
cursorSearchStrBack, cursorNextSearchStrBack :: Editor c -> Editor c
cursorSearchStr ed = scrollForCursorMiddleIfOut $
moveInline False False True ( searchStr $ getStrForSearch ed ) ed
cursorNextSearchStr ed = scrollForCursorMiddleIfOut $
moveInline True False True ( searchStr $ getStrForSearch ed ) ed
cursorSearchStrBack ed = scrollForCursorMiddleIfOut $
moveInline False True True ( searchStrBack $ getStrForSearch ed ) ed
cursorNextSearchStrBack ed = scrollForCursorMiddleIfOut $
moveInline True True True ( searchStrBack $ getStrForSearch ed ) ed
searchStr, searchStrBack :: String -> String -> Int -> Maybe Int
searchStr "" _ _ = Nothing
searchStr ss ln cx = let nxs = filter (>= cx) $ strIndices ss ln
in if null nxs then Nothing else Just $ head nxs
searchStrBack "" _ _ = Nothing
searchStrBack ss ln cx = let nxs = filter (<= cx) $ strIndices ss ln
in if null nxs then Nothing else Just $ last nxs
scrollUp , scrollDown :: Editor c -> Editor c
scrollUpPage , scrollDownPage :: Editor c -> Editor c
scrollUpHPage , scrollDownHPage :: Editor c -> Editor c
scrollForCursorHead, scrollForCursorMiddle :: Editor c -> Editor c
scrollForCursorLast :: Editor c -> Editor c
scrollForCursorMiddleIfOut :: Editor c -> Editor c
scrollUp = setMonitorY $ const2 (+ (1))
scrollDown = setMonitorY $ const2 (+ 1)
scrollUpPage = setMonitorY $ \mh -> const (+ ( mh ))
scrollDownPage = setMonitorY $ \mh -> const (+ mh )
scrollUpHPage = setMonitorY $ \mh -> const (+ ( mh `div` 2))
scrollDownHPage = setMonitorY $ \mh -> const (+ mh `div` 2)
scrollForCursorHead = setMonitorYT $ \n _ cy -> cy n + 1
scrollForCursorMiddle = setMonitorY $ \mh cy -> const $ cy mh `div` 2
scrollForCursorLast = setMonitorYT $ \n mh cy -> cy mh + n
scrollForCursorMiddleIfOut = setMonitorY sfcmio
where
sfcmio mh cy my | cy < my || cy > my + mh 1 = cy mh `div` 2
| otherwise = my
setMonitorYT :: ( Int -> Int -> Int -> Int ) -> Editor c -> Editor c
setMonitorYT f ed = let n = intoLargerEq 1 $ getTimes ed
ned = resetTimes ed
in setMonitorY ( \mh cy _ -> f n mh cy ) ned
deleteUp, deleteDown :: Editor c -> Editor c
deleteLine :: Editor c -> Editor c
deleteUp = deleteToLineT $ const3 . flip ()
deleteDown = deleteToLineT $ const3 . (+)
deleteLine = deleteToLineT $ const3 . (+) . flip () 1
deleteInLargeVmode :: Editor c -> Editor c
deleteInLargeVmode ed =
case mvy of
Just vy -> modifyVisualBeginY ( const Nothing ) $
deleteToLineT ( const5 vy ) ed
Nothing -> error "you are not in visual V mode"
where
mvy = getVisualBeginY ed
deleteToLineT :: ( Int -> Int -> Int -> Int -> Int -> Int ) -> Editor c -> Editor c
deleteToLineT f ed = let t = intoLargerEq 1 $ getTimes ed
ned = resetTimes ed
in deleteToLine ( \bs mh my cy -> f t bs mh my cy ) ned
deleteLeft, deleteRight :: Editor c -> Editor c
deleteChar :: Editor c -> Editor c
deleteLeft = deleteInline False False $ const $ Just . (+ (1))
deleteRight = deleteInline False False $ const $ Just . (+ 1)
deleteChar = deleteInline False False $ const $ Just . (+ 1)
deleteCursorToEnd, deleteCursorToBegin :: Editor c -> Editor c
deleteCursorToEnd = deleteInline False False $ const . Just . length
deleteCursorToBegin = deleteInline False False $ const $ const $ Just 0
deleteFind, deleteFindMore, deleteFindBack :: Char -> Editor c -> Editor c
deleteFind = deleteInline False False . findChar
deleteFindMore = deleteInline False False . findCharMore
deleteFindBack = deleteInline False False . findCharBack
deleteWord :: Editor c -> Editor c
deleteWord = deleteToChar False False ( const $ not . isSpace ) .
deleteToChar False False ( const isSpace )
deleteWordEnd :: Editor c -> Editor c
deleteWordEnd = deleteToChar False False ( const isSpace ) .
deleteToChar False False ( const $ not . isSpace )
deleteBackWord :: Editor c -> Editor c
deleteBackWord = deleteToChar True True ( const isSpace ) .
deleteToChar True True ( const $ not . isSpace )
initialSaveToEditor :: Int -> Int -> FilePath -> String -> Editor c
initialSaveToEditor = saveToEditorCore initContainer
modifyCExCmd :: ( String -> String ) -> Container c -> Container c
modifyCExCmd f c@Container { cExCmd = ec } = c { cExCmd = f ec }
modifyCStrForSearch :: ( String -> String ) -> Container c -> Container c
modifyCStrForSearch f c@Container { cStrForSearch = sfs } =
c { cStrForSearch = f sfs }
modifyCTimes :: ( Int -> Int ) -> Container c -> Container c
modifyCTimes f c@Container { cTimes = t } = c { cTimes = f t }
modifyCVisualBeginY :: ( Maybe Int -> Maybe Int ) -> Container c -> Container c
modifyCVisualBeginY f c@Container { cVisualBeginY = v } = c { cVisualBeginY = f v }
setCVisualBeginY :: Int -> Container c -> Container c
setCVisualBeginY y c = c { cVisualBeginY = Just y }
saveToTmpFile :: Editor c -> Editor c
saveToTmpFile ed = if isModified ed
then setIOAction C.saveToTmpFile ed
else ed
saveToFile :: Editor c -> Editor c
saveToFile ed = if isModified ed
then setIOAction saveToFileC ed
else ed
replaceModeOn, replaceModeOff :: Editor c -> Editor c
replaceModeOn = modifyContainer $ \c -> c { cReplaceMode = True }
replaceModeOff = modifyContainer $ \c -> c { cReplaceMode = False }
isReplaceMode :: Editor c -> Bool
isReplaceMode = getsContainer cReplaceMode
deleteThisEditor :: Editor c -> Editor c
deleteThisEditor = modifyContainer $ \c -> c { cDeleteSelf = True }
needDeleteThisEditor :: Editor c -> Bool
needDeleteThisEditor = getsContainer cDeleteSelf
saveToEditor :: FilePath -> Editor c -> Editor c
saveToEditor fn = setIOAction ( editNextFileIfNeed fn )
editNextFileIfNeed :: String -> Editor c -> IO ( Editor c )
editNextFileIfNeed fn ed =
do e <- doesFileExist fn
if e then do cnt <- readFile fn
return $ resaveToEditor fn cnt ed
else return $ deleteThisEditor
$ setStatus ( "not exist file " ++ fn ) ed
resaveToEditor :: String -> String -> Editor c -> Editor c
resaveToEditor = resaveToEditorCore
getVisualBeginYWithMonitorY :: ( Maybe Int -> Int -> a ) -> Editor c -> a
getVisualBeginYWithMonitorY = getsContainerWithMonitorY cVisualBeginY
getVisualBeginY :: Editor c -> Maybe Int
getVisualBeginY = getsContainer cVisualBeginY
modifyVisualBeginY :: ( Maybe Int -> Maybe Int ) -> Editor c -> Editor c
modifyVisualBeginY = modifyContainer . modifyCVisualBeginY
resetVisualmode :: Editor c -> Editor c
resetVisualmode = modifyVisualBeginY $ const Nothing
setVisualBeginY :: Editor c -> Editor c
setVisualBeginY = setToCursY setCVisualBeginY
resetExCmd :: Editor c -> Editor c
resetExCmd = modifyContainer $ modifyCExCmd $ const ""
addExCmd :: Char -> Editor c -> Editor c
addExCmd = modifyContainer . modifyCExCmd . flip (++) . (: [])
bsExCmd :: Editor c -> Editor c
bsExCmd = modifyContainer $ modifyCExCmd init_
init_ :: [ a ] -> [ a ]
init_ [ ] = [ ]
init_ lst = init lst
getExCmd :: Editor c -> String
getExCmd = getsContainer cExCmd
getStrForSearch :: Editor c -> String
getStrForSearch = getsContainer cStrForSearch
modifyStrForSearch :: ( String -> String ) -> Editor c -> Editor c
modifyStrForSearch = modifyContainer . modifyCStrForSearch
getTimes :: Editor c -> Int
getTimes = getsContainer cTimes
modifyTimes :: ( Int -> Int ) -> Editor c -> Editor c
modifyTimes = modifyContainer . modifyCTimes
resetTimes :: Editor c -> Editor c
resetTimes = modifyTimes $ const 0
addTimes :: Char -> Editor c -> Editor c
addTimes c
| isDigit c = modifyTimes $ (+ read [ c ]) . (10 *)
| otherwise = error "first argument of addTimes is digit character"
resetStrForSearch :: Editor c -> Editor c
resetStrForSearch = modifyStrForSearch $ const ""
addStrForSearch :: Char -> Editor c -> Editor c
addStrForSearch = modifyStrForSearch . flip (++) . (: [])
multi :: ( Editor c -> Editor c ) -> Editor c -> Editor c
multi f ed =
let t = getTimes ed
in resetTimes $ iterate f ed !! if t == 0 then 1 else t
yankInLargeVmode :: Editor c -> Editor c
yankInLargeVmode ed =
case mvy of
Just vy -> modifyVisualBeginY ( const Nothing ) $ yankLinesCursTo vy ed
Nothing -> error "you are not in visual V mode"
where
mvy = getVisualBeginY ed
yankLines :: Editor c -> Editor c
yankLines ed
= resetTimes $ yankLinesNum ( if t == 0 then 1 else t ) ed
where
t = getTimes ed
data DisplayLines = DisplayLines {
isNotBoxCursorLFD :: Bool,
getCursorPosLFD :: ( Int, Int ),
displayLinesWithSelLFD :: [ ( Bool, String ) ]
}
isBoxCursor :: Editor c -> Bool
isBoxCursor = not . isNotBoxCursorLFD . linesForDisplay
cursorPosOfDpy :: Editor c -> Pos
cursorPosOfDpy = getCursorPosLFD . linesForDisplay
displayVisualLines :: Editor c -> [ ( Bool, String ) ]
displayVisualLines = displayLinesWithSelLFD . linesForDisplay
displayLines :: Editor c -> [ String ]
displayLines = displayLinesLFD . linesForDisplay
displayLinesLFD :: DisplayLines -> [ String ]
displayLinesLFD = map snd . displayLinesWithSelLFD
linesForDisplay :: Editor c -> DisplayLines
linesForDisplay ed = DisplayLines
( isInsertMode ed && not ( isReplaceMode ed ) ) ( ncx, mcy ) ( ab linesGen )
where
( ( cx, mcy ), linesGen ) = C.linesForDisplay ed
ncx = tab2spaceN ( ctrl2str $ linesGen !! mcy ) $
ctrl2strN ( linesGen !! mcy ) cx
mvy = getVisualBeginY ed
vyInMonitor = getVisualBeginYWithMonitorY ( \( Just v ) m -> v m ) ed
cyInMonitor = getCursorYInMonitor ed
ab = addBool . splitLines . map ( map processCtrlChar . tab2space . ctrl2str )
addBool ( pre, sel, aft ) = map ((,) False) pre ++ map ((,) True) sel
++ map ((,) False) aft
splitLines lns =
maybe ( lns, [], [] )
( \_ -> if cyInMonitor <= vyInMonitor
then ( take ( cyInMonitor 1 ) lns ,
if cyInMonitor > 0
then take ( vyInMonitor + 2 cyInMonitor ) $
drop ( cyInMonitor 1 ) lns
else take vyInMonitor lns ,
drop ( vyInMonitor + 1 ) lns )
else ( take vyInMonitor lns ,
if vyInMonitor > 0
then take ( cyInMonitor vyInMonitor ) $
drop vyInMonitor lns
else take cyInMonitor lns ,
drop cyInMonitor lns ) )
mvy
processCtrlChar '\t' = ' '
processCtrlChar c | isControl c = 'C' | otherwise = c
getOtherValue :: Editor c -> Maybe c
getOtherValue = getsContainer cOther
modifyCOther :: ( c -> c ) -> Container c -> Container c
modifyCOther m cnt@Container { cOther = Just co } = cnt { cOther = Just $ m co }
modifyCOther _ Container { cOther = Nothing } = error errStr
where errStr = "modifyCOther: set value before modify"
setCOther :: c -> Container c -> Container c
setCOther v cnt = cnt { cOther = Just v }
modifyOtherValue :: ( c -> c ) -> Editor c -> Editor c
modifyOtherValue = modifyContainer . modifyCOther
setOtherValue :: c -> Editor c -> Editor c
setOtherValue = modifyContainer . setCOther