listview.ml

   1 open Utils;;
   2 open Glutils;;
   3 open Config;;
   4
   5 let scrollph y maxy =
   6   let sh = float (maxy + state.winh) /. float state.winh in
   7   let sh = float state.winh /. sh in
   8   let sh = max sh (float conf.scrollh) in
   9
  10   let percent = float y /. float maxy in
  11   let position = (float state.winh -. sh) *. percent in
  12
  13   let position =
  14     if position +. sh > float state.winh
  15     then float state.winh -. sh
  16     else position
  17   in
  18   position, sh;
  19 ;;
  20
  21 let isbirdseye = function
  22   | Birdseye _ -> true
  23   | Textentry _ | View | LinkNav _ -> false
  24 ;;
  25
  26 let istextentry = function
  27   | Textentry _ -> true
  28   | Birdseye _ | View | LinkNav _ -> false
  29 ;;
  30
  31 let vscrollw () =
  32   if state.uioh#alwaysscrolly || ((conf.scrollb land scrollbvv != 0)
  33                                   && (state.maxy > state.winh))
  34   then conf.scrollbw
  35   else 0
  36 ;;
  37
  38 let vscrollhit x =
  39   if conf.leftscroll
  40   then x < vscrollw ()
  41   else x > state.winw - vscrollw ()
  42 ;;
  43
  44 let firstof first active =
  45   if first > active || abs (first - active) > fstate.maxrows - 1
  46   then max 0 (active - (fstate.maxrows/2))
  47   else first
  48 ;;
  49
  50 let calcfirst first active =
  51   if active > first
  52   then
  53     let rows = active - first in
  54     if rows > fstate.maxrows then active - fstate.maxrows else first
  55   else active
  56 ;;
  57
  58 let enttext () =
  59   let len = String.length state.text in
  60   let x0 = if conf.leftscroll then vscrollw () else 0 in
  61   let drawstring s =
  62     let hscrollh =
  63       match state.mode with
  64       | Textentry _ | View | LinkNav _ ->
  65          let h, _, _ = state.uioh#scrollpw in
  66          h
  67       | Birdseye _ -> 0
  68     in
  69     let rect x w =
  70       filledrect
  71         x      (float (state.winh - (fstate.fontsize + 4) - hscrollh))
  72         (x+.w) (float (state.winh - hscrollh))
  73     in
  74
  75     let w = float (state.winw - 1 - vscrollw ()) in
  76     if state.progress >= 0.0 && state.progress < 1.0
  77     then (
  78       GlDraw.color (0.3, 0.3, 0.3);
  79       let w1 = w *. state.progress in
  80       rect (float x0) w1;
  81       GlDraw.color (0.0, 0.0, 0.0);
  82       rect (float x0+.w1) (float x0+.w-.w1)
  83     )
  84     else (
  85       GlDraw.color (0.0, 0.0, 0.0);
  86       rect (float x0) w;
  87     );
  88
  89     GlDraw.color (1.0, 1.0, 1.0);
  90     drawstring
  91       fstate.fontsize
  92       (if conf.leftscroll then x0 + 2 else x0 + if len > 0 then 8 else 2)
  93       (state.winh - hscrollh - 5) s;
  94   in
  95   let s =
  96     match state.mode with
  97     | Textentry ((prefix, text, _, _, _, _), _) ->
  98        let s =
  99          if len > 0
 100          then Printf.sprintf "%s%s_ [%s]" prefix text state.text
 101          else Printf.sprintf "%s%s_"  prefix text
 102        in
 103        s
 104
 105     | Birdseye _ | View | LinkNav _ -> state.text
 106   in
 107   let s =
 108     if state.newerrmsgs
 109     then (
 110       if not (istextentry state.mode) && state.uioh#eformsgs
 111       then
 112         let s1 = "(press 'e' to review error messasges)" in
 113         if nonemptystr s then s ^ " " ^ s1 else s1
 114       else s
 115     )
 116     else s
 117   in
 118   if nonemptystr s
 119   then drawstring s
 120 ;;
 121
 122 let textentrykeyboard
 123       key mask ((c, text, opthist, onkey, ondone, cancelonempty), onleave) =
 124   state.text <- E.s;
 125   let enttext te =
 126     state.mode <- Textentry (te, onleave);
 127     enttext ();
 128     postRedisplay "textentrykeyboard enttext";
 129   in
 130   let histaction cmd =
 131     match opthist with
 132     | None -> ()
 133     | Some (action, _) ->
 134        state.mode <- Textentry (
 135                          (c, action cmd, opthist,
 136                           onkey, ondone, cancelonempty),
 137                          onleave);
 138        postRedisplay "textentry histaction"
 139   in
 140   let open Keys in
 141   let kt = Wsi.kc2kt key in
 142   match [@warning "-4"] kt with
 143   | Backspace ->
 144      if emptystr text && cancelonempty
 145      then (
 146        onleave Cancel;
 147        postRedisplay "textentrykeyboard after cancel";
 148      )
 149      else
 150        let s = withoutlastutf8 text in
 151        enttext (c, s, opthist, onkey, ondone, cancelonempty)
 152
 153   | Enter ->
 154      ondone text;
 155      onleave Confirm;
 156      postRedisplay "textentrykeyboard after confirm"
 157
 158   | Up   -> histaction HCprev
 159   | Down -> histaction HCnext
 160   | Home -> histaction HCfirst
 161   | End  -> histaction HClast
 162
 163   | Escape ->
 164      if emptystr text
 165      then (
 166        begin match opthist with
 167        | None -> ()
 168        | Some (_, onhistcancel) -> onhistcancel ()
 169        end;
 170        onleave Cancel;
 171        state.text <- E.s;
 172        postRedisplay "textentrykeyboard after cancel2"
 173      )
 174      else enttext (c, E.s, opthist, onkey, ondone, cancelonempty)
 175
 176   | Delete -> ()
 177
 178   | Insert when Wsi.withshift mask ->
 179      let s = getcmdoutput (fun s ->
 180                  prerr_endline ("error pasting: " ^ s)) conf.pastecmd in
 181      enttext (c, s, opthist, onkey, ondone, cancelonempty)
 182
 183   | Code _ | Ascii _ ->
 184      begin match onkey text kt with
 185      | TEdone text ->
 186         ondone text;
 187         onleave Confirm;
 188         postRedisplay "textentrykeyboard after confirm2";
 189
 190      | TEcont text ->
 191         enttext (c, text, opthist, onkey, ondone, cancelonempty);
 192
 193      | TEstop ->
 194         onleave Cancel;
 195         postRedisplay "textentrykeyboard after cancel3";
 196
 197      | TEswitch te ->
 198         state.mode <- Textentry (te, onleave);
 199         postRedisplay "textentrykeyboard switch";
 200      end
 201   | _ -> vlog "unhandled key"
 202 ;;
 203
 204 class type lvsource =
 205   object
 206     method getitemcount : int
 207     method getitem : int -> (string * int)
 208     method hasaction : int -> bool
 209     method exit : uioh:uioh ->
 210                   cancel:bool ->
 211                   active:int ->
 212                   first:int ->
 213                   pan:int ->
 214                   uioh option
 215     method getactive : int
 216     method getfirst : int
 217     method getpan : int
 218     method getminfo : (int * int) array
 219   end;;
 220
 221 class virtual lvsourcebase =
 222         object
 223           val mutable m_active = 0
 224           val mutable m_first = 0
 225           val mutable m_pan = 0
 226           method getactive = m_active
 227           method getfirst = m_first
 228           method getpan = m_pan
 229           method getminfo : (int * int) array = E.a
 230         end;;
 231
 232 let coe s = (s :> uioh);;
 233
 234 class listview ~zebra ~helpmode ~(source:lvsource) ~trusted ~modehash =
 235 object (self)
 236   val m_pan = source#getpan
 237   val m_first = source#getfirst
 238   val m_active = source#getactive
 239   val m_qsearch = E.s
 240   val m_prev_uioh = state.uioh
 241
 242   method private elemunder y =
 243     if y < 0
 244     then None
 245     else
 246       let n = y / (fstate.fontsize+1) in
 247       if m_first + n < source#getitemcount
 248       then (
 249         if source#hasaction (m_first + n)
 250         then Some (m_first + n)
 251         else None
 252       )
 253       else None
 254
 255   method display =
 256     Gl.enable `blend;
 257     GlFunc.blend_func ~src:`src_alpha ~dst:`one_minus_src_alpha;
 258     GlDraw.color (0., 0., 0.) ~alpha:0.85;
 259     filledrect 0. 0. (float state.winw) (float state.winh);
 260     GlDraw.color (1., 1., 1.);
 261     Gl.enable `texture_2d;
 262     let fs = fstate.fontsize in
 263     let nfs = fs + 1 in
 264     let hw = state.winw/3 in
 265     let ww = fstate.wwidth in
 266     let tabw = 17.0*.ww in
 267     let itemcount = source#getitemcount in
 268     let minfo = source#getminfo in
 269     if conf.leftscroll
 270     then (
 271       GlMat.push ();
 272       GlMat.translate ~x:(float conf.scrollbw) ();
 273     );
 274     let x0 = 0.0 and x1 = float (state.winw - conf.scrollbw - 1) in
 275     let rec loop row =
 276       if not ((row - m_first) > fstate.maxrows)
 277       then (
 278         if row >= 0 && row < itemcount
 279         then (
 280           let (s, level) = source#getitem row in
 281           let y = (row - m_first) * nfs in
 282           let x = 5.0 +. (float (level + m_pan)) *. ww in
 283           if helpmode
 284           then GlDraw.color
 285                  (let c = if row land 1 = 0 then 1.0 else 0.92 in (c,c,c));
 286
 287           if row = m_active
 288           then (
 289             Gl.disable `texture_2d;
 290             let alpha = if source#hasaction row then 0.9 else 0.3 in
 291             GlDraw.color (1., 1., 1.) ~alpha;
 292             linerect (x0 +. 1.) (float (y + 1)) (x1) (float (y + fs + 3));
 293             Gl.enable `texture_2d;
 294           );
 295           let c =
 296             if zebra && row land 1 = 1
 297             then 0.8
 298             else 1.0
 299           in
 300           GlDraw.color (c,c,c);
 301           let drawtabularstring s =
 302             let drawstr x s =
 303               let x' = truncate (x0 +. x) in
 304               let s1, s2 = splitatchar s '\000' in
 305               if emptystr s2
 306               then drawstring1 fs x' (y+nfs) s
 307               else
 308                 let rec e s =
 309                   if emptystr s
 310                   then s
 311                   else
 312                     let s' = withoutlastutf8 s in
 313                     let s = s' ^ Utf8syms.ellipsis in
 314                     let w = measurestr fs s in
 315                     if float x' +. w +. ww < float (hw + x')
 316                     then s
 317                     else e s'
 318                 in
 319                 let s1 =
 320                   if float x' +. ww +. measurestr fs s1 > float (hw + x')
 321                   then e s1
 322                   else s1
 323                 in
 324                 ignore (drawstring1 fs x' (y+nfs) s1);
 325                 drawstring1 fs (hw + x') (y+nfs) s2
 326             in
 327             if trusted
 328             then
 329               let x = if helpmode && row > 0 then x +. ww else x in
 330               let s1, s2 = splitatchar s '\t' in
 331               if nonemptystr s2
 332               then
 333                 let nx = drawstr x s1 in
 334                 let sw = nx -. x in
 335                 let x = x +. (max tabw sw) in
 336                 drawstr x s2
 337               else
 338                 let len = String.length s - 2 in
 339                 if len > 0 && s.[0] = '\xc2' && s.[1] = '\xb7'
 340                 then
 341                   let s = String.sub s 2 len in
 342                   let x = if not helpmode then x +. ww else x in
 343                   GlDraw.color (1.2, 1.2, 1.2);
 344                   let vinc = drawstring1 (fs+fs/4)
 345                                          (truncate (x -. ww)) (y+nfs) s in
 346                   GlDraw.color (1., 1., 1.);
 347                   vinc +. (float fs *. 0.8)
 348                 else drawstr x s
 349             else drawstr x s
 350           in
 351           ignore (drawtabularstring s);
 352           loop (row+1)
 353         )
 354       )
 355     in
 356     loop m_first;
 357     GlDraw.color (1.0, 1.0, 1.0) ~alpha:0.5;
 358     let xadj = 5.0 in
 359     let rec loop row =
 360       if (row - m_first) <= fstate.maxrows
 361       then
 362         if row >= 0 && row < itemcount
 363         then
 364           let (s, level) = source#getitem row in
 365           let pos0 = Ne.index s '\000' in
 366           let y = (row - m_first) * nfs in
 367           let x = float (level + m_pan) *. ww in
 368           let (first, last) = minfo.(row) in
 369           let prefix =
 370             if pos0 > 0 && first > pos0
 371             then String.sub s (pos0+1) (first-pos0-1)
 372             else String.sub s 0 first
 373           in
 374           let suffix = String.sub s first (last - first) in
 375           let w1 = measurestr fstate.fontsize prefix in
 376           let w2 = measurestr fstate.fontsize suffix in
 377           let x = x +. if conf.leftscroll then xadj else 5.0 in
 378           let x = if pos0 > 0 && first > pos0 then x +. float hw else x in
 379           let x0 = x +. w1
 380           and y0 = float (y+2) in
 381           let x1 = x0 +. w2
 382           and y1 = float (y+fs+3) in
 383           filledrect x0 y0 x1 y1;
 384           loop (row+1)
 385     in
 386     Gl.disable `texture_2d;
 387     if Array.length minfo > 0 then loop m_first;
 388     Gl.disable `blend;
 389     if conf.leftscroll
 390     then GlMat.pop ()
 391
 392   method nextcurlevel incr =
 393     let len = source#getitemcount in
 394     let curlevel =
 395       if m_active >= 0 && m_active < len
 396       then snd (source#getitem m_active)
 397       else -1
 398     in
 399     let rec flow i =
 400       if i = len
 401       then i-1
 402       else (
 403         if i = -1
 404         then 0
 405         else
 406           let _, l = source#getitem i in
 407           if l <= curlevel then i else flow (i+incr)
 408       )
 409     in
 410     let active = flow (m_active+incr) in
 411     let first = calcfirst m_first active in
 412     postRedisplay "outline nextcurlevel";
 413     {< m_active = active; m_first = first >}
 414
 415   method updownlevel incr =
 416     let len = source#getitemcount in
 417     let curlevel =
 418       if m_active >= 0 && m_active < len
 419       then snd (source#getitem m_active)
 420       else -1
 421     in
 422     let rec flow i =
 423       if i = len
 424       then i-1
 425       else (
 426         if i = -1 then 0 else
 427           let _, l = source#getitem i in
 428           if l != curlevel then i else flow (i+incr)
 429       )
 430     in
 431     let active = flow m_active in
 432     let first = calcfirst m_first active in
 433     postRedisplay "outline updownlevel";
 434     {< m_active = active; m_first = first >}
 435
 436   method private key1 key mask =
 437     let set1 active first qsearch =
 438       coe {< m_active = active; m_first = first; m_qsearch = qsearch >}
 439     in
 440     let search active pattern incr =
 441       let active = if active = -1 then m_first else active in
 442       let dosearch re =
 443         let rec loop n =
 444           if n >= 0 && n < source#getitemcount
 445           then (
 446             let s, _ = source#getitem n in
 447             match Str.search_forward re s 0 with
 448             | exception Not_found -> loop (n + incr)
 449             | _ -> Some n
 450           )
 451           else None
 452         in
 453         loop active
 454       in
 455       let qpat = Str.quote pattern in
 456       match Str.regexp_case_fold qpat with
 457       | s -> dosearch s
 458       | exception exn ->
 459          dolog "regexp_case_fold for `%S' failed: %S\n" qpat @@
 460            Printexc.to_string exn;
 461          None
 462     in
 463     let itemcount = source#getitemcount in
 464     let find start incr =
 465       let rec find i =
 466         if i = -1 || i = itemcount
 467         then -1
 468         else (
 469           if source#hasaction i
 470           then i
 471           else find (i + incr)
 472         )
 473       in
 474       find start
 475     in
 476     let set active first =
 477       let first = bound first 0 (itemcount - fstate.maxrows) in
 478       state.text <- E.s;
 479       coe {< m_active = active; m_first = first; m_qsearch = E.s >}
 480     in
 481     let navigate incr =
 482       let isvisible first n = n >= first && n - first <= fstate.maxrows in
 483       let active, first =
 484         let incr1 = if incr > 0 then 1 else -1 in
 485         if isvisible m_first m_active
 486         then
 487           let next =
 488             let next = m_active + incr in
 489             let next =
 490               if next < 0 || next >= itemcount
 491               then -1
 492               else find next incr1
 493             in
 494             if abs (m_active - next) > fstate.maxrows
 495             then -1
 496             else next
 497           in
 498           if next = -1
 499           then
 500             let first = m_first + incr in
 501             let first = bound first 0 (itemcount - fstate.maxrows) in
 502             let next =
 503               let next = m_active + incr in
 504               let next = bound next 0 (itemcount - 1) in
 505               find next ~-incr1
 506             in
 507             let active =
 508               if next = -1
 509               then m_active
 510               else (
 511                 if isvisible first next
 512                 then next
 513                 else m_active
 514               )
 515             in
 516             active, first
 517           else
 518             let first = min next m_first in
 519             let first =
 520               if abs (next - first) > fstate.maxrows
 521               then first + incr
 522               else first
 523             in
 524             next, first
 525         else
 526           let first = m_first + incr in
 527           let first = bound first 0 (itemcount - 1) in
 528           let active =
 529             let next = m_active + incr in
 530             let next = bound next 0 (itemcount - 1) in
 531             let next = find next incr1 in
 532             let active =
 533               if next = -1 || abs (m_active - first) > fstate.maxrows
 534               then (
 535                 let active = if m_active = -1 then next else m_active in
 536                 active
 537               )
 538               else next
 539             in
 540             if isvisible first active
 541             then active
 542             else -1
 543           in
 544           active, first
 545       in
 546       postRedisplay "listview navigate";
 547       set active first;
 548     in
 549     let open Keys in
 550     let kt = Wsi.kc2kt key in
 551     match [@warning "-4"] kt with
 552     | Ascii (('r'|'s') as c) when Wsi.withctrl mask ->
 553        let incr = if c = 'r' then -1 else 1 in
 554        let active, first =
 555          match search (m_active + incr) m_qsearch incr with
 556          | None ->
 557             state.text <- m_qsearch ^ " [not found]";
 558             m_active, m_first
 559          | Some active ->
 560             state.text <- m_qsearch;
 561             active, firstof m_first active
 562        in
 563        postRedisplay "listview ctrl-r/s";
 564        set1 active first m_qsearch;
 565
 566     | Insert when Wsi.withctrl mask ->
 567        if m_active >= 0 && m_active < source#getitemcount
 568        then (
 569          let s, _ = source#getitem m_active in
 570          selstring conf.selcmd s;
 571        );
 572        coe self
 573
 574     | Backspace ->
 575        if emptystr m_qsearch
 576        then coe self
 577        else (
 578          let qsearch = withoutlastutf8 m_qsearch in
 579          if emptystr qsearch
 580          then (
 581            state.text <- E.s;
 582            postRedisplay "listview empty qsearch";
 583            set1 m_active m_first E.s;
 584          )
 585          else
 586            let active, first =
 587              match search m_active qsearch ~-1 with
 588              | None ->
 589                 state.text <- qsearch ^ " [not found]";
 590                 m_active, m_first
 591              | Some active ->
 592                 state.text <- qsearch;
 593                 active, firstof m_first active
 594            in
 595            postRedisplay "listview backspace qsearch";
 596            set1 active first qsearch
 597        );
 598
 599     | Ascii _ | Code _ ->
 600        let utf8 =
 601          match [@warning "-8"] kt with
 602          | Ascii c -> String.make 1 c
 603          | Code code -> toutf8 code
 604        in
 605        let pattern = m_qsearch ^ utf8 in
 606        let active, first =
 607          match search m_active pattern 1 with
 608          | None ->
 609             state.text <- pattern ^ " [not found]";
 610             m_active, m_first
 611          | Some active ->
 612             state.text <- pattern;
 613             active, firstof m_first active
 614        in
 615        postRedisplay "listview qsearch add";
 616        set1 active first pattern;
 617
 618     | Escape ->
 619        state.text <- E.s;
 620        if emptystr m_qsearch
 621        then (
 622          postRedisplay "list view escape";
 623          (* XXX:
 624              let mx, my = state.mpos in
 625              updateunder mx my;
 626           *)
 627          getoptdef m_prev_uioh @@
 628            source#exit ~uioh:(coe self) ~cancel:true ~active:m_active
 629              ~first:m_first ~pan:m_pan
 630        )
 631        else (
 632          postRedisplay "list view kill qsearch";
 633          coe {< m_qsearch = E.s >}
 634        )
 635
 636     | Enter ->
 637        state.text <- E.s;
 638        let self = {< m_qsearch = E.s >} in
 639        let opt =
 640          postRedisplay "listview enter";
 641          let cancel = not (m_active >= 0 && m_active < source#getitemcount) in
 642          source#exit ~uioh:(coe self) ~cancel
 643                      ~active:m_active ~first:m_first ~pan:m_pan;
 644        in
 645        getoptdef m_prev_uioh opt
 646
 647     | Delete -> coe self
 648     | Up    -> navigate ~-1
 649     | Down  -> navigate 1
 650     | Prior -> navigate ~-(fstate.maxrows)
 651     | Next  -> navigate fstate.maxrows
 652
 653     | Right ->
 654        state.text <- E.s;
 655        postRedisplay "listview right";
 656        coe {< m_pan = m_pan - 1 >}
 657
 658     | Left ->
 659        state.text <- E.s;
 660        postRedisplay "listview left";
 661        coe {< m_pan = m_pan + 1 >}
 662
 663     | Home ->
 664        let active = find 0 1 in
 665        postRedisplay "listview home";
 666        set active 0;
 667
 668     | End ->
 669        let first = max 0 (itemcount - fstate.maxrows) in
 670        let active = find (itemcount - 1) ~-1 in
 671        postRedisplay "listview end";
 672        set active first;
 673
 674     | _ -> coe self
 675
 676   method key key mask =
 677     match state.mode with
 678     | Textentry te ->
 679        textentrykeyboard key mask te;
 680        coe self
 681     | Birdseye _ | View | LinkNav _ -> self#key1 key mask
 682
 683   method button button down x y _ =
 684     let opt =
 685       match button with
 686       | 1 when vscrollhit x ->
 687          postRedisplay "listview scroll";
 688          if down
 689          then
 690            let _, position, sh = self#scrollph in
 691            if y > truncate position && y < truncate (position +. sh)
 692            then (
 693              state.mstate <- Mscrolly;
 694              Some (coe self)
 695            )
 696            else
 697              let s = float (max 0 (y - conf.scrollh)) /. float state.winh in
 698              let first = truncate (s *. float source#getitemcount) in
 699              let first = min source#getitemcount first in
 700              Some (coe {< m_first = first; m_active = first >})
 701          else (
 702            state.mstate <- Mnone;
 703            Some (coe self);
 704          );
 705       | 1 when down ->
 706          begin match self#elemunder y with
 707          | Some n ->
 708             postRedisplay "listview click";
 709             source#exit ~uioh:(coe {< m_active = n >})
 710                         ~cancel:false ~active:n ~first:m_first ~pan:m_pan
 711          | _ ->
 712             Some (coe self)
 713          end
 714       | n when (n == 4 || n == 5) && not down ->
 715          let len = source#getitemcount in
 716          let first =
 717            if n = 5 && m_first + fstate.maxrows >= len
 718            then m_first
 719            else
 720              let first = m_first + (if n == 4 then -1 else 1) in
 721              bound first 0 (len - 1)
 722          in
 723          postRedisplay "listview wheel";
 724          Some (coe {< m_first = first >})
 725       | n when (n = 6 || n = 7) && not down ->
 726          let inc = if n = 7 then -1 else 1 in
 727          postRedisplay "listview hwheel";
 728          Some (coe {< m_pan = m_pan + inc >})
 729       | _ -> Some (coe self)
 730     in
 731     getoptdef m_prev_uioh opt
 732
 733   method multiclick _ x y = self#button 1 true x y
 734
 735   method motion _ y =
 736     match state.mstate with
 737     | Mscrolly ->
 738        let s = float (max 0 (y - conf.scrollh)) /. float state.winh in
 739        let first = truncate (s *. float source#getitemcount) in
 740        let first = min source#getitemcount first in
 741        postRedisplay "listview motion";
 742        coe {< m_first = first; m_active = first >}
 743     | Msel _
 744     | Mpan _
 745     | Mscrollx
 746     | Mzoom _
 747     | Mzoomrect _
 748     | Mnone -> coe self
 749
 750   method pmotion x y =
 751     if x < state.winw - conf.scrollbw
 752     then
 753       let n =
 754         match self#elemunder y with
 755         | None -> Wsi.setcursor Wsi.CURSOR_INHERIT; m_active
 756         | Some n -> Wsi.setcursor Wsi.CURSOR_INFO; n
 757       in
 758       let o =
 759         if n != m_active
 760         then (postRedisplay "listview pmotion"; {< m_active = n >})
 761         else self
 762       in
 763       coe o
 764     else (
 765       Wsi.setcursor Wsi.CURSOR_INHERIT;
 766       coe self
 767     )
 768
 769   method infochanged _ = ()
 770
 771   method scrollpw = (0, 0.0, 0.0)
 772   method scrollph =
 773     let nfs = fstate.fontsize + 1 in
 774     let y = m_first * nfs in
 775     let itemcount = source#getitemcount in
 776     let maxi = max 0 (itemcount - fstate.maxrows) in
 777     let maxy = maxi * nfs in
 778     let p, h = scrollph y maxy in
 779     conf.scrollbw, p, h
 780
 781   method modehash = modehash
 782   method eformsgs = false
 783   method alwaysscrolly = true
 784   method scroll _ dy =
 785     let self =
 786       if dy != 0 then begin
 787         let len = source#getitemcount in
 788         let first =
 789           if dy > 0 && m_first + fstate.maxrows >= len
 790           then m_first
 791           else
 792             let first = m_first + dy / 10 in
 793             bound first 0 (len - 1)
 794         in
 795         postRedisplay "listview wheel";
 796         {< m_first = first >}
 797       end else
 798         self
 799     in
 800     coe self
 801
 802   method zoom _ _ _ = ()
 803 end;;