humza/sml-projects
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

progress fixing compile errors resulting from adding 'bufferModifyTime' field (fixed normal-mode move expressions)

Browse Source
This commit is contained in:
Humza Shahid
2025-08-20 12:50:39 +01:00
parent 642814fb36
commit c21d1b8205
7 changed files with 57 additions and 63 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
fcore/app-update.sml
View File

@@ -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

16
fcore/app-with.sml
View File

@@ -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

21
fcore/finish.sml
View File

@@ -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

11
fcore/move.sml
View File

@@ -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

31
fcore/normal-mode/normal-move.sml
View File

@@ -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

12
shell/update-thread.sml
View File

@@ -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)

25
shf-tests.mlb
View File

@@ -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