diff --git a/fcore/app-update.sml b/fcore/app-update.sml index fc4d5e0..b531ac7 100644 --- a/fcore/app-update.sml +++ b/fcore/app-update.sml @@ -2,6 +2,6 @@ structure AppUpdate = struct open AppType - fun update (app, msg) = - case #mode app of NORMAL_MODE str => NormalMode.update (app, str, msg) + fun update (app, msg, time) = + case #mode app of NORMAL_MODE str => NormalMode.update (app, str, msg, time) end diff --git a/fcore/app-with.sml b/fcore/app-with.sml index 9c0ecee..64ccf42 100644 --- a/fcore/app-with.sml +++ b/fcore/app-with.sml @@ -3,11 +3,13 @@ struct open AppType fun bufferAndSize - (app: app_type, newBuffer, newWidth, newHeight, newSearchList, newMsgs) = + (app: app_type, newBuffer, newWidth, newHeight, newSearchList, newMsgs, + newBufferModifyTime) = let val { mode , buffer = _ + , bufferModifyTime = _ , windowWidth = _ , windowHeight = _ , searchList = _ @@ -19,6 +21,7 @@ struct in { mode = mode , buffer = newBuffer + , bufferModifyTime = newBufferModifyTime , windowWidth = newWidth , windowHeight = newHeight , searchList = newSearchList @@ -37,11 +40,13 @@ struct , newStartLine , newSearchList , newMsgs + , newBufferModifyTime ) = let val { mode = _ , buffer = _ + , bufferModifyTime = _ , cursorIdx = _ , startLine = _ , searchList = _ @@ -53,6 +58,7 @@ struct in { mode = newMode , buffer = newBuffer + , bufferModifyTime = newBufferModifyTime , cursorIdx = newCursorIdx , startLine = newStartLine , searchList = newSearchList @@ -69,6 +75,7 @@ struct { mode = _ , msgs = _ , buffer + , bufferModifyTime , searchList , searchString , cursorIdx @@ -80,6 +87,7 @@ struct { mode = newMode , msgs = newMsgs , buffer = buffer + , bufferModifyTime = bufferModifyTime , searchList = searchList , searchString = searchString , cursorIdx = cursorIdx @@ -89,11 +97,12 @@ struct } end - fun searchList (app: app_type, newSearchList, newBuffer, newSearchString) = + fun searchList (app: app_type, newSearchList, newBuffer, newSearchString, newBufferModifyTime) = let val { searchList = _ , buffer = _ + , bufferModifyTime , searchString = _ , msgs , mode @@ -105,6 +114,7 @@ struct in { searchList = newSearchList , buffer = newBuffer + , bufferModifyTime = newBufferModifyTime , searchString = newSearchString , msgs = msgs , mode = mode @@ -120,6 +130,7 @@ struct val { startLine , buffer + , bufferModifyTime , searchList , searchString , mode @@ -131,6 +142,7 @@ struct in { startLine = startLine , buffer = buffer + , bufferModifyTime = bufferModifyTime , searchList = searchList , searchString = searchString , mode = mode diff --git a/fcore/finish.sml b/fcore/finish.sml index c54598d..52f1e88 100644 --- a/fcore/finish.sml +++ b/fcore/finish.sml @@ -9,7 +9,8 @@ struct fun clearMode app = AppWith.mode (app, NORMAL_MODE "", []) - fun buildTextAndClear (app: app_type, buffer, cursorIdx, searchList, msgs) = + fun buildTextAndClear (app: app_type, buffer, cursorIdx, searchList, msgs, + bufferModifyTime) = let val {windowWidth, windowHeight, startLine, searchString, ...} = app @@ -37,15 +38,15 @@ struct val mode = NORMAL_MODE "" in AppWith.bufferAndCursorIdx - (app, buffer, cursorIdx, mode, startLine, searchList, msgs) + (app, buffer, cursorIdx, mode, startLine, searchList, msgs, bufferModifyTime) end fun withSearchList (app: app_type, searchList) = let - val {buffer, searchString, cursorIdx, ...} = app - val app = AppWith.searchList (app, searchList, buffer, searchString) + val {buffer, searchString, cursorIdx, bufferModifyTime, ...} = app + val app = AppWith.searchList (app, searchList, buffer, searchString, bufferModifyTime) in - buildTextAndClear (app, buffer, cursorIdx, searchList, []) + buildTextAndClear (app, buffer, cursorIdx, searchList, [], bufferModifyTime) end fun resizeText (app: app_type, newWidth, newHeight) = @@ -58,6 +59,7 @@ struct , cursorIdx , searchList , searchString + , bufferModifyTime , ... } = app @@ -76,7 +78,7 @@ struct ) in AppWith.bufferAndSize - (app, newBuffer, newWidth, newHeight, searchList, drawMsg) + (app, newBuffer, newWidth, newHeight, searchList, drawMsg, bufferModifyTime) end (* Difference between this and buildTextAndClear is that @@ -85,7 +87,7 @@ struct * Since the cursor may move away a lot, it is best to recenter. * *) fun buildTextAndClearAfterChr - (app: app_type, buffer, cursorIdx, searchList, initialMsg) = + (app: app_type, buffer, cursorIdx, searchList, initialMsg, bufferModifyTime) = let val {windowWidth, windowHeight, startLine, searchString, ...} = app @@ -114,7 +116,7 @@ struct val mode = NORMAL_MODE "" in AppWith.bufferAndCursorIdx - (app, buffer, cursorIdx, mode, startLine, searchList, drawMsg) + (app, buffer, cursorIdx, mode, startLine, searchList, drawMsg, bufferModifyTime) end fun centreToCursor (app: app_type) = @@ -127,6 +129,7 @@ struct , cursorIdx , searchList , searchString + , bufferModifyTime , ... } = app val buffer = LineGap.goToIdx (cursorIdx, buffer) @@ -149,6 +152,6 @@ struct ) in AppWith.bufferAndCursorIdx - (app, buffer, cursorIdx, NORMAL_MODE "", startLine, searchList, drawMsg) + (app, buffer, cursorIdx, NORMAL_MODE "", startLine, searchList, drawMsg, bufferModifyTime) end end diff --git a/fcore/move.sml b/fcore/move.sml index adc83d1..50d9043 100644 --- a/fcore/move.sml +++ b/fcore/move.sml @@ -12,7 +12,12 @@ functor MakeMove(Fn: MOVE): MAKE_MOVE = struct fun helpMove (app: AppType.app_type, buffer, cursorIdx, count) = if count = 0 then - Finish.buildTextAndClear (app, buffer, cursorIdx, #searchList app, []) + let + val {searchList, bufferModifyTime, ...} = app + in + Finish.buildTextAndClear (app, buffer, cursorIdx, searchList, [], + bufferModifyTime) + end else (* move LineGap to cursorIdx, which is necessary for finding newCursorIdx *) let @@ -58,11 +63,11 @@ functor MakeDfaMove(Fn: DFA_MOVE): MAKE_DFA_MOVE = struct fun move (app: AppType.app_type, count) = let - val {buffer, cursorIdx, ...} = app + val {buffer, cursorIdx, searchList, bufferModifyTime, ...} = app val buffer = LineGap.goToIdx (cursorIdx, buffer) val cursorIdx = Fn.fMove (buffer, cursorIdx, count) in - Finish.buildTextAndClear (app, buffer, cursorIdx, #searchList app, []) + Finish.buildTextAndClear (app, buffer, cursorIdx, searchList, [], bufferModifyTime) end end diff --git a/fcore/normal-mode/normal-move.sml b/fcore/normal-mode/normal-move.sml index e1488b2..f8beb75 100644 --- a/fcore/normal-mode/normal-move.sml +++ b/fcore/normal-mode/normal-move.sml @@ -4,7 +4,8 @@ struct fun moveToStart (app: app_type) = let - val {buffer, windowWidth, windowHeight, searchList, searchString, ...} = + val {buffer, windowWidth, windowHeight, searchList, searchString, + bufferModifyTime, ...} = app val cursorIdx = 0 @@ -25,12 +26,13 @@ struct val mode = NORMAL_MODE "" in AppWith.bufferAndCursorIdx - (app, buffer, cursorIdx, mode, startLine, searchList, drawMsg) + (app, buffer, cursorIdx, mode, startLine, searchList, drawMsg, bufferModifyTime) end fun moveToEnd (app: app_type) = let - val {buffer, windowWidth, windowHeight, searchList, searchString, ...} = + val {buffer, windowWidth, windowHeight, searchList, searchString, + bufferModifyTime, ...} = app val buffer = LineGap.goToEnd buffer @@ -66,7 +68,7 @@ struct val mode = NORMAL_MODE "" in AppWith.bufferAndCursorIdx - (app, buffer, bufferIdx, mode, bufferLine, searchList, drawMsg) + (app, buffer, bufferIdx, mode, bufferLine, searchList, drawMsg, bufferModifyTime) end fun moveToLine (app: app_type, reqLine) = @@ -81,6 +83,7 @@ struct , startLine = origLine , searchList , searchString + , bufferModifyTime , ... } = app val buffer = LineGap.goToLine (reqLine, buffer) @@ -109,7 +112,7 @@ struct val mode = NORMAL_MODE "" in AppWith.bufferAndCursorIdx - (app, buffer, cursorIdx, mode, startLine, searchList, drawMsg) + (app, buffer, cursorIdx, mode, startLine, searchList, drawMsg, bufferModifyTime) end fun moveToMatchingPair (app: app_type) = @@ -122,6 +125,7 @@ struct , startLine , searchList , searchString + , bufferModifyTime , ... } = app @@ -157,6 +161,7 @@ struct , startLine , searchList , drawMsg + , bufferModifyTime ) end else @@ -188,13 +193,15 @@ struct , startLine , searchList , drawMsg + , bufferModifyTime ) end end fun firstNonSpaceChr (app: app_type) = let - val {buffer, cursorIdx, windowWidth, windowHeight, startLine, ...} = app + val {buffer, cursorIdx, windowWidth, windowHeight, startLine, searchList, + bufferModifyTime, ...} = app (* move LineGap and buffer to start of line *) val buffer = LineGap.goToIdx (cursorIdx, buffer) @@ -204,13 +211,13 @@ struct val buffer = LineGap.goToIdx (cursorIdx, buffer) val cursorIdx = Cursor.firstNonSpaceChr (buffer, cursorIdx) in - Finish.buildTextAndClear (app, buffer, cursorIdx, #searchList app, []) + Finish.buildTextAndClear (app, buffer, cursorIdx, searchList, [], bufferModifyTime) end fun helpMoveToChr (app: app_type, buffer, cursorIdx, count, fMove, chr) = if count = 0 then Finish.buildTextAndClearAfterChr - (app, buffer, cursorIdx, #searchList app, []) + (app, buffer, cursorIdx, #searchList app, [], #bufferModifyTime app) else let (* move LineGap to cursorIdx, which is necessary for finding newCursorIdx *) @@ -228,25 +235,25 @@ struct fun moveToNextMatch (app: app_type, count) = let - val {cursorIdx, searchList, buffer, ...} = app + val {cursorIdx, searchList, buffer, bufferModifyTime, ...} = app val newCursorIdx = SearchList.nextMatch (cursorIdx, searchList, count) in if newCursorIdx = ~1 then Finish.clearMode app else Finish.buildTextAndClearAfterChr - (app, buffer, newCursorIdx, searchList, []) + (app, buffer, newCursorIdx, searchList, [], bufferModifyTime) end fun moveToPrevMatch (app: app_type, count) = let - val {cursorIdx, searchList, buffer, ...} = app + val {cursorIdx, searchList, buffer, bufferModifyTime, ...} = app val newCursorIdx = SearchList.prevMatch (cursorIdx, searchList, count) in if newCursorIdx = ~1 then Finish.clearMode app else Finish.buildTextAndClearAfterChr - (app, buffer, newCursorIdx, searchList, []) + (app, buffer, newCursorIdx, searchList, [], bufferModifyTime) end end diff --git a/shell/update-thread.sml b/shell/update-thread.sml index 313f5d3..3a56833 100644 --- a/shell/update-thread.sml +++ b/shell/update-thread.sml @@ -20,20 +20,12 @@ struct fun loop (app: AppType.app_type, inputMailbox, drawMailbox, searchMailbox) = let + val time = Time.now () val inputMsg = Mailbox.recv inputMailbox - val () = - (* if a certain CHAR_EVENT is sent, - * we trigger an exception and log the command history. - * This is helpful for manually triggering logs when, - * for example, we encounter a bug and would like to see - * the history of events that caused it. *) - case inputMsg of - CHAR_EVENT #"~" => ExceptionLogger.log (Fail "") - | _ => () val () = ExceptionLogger.addCommand inputMsg - val app = AppUpdate.update (app, inputMsg) + val app = AppUpdate.update (app, inputMsg, time) handle e => ExceptionLogger.log e val () = sendMsgs (#msgs app, drawMailbox, searchMailbox) diff --git a/shf-tests.mlb b/shf-tests.mlb index 8285dd2..7786034 100644 --- a/shf-tests.mlb +++ b/shf-tests.mlb @@ -17,16 +17,6 @@ fcore/app-type.sml fcore/app-with.sml fcore/text-constants.sml -ann - "allowVectorExps true" -in - fcore/rect.sml - fcore/text-builder.sml - fcore/cursor-dfa/make-dfa-loop.sml - fcore/cursor-dfa/vi-WORD-dfa.sml - fcore/cursor-dfa/vi-word-dfa.sml - fcore/cursor-dfa/vi-dlr-dfa.sml -end fcore/cursor.sml fcore/text-window.sml @@ -34,18 +24,3 @@ fcore/finish.sml fcore/move.sml fcore/normal-mode/normal-move.sml -fcore/normal-mode/normal-delete.sml -fcore/normal-mode/normal-mode.sml - -fcore/app-update.sml - -(* TEST FILES *) -$(SML_LIB)/basis/mlton.mlb - -shell/exception-logger.sml - -test/Railroad/src/railroad.mlb -test/normal-move.sml -test/normal-delete.sml -test/regression.sml -test/test.sml