******************************************************************************)
let onfocus focused = ()
-let onkeypress mods rune =
- edit_view := View.scroll_up !edit_view
+let onkeypress mods rune = ()
let onmousebtn mods btn x y pressed =
if pressed then match btn with
+type cursor = {
+ mutable start : int;
+ mutable stop : int
+}
+
type buf = {
lexfn : Colormap.ctx -> Lexing.lexbuf -> unit;
path : string;
- rope : Rope.t
+ rope : Rope.t;
+ cursor : cursor
}
type t = buf
}
]
+module Cursor = struct
+ type csr = cursor
+ type t = csr
+
+ let swap csr =
+ if csr.stop < csr.start then
+ { start = csr.stop; stop = csr.start }
+ else
+ csr
+
+ let initial =
+ { start = 0; stop = 0 }
+
+ let make buf idx =
+ { start = 0; stop = (Rope.limit_index buf.rope idx) }
+
+ let move_to dest buf csr =
+ csr.stop <- (match dest with
+ | StartOfLine -> Rope.to_bol buf.rope csr.stop
+ | EndOfLine -> Rope.to_eol buf.rope csr.stop
+ | NextChar -> Rope.nextc buf.rope csr.stop
+ | PrevChar -> Rope.prevc buf.rope csr.stop
+ | NextLine -> Rope.nextln buf.rope csr.stop
+ | PrevLine -> Rope.prevln buf.rope csr.stop
+ );
+ csr.stop
+
+ let stop csr =
+ csr.stop
+
+ let selected csr pos =
+ let csr = swap csr in
+ (pos >= csr.start && pos <= csr.stop)
+end
+
+let move_to dest buf i =
+ Cursor.move_to dest buf (Cursor.make buf i)
+let nextln = move_to NextLine
+let prevln = move_to PrevLine
+let bol = move_to StartOfLine
+
+
let pick_syntax path =
let name = Filename.basename path in
let ext = Filename.extension path in
let empty =
{ lexfn = Lex_text.scan;
path = "";
- rope = Rope.empty }
+ rope = Rope.empty;
+ cursor = Cursor.initial }
let load path =
{ lexfn = pick_syntax path;
path = path;
- rope = Rope.from_string (Misc.load_file path) }
+ rope = Rope.from_string (Misc.load_file path);
+ cursor = Cursor.initial }
let path buf =
buf.path
let iter fn buf i =
iteri (fun i c -> (fn c)) buf i
+let cursor buf =
+ buf.cursor
+
let make_lexer buf =
let pos = ref 0 in
Colormap.({
!count)
})
-module Cursor = struct
- type csr = {
- mutable start : int;
- mutable stop : int
- }
-
- type t = csr
-
- let make buf idx =
- { start = 0; stop = (Rope.limit_index buf.rope idx) }
-
- let move_to dest buf csr =
- csr.stop <- (match dest with
- | StartOfLine -> Rope.to_bol buf.rope csr.stop
- | EndOfLine -> Rope.to_eol buf.rope csr.stop
- | NextChar -> Rope.nextc buf.rope csr.stop
- | PrevChar -> Rope.prevc buf.rope csr.stop
- | NextLine -> Rope.nextln buf.rope csr.stop
- | PrevLine -> Rope.prevln buf.rope csr.stop
- );
- csr.stop
(*
let clone csr =
{ start = csr.start; stop = csr.stop }
let is_bol = is_at StartOfLine
let is_eol = is_at EndOfLine
-*)
-end
-let move_to dest buf i =
- Cursor.move_to dest buf (Cursor.make buf i)
-let nextln = move_to NextLine
-let prevln = move_to PrevLine
-let bol = move_to StartOfLine
-
-(*
let nextc = move_to NextChar
let prevc = move_to PrevChar
let eol = move_to EndOfLine
| NextChar | PrevChar
| NextLine | PrevLine
-(*
module Cursor : sig
type t
-
val make : buf -> int -> t
- val clone : t -> t
- val iter : (t -> int -> bool) -> buf -> t -> unit
- val offset : t -> int
- val goto : buf -> t -> int -> unit
-
- val getc : buf -> t -> int
-( *
- val putc : buf -> t -> int -> unit
- val gets : buf -> t -> string
- val puts : buf -> t -> string -> unit
-* )
-
val move_to : dest -> buf -> t -> int
- val nextc : buf -> t -> int
- val prevc : buf -> t -> int
- val nextln : buf -> t -> int
- val prevln : buf -> t -> int
- val bol : buf -> t -> int
- val eol : buf -> t -> int
-
- val is_at : dest -> buf -> t -> bool
- val is_bol : buf -> t -> bool
- val is_eol : buf -> t -> bool
+ val stop : t -> int
+ val selected : t -> int -> bool
end
-*)
val empty : t
val load : string -> t
val length : t -> int
val iteri : (int -> int -> bool) -> t -> int -> unit
val iter : (int -> bool) -> t -> int -> unit
+val cursor : t -> Cursor.t
val make_lexer : t -> Colormap.lexer
-
val nextln : t -> int -> int
val prevln : t -> int -> int
val bol : t -> int -> int
-
-(*
-val move_to : dest -> t -> int -> int
-val nextc : t -> int -> int
-val prevc : t -> int -> int
-
-val eol : t -> int -> int
-
-val is_at : dest -> t -> int -> bool
-val is_bol : t -> int -> bool
-val is_eol : t -> int -> bool
-*)
-
-
"Quit Undo Redo Cut Copy Paste | Send Find "
(* font settings *)
-let font = strvar "tide.ui.tags.edit" "Verdana:size=10"
+let font = strvar "tide.ui.tags.edit" "Verdana:size=11"
let line_spacing = intvar "tide.ui.line_spacing" 1
(* user interface related options *)
let dark_bkg = rectangle Cfg.Color.palette.(0)
let light_bkg = rectangle Cfg.Color.palette.(1)
let rule_bkg = rectangle Cfg.Color.palette.(3)
+let draw_cursor = rectangle Cfg.Color.palette.(6) 1 font_height
let string text csr =
X11.draw_string font Cfg.Color.palette.(5) text (csr.x + 2, csr.y);
let buffer csr buf clr off =
dark_bkg (csr.width - csr.x) (csr.height - csr.y) csr;
+ csr.y <- csr.y + 2;
let num = ref 0 and csr = (restart csr 2 0) in
let draw_rune c =
- draw_glyph csr c (Colormap.find (off + !num) clr);
+ let pos = off + !num in
+ if pos == (Buf.Cursor.stop (Buf.cursor buf)) then
+ draw_cursor csr;
+ draw_glyph csr c (Colormap.find pos clr);
num := !num + 1;
has_next_line csr
in
open Test
open Rope
-(*
+
let () = (* empty tests *)
test "empty : should be an empty rope" (fun () ->
let rope = Rope.empty in
assert( (to_eol rope 1) == 4 );
);
()
-*)
let () = (* getc() tests *)
test "getc : " (fun () ->