-
Notifications
You must be signed in to change notification settings - Fork 1
Implement up/down scrolling (CTRL-E, CTRL-Y, CTRL-U, CTRL-D) #58
Changes from all commits
fc98658
5e8abae
2f5bec3
51c9f58
4d32367
14632f9
f39063e
7d6dd5a
259d8b3
e783524
28f5ea2
786f68e
f436be4
23edd51
f2d1195
9fd66a2
8701ef8
c2e8de3
bda47a2
17845d6
0bf0c0e
075a318
596c030
e617b86
7310e74
66584d4
854f952
89284af
ac3fd3a
File filter
Filter by extension
Conversations
Jump to
Diff view
Diff view
There are no files selected for viewing
Original file line number | Diff line number | Diff line change |
---|---|---|
|
@@ -5,36 +5,43 @@ type Message = interface end | |
type CommandMessage = inherit Message | ||
type EventMessage = inherit Message | ||
|
||
type EnvelopeMessage<'TInnerMessage when 'TInnerMessage :> Message> = inherit Message | ||
|
||
type RequestMessage = inherit Message | ||
type ResponseMessage<'TRequest when 'TRequest :> RequestMessage> = inherit Message | ||
|
||
[<AutoOpen>] | ||
module ``This module is auto-opened to provide a null message`` = | ||
type NoMessage = | ||
| NoMessage | ||
interface Message | ||
type NoMessage = NoMessage interface Message | ||
let noMessage = NoMessage :> Message | ||
|
||
type NoResponseToRequest<'TRequest when 'TRequest :> RequestMessage> = | ||
{ | ||
Request : 'TRequest | ||
} | ||
interface Message | ||
|
||
type Handle<'TMsg when 'TMsg :> Message> = | ||
'TMsg -> Message | ||
|
||
type HandleRequest<'TRequest when 'TRequest :> RequestMessage> = | ||
'TRequest -> ResponseMessage<'TRequest> | ||
type HandleRequest<'TRequest, 'TResponse when 'TRequest :> RequestMessage and 'TResponse :> ResponseMessage<'TRequest>> = | ||
'TRequest -> 'TResponse | ||
|
||
type MaybeHandleRequest<'TRequest, 'TResponse when 'TRequest :> RequestMessage and 'TResponse :> ResponseMessage<'TRequest>> = | ||
'TRequest -> 'TResponse option | ||
|
||
type HandlePackagedRequest<'TRequest, 'TResponse, 'TPackagedRequest, 'TPackagedResponse when 'TRequest :> RequestMessage and 'TResponse :> ResponseMessage<'TRequest> and 'TPackagedRequest :> EnvelopeMessage<'TRequest> and 'TPackagedResponse :> EnvelopeMessage<'TResponse>> = | ||
'TPackagedRequest -> 'TPackagedResponse | ||
|
||
type MaybeHandlePackagedRequest<'TRequest, 'TResponse, 'TPackagedRequest, 'TPackagedResponse when 'TRequest :> RequestMessage and 'TResponse :> ResponseMessage<'TRequest> and 'TPackagedRequest :> EnvelopeMessage<'TRequest> and 'TPackagedResponse :> EnvelopeMessage<'TResponse>> = | ||
'TPackagedRequest -> 'TPackagedResponse option | ||
|
||
type MaybeHandleRequest<'TRequest when 'TRequest :> RequestMessage> = | ||
'TRequest -> ResponseMessage<'TRequest> option | ||
type RequestSender = | ||
abstract member makeRequest<'TRequest, 'TResponse when 'TRequest :> RequestMessage and 'TResponse :> ResponseMessage<'TRequest>> : 'TRequest -> 'TResponse option | ||
|
||
type HandleResponse<'TRequest, 'TResponse when 'TRequest :> RequestMessage and 'TResponse :> ResponseMessage<'TRequest>> = | ||
'TResponse -> Message | ||
type PackagedRequestSender = | ||
abstract member makePackagedRequest<'TRequest, 'TResponse, 'TPackagedRequest, 'TPackagedResponse when 'TRequest :> RequestMessage and 'TResponse :> ResponseMessage<'TRequest> and 'TPackagedRequest :> EnvelopeMessage<'TRequest> and 'TPackagedResponse :> EnvelopeMessage<'TResponse>> : 'TPackagedRequest -> 'TPackagedResponse option | ||
|
||
type SubscribeToBus = | ||
type Bus = | ||
abstract member publish : Message -> unit | ||
abstract member subscribe<'TMsg when 'TMsg :> Message> : Handle<'TMsg> -> unit | ||
abstract member subscribeToRequest<'TRequest when 'TRequest :> RequestMessage> : HandleRequest<'TRequest> -> unit | ||
abstract member subscribeToRequest<'TRequest when 'TRequest :> RequestMessage> : MaybeHandleRequest<'TRequest> -> unit | ||
abstract member subscribeToResponse<'TRequest, 'TResponse when 'TRequest :> RequestMessage and 'TResponse :> ResponseMessage<'TRequest>> : HandleResponse<'TRequest, 'TResponse> -> unit | ||
abstract member subscribeToRequest<'TRequest, 'TResponse when 'TRequest :> RequestMessage and 'TResponse :> ResponseMessage<'TRequest>> : HandleRequest<'TRequest, 'TResponse> -> unit | ||
There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. Can these types be unified somehow to prevent overloading? There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. I don't think so. Is there a disadvantage to overloading that you are concerned about? We could always name the methods differently I suppose. |
||
abstract member subscribeToRequest<'TRequest, 'TResponse when 'TRequest :> RequestMessage and 'TResponse :> ResponseMessage<'TRequest>> : MaybeHandleRequest<'TRequest, 'TResponse> -> unit | ||
abstract member subscribeToPackagedRequest<'TRequest, 'TResponse, 'TPackagedRequest, 'TPackagedResponse when 'TRequest :> RequestMessage and 'TResponse :> ResponseMessage<'TRequest> and 'TPackagedRequest :> EnvelopeMessage<'TRequest> and 'TPackagedResponse :> EnvelopeMessage<'TResponse>> : HandlePackagedRequest<'TRequest, 'TResponse, 'TPackagedRequest, 'TPackagedResponse> -> unit | ||
abstract member subscribeToPackagedRequest<'TRequest, 'TResponse, 'TPackagedRequest, 'TPackagedResponse when 'TRequest :> RequestMessage and 'TResponse :> ResponseMessage<'TRequest> and 'TPackagedRequest :> EnvelopeMessage<'TRequest> and 'TPackagedResponse :> EnvelopeMessage<'TResponse>> : MaybeHandlePackagedRequest<'TRequest, 'TResponse, 'TPackagedRequest, 'TPackagedResponse> -> unit | ||
inherit RequestSender | ||
inherit PackagedRequestSender |
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -1,5 +1,12 @@ | ||
namespace Void.Core | ||
|
||
// TODO This is naive, obviously | ||
type FileBuffer = private { | ||
Filepath : string option | ||
Contents : string list | ||
CursorPosition : CellGrid.Cell | ||
} | ||
|
||
module Buffer = | ||
open CellGrid | ||
|
||
|
@@ -13,7 +20,7 @@ module Buffer = | |
{ Filepath = Some path; Contents = contents; CursorPosition = originCell } | ||
|
||
let readLines fileBuffer start = | ||
fileBuffer.Contents |> Seq.skip (start - 1) // Line numbers start at 1 | ||
fileBuffer.Contents |> Seq.skip ((start - 1<mLine>)/1<mLine>) // Line numbers start at 1 | ||
|
||
type Buffers = private { | ||
List : Map<int, FileBuffer> | ||
|
@@ -36,13 +43,17 @@ module BufferList = | |
List = bufferList.List.Add(id, buffer) | ||
LastId = id | ||
} | ||
(listPlusOne, CoreEvent.BufferAdded (id, buffer) :> Message ) | ||
let bufferProxy = { | ||
MaybeFilepath = buffer.Filepath | ||
Contents = Seq.ofList buffer.Contents | ||
} | ||
(listPlusOne, { BufferId = id; Message = BufferEvent.Added bufferProxy } :> Message ) | ||
|
||
let private addEmptyBuffer bufferList = | ||
addBuffer bufferList Buffer.emptyFile | ||
|
||
let private writeBufferToPath bufferList bufferId path = | ||
let lines = Buffer.readLines bufferList.List.[bufferId] 0 | ||
let lines = Buffer.readLines bufferList.List.[bufferId] 0<mLine> | ||
let msg = Filesystem.Command.SaveToDisk (path, lines) :> Message | ||
(bufferList, msg) | ||
|
||
|
@@ -72,10 +83,33 @@ module BufferList = | |
| CoreCommand.WriteBufferToPath (bufferId, path) -> | ||
writeBufferToPath bufferList bufferId path | ||
| _ -> | ||
(bufferList, noMessage) | ||
bufferList, noMessage | ||
|
||
let private package bufferId message = | ||
{ | ||
BufferId = bufferId | ||
Message = message | ||
} | ||
|
||
let handleGetBufferContentsRequest bufferList envelope = | ||
let buffers = (!bufferList).List | ||
There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. What does There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. Confusingly enough, it means dereference the |
||
if buffers.ContainsKey envelope.BufferId | ||
then | ||
let buffer = buffers.[envelope.BufferId] | ||
{ | ||
FirstLineNumber = envelope.Message.StartingAtLine | ||
RequestedContents = | ||
if buffer.Contents.Length*1<mLine> < envelope.Message.StartingAtLine | ||
then Seq.empty | ||
else Buffer.readLines buffer envelope.Message.StartingAtLine | ||
} | ||
|> package envelope.BufferId | ||
|> Some | ||
There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. I am becoming quite a fan of There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. YEAH BABY!! |
||
else None | ||
|
||
module Service = | ||
let subscribe (subscribeHandler : SubscribeToBus) = | ||
let subscribe (bus : Bus) = | ||
let bufferList = ref empty | ||
subscribeHandler.subscribe <| Service.wrap bufferList handleCommand | ||
subscribeHandler.subscribe <| Service.wrap bufferList handleEvent | ||
Service.wrap bufferList handleCommand |> bus.subscribe | ||
Service.wrap bufferList handleEvent |> bus.subscribe | ||
handleGetBufferContentsRequest bufferList |> bus.subscribeToPackagedRequest |
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,42 @@ | ||
namespace Void.Core | ||
|
||
type BufferMessage = inherit Message | ||
|
||
type BufferEnvelopeMessage<'TBufferMessage when 'TBufferMessage :> BufferMessage> = | ||
{ | ||
BufferId : int | ||
Message : 'TBufferMessage | ||
} | ||
interface EnvelopeMessage<'TBufferMessage> | ||
There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. This is the first concretion on There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. I think I can see it. It's just providing those things that are common to a There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. Yeah my idea is that the That said, it might be a premature abstraction. |
||
|
||
type FileBufferProxy = { | ||
MaybeFilepath : string option | ||
Contents : string seq | ||
} | ||
|
||
[<RequireQualifiedAccess>] | ||
type BufferCommand = | ||
| MoveCursor of Motion | ||
There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. Cool! |
||
interface CommandMessage | ||
interface BufferMessage | ||
|
||
[<RequireQualifiedAccess>] | ||
type BufferEvent = | ||
| Added of FileBufferProxy | ||
There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. This means "a file was added to the buffer"? There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. No, it means "a (file) buffer was added". Maybe I should have spelled out the name more. I was reading it like |
||
interface EventMessage | ||
interface BufferMessage | ||
|
||
type GetBufferContentsRequest = | ||
{ | ||
StartingAtLine : int<mLine> | ||
} | ||
interface RequestMessage | ||
interface BufferMessage | ||
|
||
type GetBufferContentsResponse = | ||
{ | ||
FirstLineNumber : int<mLine> | ||
RequestedContents : string seq | ||
} | ||
interface ResponseMessage<GetBufferContentsRequest> | ||
interface BufferMessage |
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,38 @@ | ||
namespace Void.Core | ||
|
||
(* This is really for tests, and probably shouldn't be here. | ||
* However, I'm not going to extract a new assembly for this one class. | ||
* Besides, the test DLL shouldn't depend on Void.Core. | ||
* Void.Core has become unclear anyway: it really should be Void.Base and Void.Editor, | ||
* or something to that effect, and the test DLL should only depend on Void.Base. | ||
* So TODO: when there are several more things like this, create a test library. | ||
* Until then, this code isn't really hurting anybody. *) | ||
type CannedResponseRequestSender() = | ||
let mutable _requests = [] | ||
let mutable _responses = [] | ||
|
||
member x.registerResponse<'TRequest, 'TResponse when 'TRequest :> RequestMessage and 'TResponse :> ResponseMessage<'TRequest>> (response : 'TResponse) = | ||
_responses <- box response :: _responses | ||
|
||
member x.tryPickRequest<'TRequest when 'TRequest :> RequestMessage>() = | ||
let tryUnbox request = | ||
try | ||
unbox<'TRequest> request |> Some | ||
with _ -> | ||
None | ||
_requests |> List.tryPick tryUnbox | ||
|
||
member x.reset() = | ||
_requests <- [] | ||
_responses <- [] | ||
|
||
interface RequestSender with | ||
member x.makeRequest<'TRequest, 'TResponse when 'TRequest :> RequestMessage and 'TResponse :> ResponseMessage<'TRequest>> (request : 'TRequest) = | ||
let tryUnbox response = | ||
try | ||
unbox<'TResponse> response |> Some | ||
with _ -> | ||
None | ||
_requests <- box request :: _requests | ||
_responses |> List.tryPick tryUnbox | ||
|
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
Just curious, was this picked up by a warning?
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
No... not sure why I did that actually. Stylistic thrashing I guess. :)