open Utilsopen Glutilsopen 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  let s =    if !S.newerrmsgs    then (      if not (istextentry !S.mode) && !S.uioh#eformsgs      then        let s1 = "(press 'e' to review error messages)" in        if nonemptystr s then s ^ " " ^ s1 else s1      else s    )    else s  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 =

Lines 1–500 of 796. Load more