786 lines
22 KiB
OCaml
786 lines
22 KiB
OCaml
open Utils
|
|
open Glutils
|
|
open Config
|
|
|
|
let scrollph y maxy =
|
|
let sh = float (maxy + !S.winh) /. float !S.winh in
|
|
let sh = float !S.winh /. sh in
|
|
let sh = max sh (float conf.scrollh) in
|
|
|
|
let percent = float y /. float maxy in
|
|
let position = (float !S.winh -. sh) *. percent in
|
|
|
|
let position =
|
|
if position +. sh > float !S.winh
|
|
then float !S.winh -. sh
|
|
else position
|
|
in
|
|
position, sh
|
|
|
|
let isbirdseye = function
|
|
| Birdseye _ -> true
|
|
| Textentry _ | View | LinkNav _ -> false
|
|
|
|
let istextentry = function
|
|
| Textentry _ -> true
|
|
| Birdseye _ | View | LinkNav _ -> false
|
|
|
|
let vscrollw () =
|
|
if !S.uioh#alwaysscrolly || ((conf.scrollb land scrollbvv != 0)
|
|
&& (!S.maxy > !S.winh))
|
|
then conf.scrollbw
|
|
else 0
|
|
|
|
let vscrollhit x =
|
|
if conf.leftscroll
|
|
then x < vscrollw ()
|
|
else x > !S.winw - vscrollw ()
|
|
|
|
let firstof first active =
|
|
if first > active || abs (first - active) > fstate.maxrows - 1
|
|
then max 0 (active - (fstate.maxrows/2))
|
|
else first
|
|
|
|
let calcfirst first active =
|
|
if active > first
|
|
then
|
|
let rows = active - first in
|
|
if rows > fstate.maxrows then active - fstate.maxrows else first
|
|
else active
|
|
|
|
let enttext () =
|
|
let len = String.length !S.text in
|
|
let x0 = if conf.leftscroll then vscrollw () else 0 in
|
|
let drawstring s =
|
|
let hscrollh =
|
|
match !S.mode with
|
|
| Textentry _ | View | LinkNav _ ->
|
|
let h, _, _ = !S.uioh#scrollpw in
|
|
h
|
|
| Birdseye _ -> 0
|
|
in
|
|
let rect x w =
|
|
filledrect
|
|
x (float (!S.winh - (fstate.fontsize + 4) - hscrollh))
|
|
(x+.w) (float (!S.winh - hscrollh))
|
|
in
|
|
|
|
let w = float (!S.winw - 1 - vscrollw ()) in
|
|
if !S.progress >= 0.0 && !S.progress < 1.0
|
|
then (
|
|
GlDraw.color (0.3, 0.3, 0.3);
|
|
let w1 = w *. !S.progress in
|
|
rect (float x0) w1;
|
|
GlDraw.color (0.0, 0.0, 0.0);
|
|
rect (float x0+.w1) (float x0+.w-.w1)
|
|
)
|
|
else (
|
|
GlDraw.color (0.0, 0.0, 0.0);
|
|
rect (float x0) w;
|
|
);
|
|
|
|
GlDraw.color (1.0, 1.0, 1.0);
|
|
drawstring
|
|
fstate.fontsize
|
|
(if conf.leftscroll then x0 + 2 else x0 + if len > 0 then 8 else 2)
|
|
(!S.winh - hscrollh - 5) s;
|
|
in
|
|
let s =
|
|
match !S.mode with
|
|
| Textentry ((prefix, text, _, _, _, _), _) ->
|
|
let s =
|
|
if len > 0
|
|
then Printf.sprintf "%s%s_ [%s]" prefix text !S.text
|
|
else Printf.sprintf "%s%s_" prefix text
|
|
in
|
|
s
|
|
|
|
| Birdseye _ | View | LinkNav _ -> !S.text
|
|
in
|
|
if nonemptystr s
|
|
then drawstring s
|
|
|
|
let textentrykeyboard
|
|
key mask ((c, text, opthist, onkey, ondone, cancelonempty), onleave) =
|
|
S.text := E.s;
|
|
let enttext te =
|
|
S.mode := Textentry (te, onleave);
|
|
enttext ();
|
|
postRedisplay "textentrykeyboard enttext";
|
|
in
|
|
let histaction cmd =
|
|
match opthist with
|
|
| None -> ()
|
|
| Some (action, _) ->
|
|
let te = (c, action cmd, opthist, onkey, ondone, cancelonempty) in
|
|
S.mode := Textentry (te, onleave);
|
|
postRedisplay "textentry histaction"
|
|
in
|
|
let open Keys in
|
|
let kt = Wsi.ks2kt key in
|
|
match [@warning "-fragile-match"] kt with
|
|
| Backspace ->
|
|
if emptystr text && cancelonempty
|
|
then (
|
|
onleave Cancel;
|
|
postRedisplay "textentrykeyboard after cancel";
|
|
)
|
|
else
|
|
let s = withoutlastutf8 text in
|
|
enttext (c, s, opthist, onkey, ondone, cancelonempty)
|
|
|
|
| Enter ->
|
|
ondone text;
|
|
onleave Confirm;
|
|
postRedisplay "textentrykeyboard after confirm"
|
|
|
|
| Up -> histaction HCprev
|
|
| Down -> histaction HCnext
|
|
| Home -> histaction HCfirst
|
|
| End -> histaction HClast
|
|
|
|
| Escape ->
|
|
if emptystr text
|
|
then (
|
|
begin match opthist with
|
|
| None -> ()
|
|
| Some (_, onhistcancel) -> onhistcancel ()
|
|
end;
|
|
onleave Cancel;
|
|
S.text := E.s;
|
|
postRedisplay "textentrykeyboard after cancel2"
|
|
)
|
|
else enttext (c, E.s, opthist, onkey, ondone, cancelonempty)
|
|
|
|
| Delete -> ()
|
|
|
|
| Insert when Wsi.withshift mask ->
|
|
let s = getcmdoutput (fun s ->
|
|
prerr_endline ("error pasting: " ^ s)) conf.pastecmd in
|
|
enttext (c, s, opthist, onkey, ondone, cancelonempty)
|
|
|
|
| Code _ | Ascii _ ->
|
|
begin match onkey text kt with
|
|
| TEdone text ->
|
|
ondone text;
|
|
onleave Confirm;
|
|
postRedisplay "textentrykeyboard after confirm2";
|
|
|
|
| TEcont text -> enttext (c, text, opthist, onkey, ondone, cancelonempty);
|
|
|
|
| TEstop ->
|
|
onleave Cancel;
|
|
postRedisplay "textentrykeyboard after cancel3";
|
|
|
|
| TEswitch te ->
|
|
S.mode := Textentry (te, onleave);
|
|
postRedisplay "textentrykeyboard switch";
|
|
end
|
|
| _ -> vlog "unhandled key"
|
|
|
|
class type lvsource =
|
|
object
|
|
method getitemcount : int
|
|
method getitem : int -> (string * int)
|
|
method hasaction : int -> bool
|
|
method exit : uioh:uioh ->
|
|
cancel:bool ->
|
|
active:int ->
|
|
first:int ->
|
|
pan:int ->
|
|
uioh option
|
|
method getactive : int
|
|
method getfirst : int
|
|
method getpan : int
|
|
method getminfo : (int * int) array
|
|
end
|
|
|
|
class virtual lvsourcebase =
|
|
object
|
|
val mutable m_active = 0
|
|
val mutable m_first = 0
|
|
val mutable m_pan = 0
|
|
method getactive = m_active
|
|
method getfirst = m_first
|
|
method getpan = m_pan
|
|
method getminfo : (int * int) array = E.a
|
|
end
|
|
|
|
let coe s = (s :> uioh)
|
|
let setuioh uioh = S.uioh := coe uioh
|
|
|
|
let changetitle uioh =
|
|
let title = uioh#title in
|
|
Wsi.settitle @@ if emptystr title then "llpp" else title ^ " - llpp";
|
|
|
|
class listview ~zebra ~helpmode ~(source:lvsource) ~trusted ~modehash =
|
|
object (self)
|
|
val m_pan = source#getpan
|
|
val m_first = source#getfirst
|
|
val m_active = source#getactive
|
|
val m_qsearch = E.s
|
|
val m_prev_uioh = !S.uioh
|
|
|
|
method private elemunder y =
|
|
if y < 0
|
|
then None
|
|
else
|
|
let n = y / (fstate.fontsize+1) in
|
|
if m_first + n < source#getitemcount
|
|
then (
|
|
if source#hasaction (m_first + n)
|
|
then Some (m_first + n)
|
|
else None
|
|
)
|
|
else None
|
|
|
|
method display =
|
|
Gl.enable `blend;
|
|
GlFunc.blend_func ~src:`src_alpha ~dst:`one_minus_src_alpha;
|
|
GlDraw.color (0., 0., 0.) ~alpha:0.85;
|
|
filledrect 0. 0. (float !S.winw) (float !S.winh);
|
|
GlDraw.color (1., 1., 1.);
|
|
Gl.enable `texture_2d;
|
|
let fs = fstate.fontsize in
|
|
let nfs = fs + 1 in
|
|
let hw = !S.winw/3 in
|
|
let ww = fstate.wwidth in
|
|
let tabw = 17.0*.ww in
|
|
let itemcount = source#getitemcount in
|
|
let minfo = source#getminfo in
|
|
if conf.leftscroll
|
|
then (
|
|
GlMat.push ();
|
|
GlMat.translate ~x:(float conf.scrollbw) ();
|
|
);
|
|
let x0 = 0.0 and x1 = float (!S.winw - conf.scrollbw - 1) in
|
|
let rec loop row =
|
|
if not ((row - m_first) > fstate.maxrows)
|
|
then (
|
|
if row >= 0 && row < itemcount
|
|
then (
|
|
let (s, level) = source#getitem row in
|
|
let y = (row - m_first) * nfs in
|
|
let x = 5.0 +. (float (level + m_pan)) *. ww in
|
|
if helpmode
|
|
then GlDraw.color
|
|
(let c = if row land 1 = 0 then 1.0 else 0.92 in (c,c,c));
|
|
|
|
if row = m_active
|
|
then (
|
|
Gl.disable `texture_2d;
|
|
let alpha = if source#hasaction row then 0.9 else 0.3 in
|
|
GlDraw.color (1., 1., 1.) ~alpha;
|
|
linerect (x0 +. 1.) (float (y + 1)) (x1) (float (y + fs + 3));
|
|
Gl.enable `texture_2d;
|
|
);
|
|
let c =
|
|
if zebra && row land 1 = 1
|
|
then 0.8
|
|
else 1.0
|
|
in
|
|
GlDraw.color (c,c,c);
|
|
let drawtabularstring s =
|
|
let drawstr x s =
|
|
let x' = truncate (x0 +. x) in
|
|
let s1, s2 = splitatchar s '\000' in
|
|
if emptystr s2
|
|
then Ffi.drawstr fs x' (y+nfs) s
|
|
else
|
|
let rec e s =
|
|
if emptystr s
|
|
then s
|
|
else
|
|
let s' = withoutlastutf8 s in
|
|
let s = s' ^ Utf8syms.ellipsis in
|
|
let w = Ffi.measurestr fs s in
|
|
if float x' +. w +. ww < float (hw + x')
|
|
then s
|
|
else e s'
|
|
in
|
|
let s1 =
|
|
if float x' +. ww +. Ffi.measurestr fs s1 > float (hw + x')
|
|
then e s1
|
|
else s1
|
|
in
|
|
ignore (Ffi.drawstr fs x' (y+nfs) s1);
|
|
Ffi.drawstr fs (hw + x') (y+nfs) s2
|
|
in
|
|
if trusted
|
|
then
|
|
let x = if helpmode && row > 0 then x +. ww else x in
|
|
let s1, s2 = splitatchar s '\t' in
|
|
if nonemptystr s2
|
|
then
|
|
let nx = drawstr x s1 in
|
|
let sw = nx -. x in
|
|
let x = x +. (max tabw sw) in
|
|
drawstr x s2
|
|
else
|
|
let len = String.length s - 2 in
|
|
if len > 0 && s.[0] = '\xc2' && s.[1] = '\xb7'
|
|
then
|
|
let s = String.sub s 2 len in
|
|
let x = if not helpmode then x +. ww else x in
|
|
GlDraw.color (1.2, 1.2, 1.2);
|
|
let vinc = Ffi.drawstr (fs+fs/4)
|
|
(truncate (x -. ww)) (y+nfs) s in
|
|
GlDraw.color (1., 1., 1.);
|
|
vinc +. (float fs *. 0.8)
|
|
else drawstr x s
|
|
else drawstr x s
|
|
in
|
|
ignore (drawtabularstring s);
|
|
loop (row+1)
|
|
)
|
|
)
|
|
in
|
|
loop m_first;
|
|
GlDraw.color (1.0, 1.0, 1.0) ~alpha:0.5;
|
|
let xadj = 5.0 in
|
|
let rec loop row =
|
|
if (row - m_first) <= fstate.maxrows
|
|
then
|
|
if row >= 0 && row < itemcount
|
|
then
|
|
let (s, level) = source#getitem row in
|
|
let pos0 = Ne.index s '\000' in
|
|
let y = (row - m_first) * nfs in
|
|
let x = float (level + m_pan) *. ww in
|
|
let (first, last) = minfo.(row) in
|
|
let prefix =
|
|
if pos0 > 0 && first > pos0
|
|
then String.sub s (pos0+1) (first-pos0-1)
|
|
else String.sub s 0 first
|
|
in
|
|
let suffix = String.sub s first (last - first) in
|
|
let w1 = Ffi.measurestr fstate.fontsize prefix in
|
|
let w2 = Ffi.measurestr fstate.fontsize suffix in
|
|
let x = x +. if conf.leftscroll then xadj else 5.0 in
|
|
let x = if pos0 > 0 && first > pos0 then x +. float hw else x in
|
|
let x0 = x +. w1
|
|
and y0 = float (y+2) in
|
|
let x1 = x0 +. w2
|
|
and y1 = float (y+fs+3) in
|
|
filledrect x0 y0 x1 y1;
|
|
loop (row+1)
|
|
in
|
|
Gl.disable `texture_2d;
|
|
if Array.length minfo > 0 then loop m_first;
|
|
Gl.disable `blend;
|
|
if conf.leftscroll
|
|
then GlMat.pop ()
|
|
|
|
method nextcurlevel incr =
|
|
let len = source#getitemcount in
|
|
let curlevel =
|
|
if m_active >= 0 && m_active < len
|
|
then snd (source#getitem m_active)
|
|
else -1
|
|
in
|
|
let rec flow i =
|
|
if i = len
|
|
then i-1
|
|
else (
|
|
if i < 0
|
|
then 0
|
|
else
|
|
let _, l = source#getitem i in
|
|
if l <= curlevel then i else flow (i+incr)
|
|
)
|
|
in
|
|
let active = flow (m_active+incr) in
|
|
let first = calcfirst m_first active in
|
|
postRedisplay "listview nextcurlevel";
|
|
{< m_active = active; m_first = first >}
|
|
|
|
method updownlevel incr =
|
|
let len = source#getitemcount in
|
|
let curlevel =
|
|
if m_active >= 0 && m_active < len
|
|
then snd (source#getitem m_active)
|
|
else -1
|
|
in
|
|
let rec flow i =
|
|
if i = len
|
|
then i-1
|
|
else (
|
|
if i = -1 then 0 else
|
|
let _, l = source#getitem i in
|
|
if l != curlevel then i else flow (i+incr)
|
|
)
|
|
in
|
|
let active = flow m_active in
|
|
let first = calcfirst m_first active in
|
|
postRedisplay "listview updownlevel";
|
|
{< m_active = active; m_first = first >}
|
|
|
|
method private key1 key mask =
|
|
let set1 active first qsearch =
|
|
coe {< m_active = active; m_first = first; m_qsearch = qsearch >}
|
|
in
|
|
let search active pattern incr =
|
|
let active = if active = -1 then m_first else active in
|
|
let dosearch re =
|
|
let rec loop n =
|
|
if n >= 0 && n < source#getitemcount
|
|
then (
|
|
let s, _ = source#getitem n in
|
|
match Str.search_forward re s 0 with
|
|
| exception Not_found -> loop (n + incr)
|
|
| _ -> Some n
|
|
)
|
|
else None
|
|
in
|
|
loop active
|
|
in
|
|
let qpat = Str.quote pattern in
|
|
match Str.regexp_case_fold qpat with
|
|
| s -> dosearch s
|
|
| exception exn ->
|
|
dolog "regexp_case_fold for `%S' failed: %S\n" qpat @@
|
|
Printexc.to_string exn;
|
|
None
|
|
in
|
|
let itemcount = source#getitemcount in
|
|
let find start incr =
|
|
let rec find i =
|
|
if i = -1 || i = itemcount
|
|
then -1
|
|
else (
|
|
if source#hasaction i
|
|
then i
|
|
else find (i + incr)
|
|
)
|
|
in
|
|
find start
|
|
in
|
|
let set active first =
|
|
let first = bound first 0 (itemcount - fstate.maxrows) in
|
|
S.text := E.s;
|
|
coe {< m_active = active; m_first = first; m_qsearch = E.s >}
|
|
in
|
|
let navigate incr =
|
|
let isvisible first n = n >= first && n - first <= fstate.maxrows in
|
|
let active, first =
|
|
let incr1 = if incr > 0 then 1 else -1 in
|
|
if isvisible m_first m_active
|
|
then
|
|
let next =
|
|
let next = m_active + incr in
|
|
let next =
|
|
if next < 0 || next >= itemcount
|
|
then -1
|
|
else find next incr1
|
|
in
|
|
if abs (m_active - next) > fstate.maxrows
|
|
then -1
|
|
else next
|
|
in
|
|
if next = -1
|
|
then
|
|
let first = m_first + incr in
|
|
let first = bound first 0 (itemcount - fstate.maxrows) in
|
|
let next =
|
|
let next = m_active + incr in
|
|
let next = bound next 0 (itemcount - 1) in
|
|
find next ~-incr1
|
|
in
|
|
let active =
|
|
if next = -1
|
|
then m_active
|
|
else (
|
|
if isvisible first next
|
|
then next
|
|
else m_active
|
|
)
|
|
in
|
|
active, first
|
|
else
|
|
let first = min next m_first in
|
|
let first =
|
|
if abs (next - first) > fstate.maxrows
|
|
then first + incr
|
|
else first
|
|
in
|
|
next, first
|
|
else
|
|
let first = m_first + incr in
|
|
let first = bound first 0 (itemcount - 1) in
|
|
let active =
|
|
let next = m_active + incr in
|
|
let next = bound next 0 (itemcount - 1) in
|
|
let next = find next incr1 in
|
|
let active =
|
|
if next = -1 || abs (m_active - first) > fstate.maxrows
|
|
then (
|
|
let active = if m_active = -1 then next else m_active in
|
|
active
|
|
)
|
|
else next
|
|
in
|
|
if isvisible first active
|
|
then active
|
|
else -1
|
|
in
|
|
active, first
|
|
in
|
|
postRedisplay "listview navigate";
|
|
set active first;
|
|
in
|
|
let open Keys in
|
|
let kt = Wsi.ks2kt key in
|
|
match [@warning "-fragile-match"] kt with
|
|
| Ascii (('r'|'s') as c) when Wsi.withctrl mask ->
|
|
let incr = if c = 'r' then -1 else 1 in
|
|
let active, first =
|
|
match search (m_active + incr) m_qsearch incr with
|
|
| None ->
|
|
S.text := m_qsearch ^ " [not found]";
|
|
m_active, m_first
|
|
| Some active ->
|
|
S.text := m_qsearch;
|
|
active, firstof m_first active
|
|
in
|
|
postRedisplay "listview ctrl-r/s";
|
|
set1 active first m_qsearch;
|
|
|
|
| Insert when Wsi.withctrl mask ->
|
|
if m_active >= 0 && m_active < source#getitemcount
|
|
then (
|
|
let s, _ = source#getitem m_active in
|
|
selstring conf.selcmd s;
|
|
);
|
|
coe self
|
|
|
|
| Backspace ->
|
|
if emptystr m_qsearch
|
|
then coe self
|
|
else (
|
|
let qsearch = withoutlastutf8 m_qsearch in
|
|
if emptystr qsearch
|
|
then (
|
|
S.text := E.s;
|
|
postRedisplay "listview empty qsearch";
|
|
set1 m_active m_first E.s;
|
|
)
|
|
else
|
|
let active, first =
|
|
match search m_active qsearch ~-1 with
|
|
| None ->
|
|
S.text := qsearch ^ " [not found]";
|
|
m_active, m_first
|
|
| Some active ->
|
|
S.text := qsearch;
|
|
active, firstof m_first active
|
|
in
|
|
postRedisplay "listview backspace qsearch";
|
|
set1 active first qsearch
|
|
);
|
|
|
|
| Ascii _ | Code _ ->
|
|
let utf8 =
|
|
match [@warning "-partial-match"] kt with
|
|
| Ascii c -> String.make 1 c
|
|
| Code code -> Ffi.toutf8 code
|
|
in
|
|
let pattern = m_qsearch ^ utf8 in
|
|
let active, first =
|
|
match search m_active pattern 1 with
|
|
| None ->
|
|
S.text := pattern ^ " [not found]";
|
|
m_active, m_first
|
|
| Some active ->
|
|
S.text := pattern;
|
|
active, firstof m_first active
|
|
in
|
|
postRedisplay "listview qsearch add";
|
|
set1 active first pattern;
|
|
|
|
| Escape ->
|
|
S.text := E.s;
|
|
if emptystr m_qsearch
|
|
then (
|
|
postRedisplay "list view escape";
|
|
(* XXX:
|
|
let mx, my = state.mpos in
|
|
updateunder mx my;
|
|
*)
|
|
Option.value ~default:m_prev_uioh @@
|
|
source#exit ~uioh:(coe self) ~cancel:true ~active:m_active
|
|
~first:m_first ~pan:m_pan
|
|
)
|
|
else (
|
|
postRedisplay "list view kill qsearch";
|
|
coe {< m_qsearch = E.s >}
|
|
)
|
|
|
|
| Enter ->
|
|
S.text := E.s;
|
|
let self = {< m_qsearch = E.s >} in
|
|
let opt =
|
|
postRedisplay "listview enter";
|
|
let cancel = not (m_active >= 0 && m_active < source#getitemcount) in
|
|
source#exit ~uioh:(coe self) ~cancel
|
|
~active:m_active ~first:m_first ~pan:m_pan;
|
|
in
|
|
Option.value ~default:m_prev_uioh opt
|
|
|
|
| Delete -> coe self
|
|
| Up -> navigate ~-1
|
|
| Down -> navigate 1
|
|
| Prior -> navigate ~-(fstate.maxrows)
|
|
| Next -> navigate fstate.maxrows
|
|
|
|
| Right ->
|
|
S.text := E.s;
|
|
postRedisplay "listview right";
|
|
coe {< m_pan = m_pan - 1 >}
|
|
|
|
| Left ->
|
|
S.text := E.s;
|
|
postRedisplay "listview left";
|
|
coe {< m_pan = m_pan + 1 >}
|
|
|
|
| Home ->
|
|
let active = find 0 1 in
|
|
postRedisplay "listview home";
|
|
set active 0;
|
|
|
|
| End ->
|
|
let first = max 0 (itemcount - fstate.maxrows) in
|
|
let active = find (itemcount - 1) ~-1 in
|
|
postRedisplay "listview end";
|
|
set active first;
|
|
|
|
| _ -> coe self
|
|
|
|
method key key mask =
|
|
match !S.mode with
|
|
| Textentry te ->
|
|
textentrykeyboard key mask te;
|
|
coe self
|
|
| Birdseye _ | View | LinkNav _ -> self#key1 key mask
|
|
|
|
method button button down x y _ =
|
|
let opt =
|
|
match button with
|
|
| 1 when vscrollhit x ->
|
|
postRedisplay "listview scroll";
|
|
if down
|
|
then
|
|
let _, position, sh = self#scrollph in
|
|
if y > truncate position && y < truncate (position +. sh)
|
|
then (
|
|
S.mstate := Mscrolly;
|
|
Some (coe self)
|
|
)
|
|
else
|
|
let s = float (max 0 (y - conf.scrollh)) /. float !S.winh in
|
|
let first = truncate (s *. float source#getitemcount) in
|
|
let first = min source#getitemcount first in
|
|
Some (coe {< m_first = first; m_active = first >})
|
|
else (
|
|
S.mstate := Mnone;
|
|
Some (coe self);
|
|
);
|
|
| 1 when down ->
|
|
begin match self#elemunder y with
|
|
| Some n ->
|
|
postRedisplay "listview click";
|
|
source#exit ~uioh:(coe {< m_active = n >})
|
|
~cancel:false ~active:n ~first:m_first ~pan:m_pan
|
|
| _ -> Some (coe self)
|
|
end
|
|
| n when (n == 4 || n == 5) && not down ->
|
|
let len = source#getitemcount in
|
|
let first =
|
|
if n = 5 && m_first + fstate.maxrows >= len
|
|
then m_first
|
|
else
|
|
let first = m_first + (if n == 4 then -1 else 1) in
|
|
bound first 0 (len - 1)
|
|
in
|
|
postRedisplay "listview wheel";
|
|
Some (coe {< m_first = first >})
|
|
| n when (n = 6 || n = 7) && not down ->
|
|
let inc = if n = 7 then -1 else 1 in
|
|
postRedisplay "listview hwheel";
|
|
Some (coe {< m_pan = m_pan + inc >})
|
|
| _ -> Some (coe self)
|
|
in
|
|
Option.value ~default:m_prev_uioh opt
|
|
|
|
method multiclick _ x y = self#button 1 true x y
|
|
|
|
method motion _ y =
|
|
match !S.mstate with
|
|
| Mscrolly ->
|
|
let s = float (max 0 (y - conf.scrollh)) /. float !S.winh in
|
|
let first = truncate (s *. float source#getitemcount) in
|
|
let first = min source#getitemcount first in
|
|
postRedisplay "listview motion";
|
|
coe {< m_first = first; m_active = first >}
|
|
| Msel _
|
|
| Mpan _
|
|
| Mscrollx
|
|
| Mzoom _
|
|
| Mzoomrect _
|
|
| Mnone -> coe self
|
|
|
|
method pmotion x y =
|
|
if x < !S.winw - conf.scrollbw
|
|
then
|
|
let n =
|
|
match self#elemunder y with
|
|
| None -> Wsi.setcursor Wsi.CURSOR_INHERIT; m_active
|
|
| Some n -> Wsi.setcursor Wsi.CURSOR_INFO; n
|
|
in
|
|
let o =
|
|
if n != m_active
|
|
then (postRedisplay "listview pmotion"; {< m_active = n >})
|
|
else self
|
|
in
|
|
coe o
|
|
else (
|
|
Wsi.setcursor Wsi.CURSOR_INHERIT;
|
|
coe self
|
|
)
|
|
|
|
method infochanged _ = ()
|
|
|
|
method scrollpw = (0, 0.0, 0.0)
|
|
method scrollph =
|
|
let nfs = fstate.fontsize + 1 in
|
|
let y = m_first * nfs in
|
|
let itemcount = source#getitemcount in
|
|
let maxi = max 0 (itemcount - fstate.maxrows) in
|
|
let maxy = maxi * nfs in
|
|
let p, h = scrollph y maxy in
|
|
conf.scrollbw, p, h
|
|
|
|
method modehash = modehash
|
|
method eformsgs = false
|
|
method alwaysscrolly = true
|
|
method scroll _ dy =
|
|
let self =
|
|
if dy != 0
|
|
then (
|
|
let len = source#getitemcount in
|
|
let first =
|
|
if dy > 0 && m_first + fstate.maxrows >= len
|
|
then m_first
|
|
else
|
|
let first = m_first + dy / 10 in
|
|
bound first 0 (len - 1)
|
|
in
|
|
postRedisplay "listview wheel";
|
|
{< m_first = first >}
|
|
)
|
|
else self
|
|
in
|
|
coe self
|
|
|
|
method zoom _ _ _ = ()
|
|
end
|