uiutils.ml

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