basic movement commands implemented
This commit is contained in:
103
ogui.ml
103
ogui.ml
@ -97,10 +97,10 @@ module TextBuffer = struct
|
||||
| Some src ->
|
||||
let srcn = String.length src in
|
||||
assert (n < srcn);
|
||||
let dst = Bytes.create srcn in
|
||||
let ucn =
|
||||
Uchar.utf_decode_length (String.get_utf_8_uchar src n)
|
||||
in
|
||||
let dst = Bytes.create (srcn - ucn) in
|
||||
Bytes.blit_string src 0 dst 0 n;
|
||||
Bytes.blit_string src (n + ucn) dst n (srcn - n - ucn);
|
||||
Some (Bytes.to_string dst)
|
||||
@ -980,36 +980,90 @@ module TextEdit = struct
|
||||
(fun () ->
|
||||
TextBuffer.fold_string t.text (fun s ->
|
||||
let sn = String.length s in
|
||||
let last_col = t.cursor.last_col in
|
||||
let seol = Str.search_forward (Str.regexp "$") in
|
||||
let bol =
|
||||
Str.search_backward (Str.regexp "^") s
|
||||
t.cursor.index
|
||||
let next_bol =
|
||||
min sn (seol s t.cursor.index + 1)
|
||||
in
|
||||
let eol = seol s t.cursor.index in
|
||||
let bol' = min sn eol + 1 in
|
||||
let eol' = seol s bol' in
|
||||
let next_line_len = eol' - bol' in
|
||||
F.epr
|
||||
"Down: index=%d last_col=%d eol=%d eol'=%d \
|
||||
bol=%d @."
|
||||
t.cursor.index last_col eol eol' bol;
|
||||
let next_line_len = seol s next_bol - next_bol in
|
||||
(* F.epr
|
||||
"Down: index=%d last_col=%d eol=%d eol'=%d \
|
||||
bol=%d @."
|
||||
t.cursor.index last_col eol' bol; *)
|
||||
t.cursor <-
|
||||
{
|
||||
t.cursor with
|
||||
index =
|
||||
(bol'
|
||||
(next_bol
|
||||
+
|
||||
if last_col > next_line_len then
|
||||
if t.cursor.last_col > next_line_len then
|
||||
next_line_len
|
||||
else min next_line_len last_col);
|
||||
else min next_line_len t.cursor.last_col);
|
||||
}));
|
||||
]
|
||||
|> adds
|
||||
[
|
||||
[ Key (Press, P, [ Control ]) ]; [ Key (Press, Up, []) ];
|
||||
]
|
||||
[ Custom (fun () -> cursor_move t (-10)) ]
|
||||
[
|
||||
Custom
|
||||
(fun () ->
|
||||
TextBuffer.fold_string t.text (fun s ->
|
||||
let sbol =
|
||||
Str.search_backward (Str.regexp "^") s
|
||||
in
|
||||
let bol = sbol t.cursor.index in
|
||||
if bol > 0 then (
|
||||
let prev_bol = sbol (max 0 (bol - 1)) in
|
||||
let prev_line_len = bol - 1 - prev_bol in
|
||||
F.epr
|
||||
"up: index=%d bol=%d prev_bol=%d \
|
||||
prev_line_len=%d @."
|
||||
t.cursor.index bol prev_bol prev_line_len;
|
||||
t.cursor <-
|
||||
{
|
||||
t.cursor with
|
||||
index =
|
||||
(prev_bol
|
||||
+
|
||||
if t.cursor.last_col > prev_line_len then
|
||||
prev_line_len
|
||||
else min prev_line_len t.cursor.last_col
|
||||
);
|
||||
})));
|
||||
]
|
||||
|> adds (* EOL *)
|
||||
[
|
||||
[ Key (Press, E, [ Control ]) ]; [ Key (Press, End, []) ];
|
||||
]
|
||||
[
|
||||
Custom
|
||||
(fun () ->
|
||||
TextBuffer.fold_string t.text (fun s ->
|
||||
let bol =
|
||||
Str.search_backward (Str.regexp "^") s
|
||||
t.cursor.index
|
||||
in
|
||||
let eol =
|
||||
Str.search_forward (Str.regexp "$") s
|
||||
t.cursor.index
|
||||
in
|
||||
t.cursor <-
|
||||
TextLayout.cursor ~last_col:(eol - bol) eol));
|
||||
]
|
||||
|> adds (* BOL *)
|
||||
[
|
||||
[ Key (Press, A, [ Control ]) ];
|
||||
[ Key (Press, Home, []) ];
|
||||
]
|
||||
[
|
||||
Custom
|
||||
(fun () ->
|
||||
TextBuffer.fold_string t.text (fun s ->
|
||||
t.cursor <-
|
||||
TextLayout.cursor ~last_col:0
|
||||
(Str.search_backward (Str.regexp "^") s
|
||||
t.cursor.index)));
|
||||
]
|
||||
|> adds
|
||||
[ [ Key (Press, Backspace, []) ] ]
|
||||
[
|
||||
@ -1021,21 +1075,6 @@ module TextEdit = struct
|
||||
t.text <- text;
|
||||
cursor_move t (-1))
|
||||
else Lwt.return_unit);
|
||||
]
|
||||
|> adds (* EOL *)
|
||||
[
|
||||
[ Key (Press, E, [ Control ]) ]; [ Key (Press, End, []) ];
|
||||
]
|
||||
[
|
||||
Custom
|
||||
(fun () ->
|
||||
TextBuffer.length t.text >>= fun _textlen ->
|
||||
TextBuffer.fold_string t.text (fun s ->
|
||||
Str.search_forward (Str.regexp "$") s
|
||||
t.cursor.index)
|
||||
>>= fun index ->
|
||||
t.cursor <- { t.cursor with index };
|
||||
Lwt.return_unit);
|
||||
];
|
||||
|
||||
(* WARN XXX TKTK TODO this is probably "breaking" the lwt context and being used in other calls to Lwt_main.run *)
|
||||
|
||||
Reference in New Issue
Block a user