History

Layering violation

malc committed 8 years ago

Commit 36c09301 parent 9c366043 files · +798 −791Browse files

Unified · Split

3 files
  1. glutils.ml +10 −0
  2. listview.ml +787 −0
  3. main.ml +1 −791
glutils.ml+10−0
@@ -57,3 +57,13 @@ let makecheckers () = · 56 unmodified lines
57 [ `mag_filter `nearest; `min_filter `nearest ];57 [ `mag_filter `nearest; `min_filter `nearest ];
58 id;58 id;
59;;59;;
60
61module G =
62 struct
63 let redisplay = ref false;;
64 let postRedisplay who =
65 Utils.vlog "redisplay for [%S]" who;
66 redisplay := true;
67 ;;
68 end
69;;
listview.ml+787−0
@@ -0,0 +1,787 @@
1open Utils;;
2open Glutils;;
3open Config;;
4
5let 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
21let isbirdseye = function
22 | Birdseye _ -> true
23 | Textentry _ | View | LinkNav _ -> false
24;;
25
26let istextentry = function
27 | Textentry _ -> true
28 | Birdseye _ | View | LinkNav _ -> false
29;;
30
31let 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
38let vscrollhit x =
39 if conf.leftscroll
40 then x < vscrollw ()
41 else x > state.winw - vscrollw ()
42;;
43
44let 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
50let 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
58let 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
122let 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 G.postRedisplay "textentrykeyboard enttext";
129 in
130 let histaction cmd =
131 match opthist with
132 | None -> ()
133 | Some (action, _) ->
134 state.mode <-
135 Textentry (
136 (c, action cmd, opthist, onkey, ondone, cancelonempty), onleave
137 );
138 G.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 G.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 G.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 G.postRedisplay "textentrykeyboard after cancel2"
173 )
174 else (
175 enttext (c, E.s, opthist, onkey, ondone, cancelonempty)
176 )
177
178 | Delete -> ()
179
180 | Code _ | Ascii _ ->
181 begin match onkey text kt with
182 | TEdone text ->
183 ondone text;
184 onleave Confirm;
185 G.postRedisplay "textentrykeyboard after confirm2";
186
187 | TEcont text ->
188 enttext (c, text, opthist, onkey, ondone, cancelonempty);
189
190 | TEstop ->
191 onleave Cancel;
192 G.postRedisplay "textentrykeyboard after cancel3"
193
194 | TEswitch te ->
195 state.mode <- Textentry (te, onleave);
196 G.postRedisplay "textentrykeyboard switch";
197 end
198 | _ -> vlog "unhandled key"
199;;
200
201class type lvsource =
202 object
203 method getitemcount : int
204 method getitem : int -> (string * int)
205 method hasaction : int -> bool
206 method exit : uioh:uioh ->
207 cancel:bool ->
208 active:int ->
209 first:int ->
210 pan:int ->
211 uioh option
212 method getactive : int
213 method getfirst : int
214 method getpan : int
215 method getminfo : (int * int) array
216 end;;
217
218class virtual lvsourcebase = object
219 val mutable m_active = 0
220 val mutable m_first = 0
221 val mutable m_pan = 0
222 method getactive = m_active
223 method getfirst = m_first
224 method getpan = m_pan
225 method getminfo : (int * int) array = E.a
226 end;;
227
228let coe s = (s :> uioh);;
229
230class listview ~zebra ~helpmode ~(source:lvsource) ~trusted ~modehash =
231object (self)
232 val m_pan = source#getpan
233 val m_first = source#getfirst
234 val m_active = source#getactive
235 val m_qsearch = E.s
236 val m_prev_uioh = state.uioh
237
238 method private elemunder y =
239 if y < 0
240 then None
241 else
242 let n = y / (fstate.fontsize+1) in
243 if m_first + n < source#getitemcount
244 then (
245 if source#hasaction (m_first + n)
246 then Some (m_first + n)
247 else None
248 )
249 else None
250
251 method display =
252 Gl.enable `blend;
253 GlFunc.blend_func ~src:`src_alpha ~dst:`one_minus_src_alpha;
254 GlDraw.color (0., 0., 0.) ~alpha:0.85;
255 filledrect 0. 0. (float state.winw) (float state.winh);
256 GlDraw.color (1., 1., 1.);
257 Gl.enable `texture_2d;
258 let fs = fstate.fontsize in
259 let nfs = fs + 1 in
260 let hw = state.winw/3 in
261 let ww = fstate.wwidth in
262 let tabw = 17.0*.ww in
263 let itemcount = source#getitemcount in
264 let minfo = source#getminfo in
265 if conf.leftscroll
266 then (
267 GlMat.push ();
268 GlMat.translate ~x:(float conf.scrollbw) ();
269 );
270 let x0 = 0.0 and x1 = float (state.winw - conf.scrollbw - 1) in
271 let rec loop row =
272 if (row - m_first) > fstate.maxrows
273 then ()
274 else (
275 if row >= 0 && row < itemcount
276 then (
277 let (s, level) = source#getitem row in
278 let y = (row - m_first) * nfs in
279 let x = 5.0 +. (float (level + m_pan)) *. ww in
280 if helpmode
281 then GlDraw.color
282 (let c = if row land 1 = 0 then 1.0 else 0.92 in (c,c,c));
283
284 if row = m_active
285 then (
286 Gl.disable `texture_2d;
287 let alpha = if source#hasaction row then 0.9 else 0.3 in
288 GlDraw.color (1., 1., 1.) ~alpha;
289 linerect (x0 +. 1.) (float (y + 1)) (x1) (float (y + fs + 3));
290 Gl.enable `texture_2d;
291 );
292 let c =
293 if zebra && row land 1 = 1
294 then 0.8
295 else 1.0
296 in
297 GlDraw.color (c,c,c);
298 let drawtabularstring s =
299 let drawstr x s =
300 let x' = truncate (x0 +. x) in
301 let s1, s2 = splitatchar s '\000' in
302 if emptystr s2
303 then drawstring1 fs x' (y+nfs) s
304 else
305 let rec e s =
306 if emptystr s
307 then s
308 else
309 let s' = withoutlastutf8 s in
310 let s = s' ^ Unisyms.ellipsis in
311 let w = measurestr fs s in
312 if float x' +. w +. ww < float (hw + x')
313 then s
314 else e s'
315 in
316 let s1 =
317 if float x' +. ww +. measurestr fs s1 > float (hw + x')
318 then e s1
319 else s1
320 in
321 ignore (drawstring1 fs x' (y+nfs) s1);
322 drawstring1 fs (hw + x') (y+nfs) s2
323 in
324 if trusted
325 then
326 let x = if helpmode && row > 0 then x +. ww else x in
327 let s1, s2 = splitatchar s '\t' in
328 if nonemptystr s2
329 then
330 let nx = drawstr x s1 in
331 let sw = nx -. x in
332 let x = x +. (max tabw sw) in
333 drawstr x s2
334 else
335 let len = String.length s - 2 in
336 if len > 0 && s.[0] = '\xc2' && s.[1] = '\xb7'
337 then
338 let s = String.sub s 2 len in
339 let x = if not helpmode then x +. ww else x in
340 GlDraw.color (1.2, 1.2, 1.2);
341 let vinc = drawstring1 (fs+fs/4)
342 (truncate (x -. ww)) (y+nfs) s in
343 GlDraw.color (1., 1., 1.);
344 vinc +. (float fs *. 0.8)
345 else
346 drawstr x s
347 else
348 drawstr x s
349 in
350 ignore (drawtabularstring s);
351 loop (row+1)
352 )
353 )
354 in
355 loop m_first;
356 GlDraw.color (1.0, 1.0, 1.0) ~alpha:0.5;
357 let xadj = 5.0 in
358 let rec loop row =
359 if (row - m_first) <= fstate.maxrows
360 then
361 if row >= 0 && row < itemcount
362 then (
363 let (s, level) = source#getitem row in
364 let pos0 = nindex s '\000' in
365 let y = (row - m_first) * nfs in
366 let x = float (level + m_pan) *. ww in
367 let (first, last) = minfo.(row) in
368 let prefix =
369 if pos0 > 0 && first > pos0
370 then String.sub s (pos0+1) (first-pos0-1)
371 else String.sub s 0 first
372 in
373 let suffix = String.sub s first (last - first) in
374 let w1 = measurestr fstate.fontsize prefix in
375 let w2 = measurestr fstate.fontsize suffix in
376 let x = x +. if conf.leftscroll then xadj else 5.0 in
377 let x = if pos0 > 0 && first > pos0 then x +. float hw else x in
378 let x0 = x +. w1
379 and y0 = float (y+2) in
380 let x1 = x0 +. w2
381 and y1 = float (y+fs+3) in
382 filledrect x0 y0 x1 y1;
383 loop (row+1)
384 )
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 updownlevel 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 then i-1 else if i = -1 then 0 else
401 let _, l = source#getitem i in
402 if l != curlevel then i else flow (i+incr)
403 in
404 let active = flow m_active in
405 let first = calcfirst m_first active in
406 G.postRedisplay "outline updownlevel";
407 {< m_active = active; m_first = first >}
408
409 method private key1 key mask =
410 let set1 active first qsearch =
411 coe {< m_active = active; m_first = first; m_qsearch = qsearch >}
412 in
413 let search active pattern incr =
414 let active = if active = -1 then m_first else active in
415 let dosearch re =
416 let rec loop n =
417 if n >= 0 && n < source#getitemcount
418 then (
419 let s, _ = source#getitem n in
420 match Str.search_forward re s 0 with
421 | exception Not_found -> loop (n + incr)
422 | _ -> Some n
423 )
424 else None
425 in
426 loop active
427 in
428 let qpat = Str.quote pattern in
429 match Str.regexp_case_fold qpat with
430 | s -> dosearch s
431 | exception exn ->
432 dolog "regexp_case_fold for `%S' failed: %S\n" qpat @@
433 Printexc.to_string exn;
434 None
435 in
436 let itemcount = source#getitemcount in
437 let find start incr =
438 let rec find i =
439 if i = -1 || i = itemcount
440 then -1
441 else (
442 if source#hasaction i
443 then i
444 else find (i + incr)
445 )
446 in
447 find start
448 in
449 let set active first =
450 let first = bound first 0 (itemcount - fstate.maxrows) in
451 state.text <- E.s;
452 coe {< m_active = active; m_first = first; m_qsearch = E.s >}
453 in
454 let navigate incr =
455 let isvisible first n = n >= first && n - first <= fstate.maxrows in
456 let active, first =
457 let incr1 = if incr > 0 then 1 else -1 in
458 if isvisible m_first m_active
459 then
460 let next =
461 let next = m_active + incr in
462 let next =
463 if next < 0 || next >= itemcount
464 then -1
465 else find next incr1
466 in
467 if abs (m_active - next) > fstate.maxrows
468 then -1
469 else next
470 in
471 if next = -1
472 then
473 let first = m_first + incr in
474 let first = bound first 0 (itemcount - fstate.maxrows) in
475 let next =
476 let next = m_active + incr in
477 let next = bound next 0 (itemcount - 1) in
478 find next ~-incr1
479 in
480 let active =
481 if next = -1
482 then m_active
483 else (
484 if isvisible first next
485 then next
486 else m_active
487 )
488 in
489 active, first
490 else
491 let first = min next m_first in
492 let first =
493 if abs (next - first) > fstate.maxrows
494 then first + incr
495 else first
496 in
497 next, first
498 else
499 let first = m_first + incr in
500 let first = bound first 0 (itemcount - 1) in
501 let active =
502 let next = m_active + incr in
503 let next = bound next 0 (itemcount - 1) in
504 let next = find next incr1 in
505 let active =
506 if next = -1 || abs (m_active - first) > fstate.maxrows
507 then (
508 let active = if m_active = -1 then next else m_active in
509 active
510 )
511 else next
512 in
513 if isvisible first active
514 then active
515 else -1
516 in
517 active, first
518 in
519 G.postRedisplay "listview navigate";
520 set active first;
521 in
522 let open Keys in
523 let kt = Wsi.kc2kt key in
524 match [@warning "-4"] kt with
525 | Ascii (('r'|'s') as c) when Wsi.withctrl mask ->
526 let incr = if c = 'r' then -1 else 1 in
527 let active, first =
528 match search (m_active + incr) m_qsearch incr with
529 | None ->
530 state.text <- m_qsearch ^ " [not found]";
531 m_active, m_first
532 | Some active ->
533 state.text <- m_qsearch;
534 active, firstof m_first active
535 in
536 G.postRedisplay "listview ctrl-r/s";
537 set1 active first m_qsearch;
538
539 | Insert when Wsi.withctrl mask ->
540 if m_active >= 0 && m_active < source#getitemcount
541 then (
542 let s, _ = source#getitem m_active in
543 selstring conf.selcmd s;
544 );
545 coe self
546
547 | Backspace ->
548 if emptystr m_qsearch
549 then coe self
550 else (
551 let qsearch = withoutlastutf8 m_qsearch in
552 if emptystr qsearch
553 then (
554 state.text <- E.s;
555 G.postRedisplay "listview empty qsearch";
556 set1 m_active m_first E.s;
557 )
558 else
559 let active, first =
560 match search m_active qsearch ~-1 with
561 | None ->
562 state.text <- qsearch ^ " [not found]";
563 m_active, m_first
564 | Some active ->
565 state.text <- qsearch;
566 active, firstof m_first active
567 in
568 G.postRedisplay "listview backspace qsearch";
569 set1 active first qsearch
570 );
571
572 | Ascii _ | Code _ ->
573 let utf8 =
574 match [@warning "-8"] kt with
575 | Ascii c -> String.make 1 c
576 | Code code -> toutf8 code
577 in
578 let pattern = m_qsearch ^ utf8 in
579 let active, first =
580 match search m_active pattern 1 with
581 | None ->
582 state.text <- pattern ^ " [not found]";
583 m_active, m_first
584 | Some active ->
585 state.text <- pattern;
586 active, firstof m_first active
587 in
588 G.postRedisplay "listview qsearch add";
589 set1 active first pattern;
590
591 | Escape ->
592 state.text <- E.s;
593 if emptystr m_qsearch
594 then (
595 G.postRedisplay "list view escape";
596 (* XXX:
597 let mx, my = state.mpos in
598 updateunder mx my;
599 *)
600 match source#exit ~uioh:(coe self) ~cancel:true ~active:m_active
601 ~first:m_first ~pan:m_pan with
602 | None -> m_prev_uioh
603 | Some uioh -> uioh
604 )
605 else (
606 G.postRedisplay "list view kill qsearch";
607 coe {< m_qsearch = E.s >}
608 )
609
610 | Enter ->
611 state.text <- E.s;
612 let self = {< m_qsearch = E.s >} in
613 let opt =
614 G.postRedisplay "listview enter";
615 let cancel = not (m_active >= 0 && m_active < source#getitemcount) in
616 source#exit ~uioh:(coe self) ~cancel
617 ~active:m_active ~first:m_first ~pan:m_pan;
618 in
619 begin match opt with
620 | None -> m_prev_uioh
621 | Some uioh -> uioh
622 end
623
624 | Delete ->
625 coe self
626
627 | Up -> navigate ~-1
628 | Down -> navigate 1
629 | Prior -> navigate ~-(fstate.maxrows)
630 | Next -> navigate fstate.maxrows
631
632 | Right ->
633 state.text <- E.s;
634 G.postRedisplay "listview right";
635 coe {< m_pan = m_pan - 1 >}
636
637 | Left ->
638 state.text <- E.s;
639 G.postRedisplay "listview left";
640 coe {< m_pan = m_pan + 1 >}
641
642 | Home ->
643 let active = find 0 1 in
644 G.postRedisplay "listview home";
645 set active 0;
646
647 | End ->
648 let first = max 0 (itemcount - fstate.maxrows) in
649 let active = find (itemcount - 1) ~-1 in
650 G.postRedisplay "listview end";
651 set active first;
652
653 | _ -> coe self
654
655 method key key mask =
656 match state.mode with
657 | Textentry te ->
658 textentrykeyboard key mask te;
659 coe self
660 | Birdseye _ | View | LinkNav _ -> self#key1 key mask
661
662 method button button down x y _ =
663 let opt =
664 match button with
665 | 1 when vscrollhit x ->
666 G.postRedisplay "listview scroll";
667 if down
668 then
669 let _, position, sh = self#scrollph in
670 if y > truncate position && y < truncate (position +. sh)
671 then (
672 state.mstate <- Mscrolly;
673 Some (coe self)
674 )
675 else
676 let s = float (max 0 (y - conf.scrollh)) /. float state.winh in
677 let first = truncate (s *. float source#getitemcount) in
678 let first = min source#getitemcount first in
679 Some (coe {< m_first = first; m_active = first >})
680 else (
681 state.mstate <- Mnone;
682 Some (coe self);
683 );
684 | 1 when down ->
685 begin match self#elemunder y with
686 | Some n ->
687 G.postRedisplay "listview click";
688 source#exit ~uioh:(coe {< m_active = n >})
689 ~cancel:false ~active:n ~first:m_first ~pan:m_pan
690 | _ ->
691 Some (coe self)
692 end
693 | n when (n == 4 || n == 5) && not down ->
694 let len = source#getitemcount in
695 let first =
696 if n = 5 && m_first + fstate.maxrows >= len
697 then
698 m_first
699 else
700 let first = m_first + (if n == 4 then -1 else 1) in
701 bound first 0 (len - 1)
702 in
703 G.postRedisplay "listview wheel";
704 Some (coe {< m_first = first >})
705 | n when (n = 6 || n = 7) && not down ->
706 let inc = if n = 7 then -1 else 1 in
707 G.postRedisplay "listview hwheel";
708 Some (coe {< m_pan = m_pan + inc >})
709 | _ ->
710 Some (coe self)
711 in
712 match opt with
713 | None -> m_prev_uioh
714 | Some uioh -> uioh
715
716 method multiclick _ x y = self#button 1 true x y
717
718 method motion _ y =
719 match state.mstate with
720 | Mscrolly ->
721 let s = float (max 0 (y - conf.scrollh)) /. float state.winh in
722 let first = truncate (s *. float source#getitemcount) in
723 let first = min source#getitemcount first in
724 G.postRedisplay "listview motion";
725 coe {< m_first = first; m_active = first >}
726 | Msel _
727 | Mpan _
728 | Mscrollx
729 | Mzoom _
730 | Mzoomrect _
731 | Mnone -> coe self
732
733 method pmotion x y =
734 if x < state.winw - conf.scrollbw
735 then
736 let n =
737 match self#elemunder y with
738 | None -> Wsi.setcursor Wsi.CURSOR_INHERIT; m_active
739 | Some n -> Wsi.setcursor Wsi.CURSOR_INFO; n
740 in
741 let o =
742 if n != m_active
743 then (G.postRedisplay "listview pmotion"; {< m_active = n >})
744 else self
745 in
746 coe o
747 else (
748 Wsi.setcursor Wsi.CURSOR_INHERIT;
749 coe self
750 )
751
752 method infochanged _ = ()
753
754 method scrollpw = (0, 0.0, 0.0)
755 method scrollph =
756 let nfs = fstate.fontsize + 1 in
757 let y = m_first * nfs in
758 let itemcount = source#getitemcount in
759 let maxi = max 0 (itemcount - fstate.maxrows) in
760 let maxy = maxi * nfs in
761 let p, h = scrollph y maxy in
762 conf.scrollbw, p, h
763
764 method modehash = modehash
765 method eformsgs = false
766 method alwaysscrolly = true
767 method scroll _ dy =
768 let self =
769 if dy != 0 then begin
770 let len = source#getitemcount in
771 let first =
772 if dy > 0 && m_first + fstate.maxrows >= len
773 then
774 m_first
775 else
776 let first = m_first + dy / 10 in
777 bound first 0 (len - 1)
778 in
779 G.postRedisplay "listview wheel";
780 {< m_first = first >}
781 end else
782 self
783 in
784 coe self
785
786 method zoom _ _ _ = ()
787end;;
main.ml+1−791
@@ -1,6 +1,7 @@
1open Utils;;1open Utils;;
2open Config;;2open Config;;
3open Glutils;;3open Glutils;;
4open Listview;;
4 5
5external init : Unix.file_descr -> initparams -> unit = "ml_init";;6external init : Unix.file_descr -> initparams -> unit = "ml_init";;
6external seltext : opaque -> (int * int * int * int) -> unit = "ml_seltext";;7external seltext : opaque -> (int * int * int * int) -> unit = "ml_seltext";;
@@ -84,16 +85,6 @@ let debugrect (x0, y0, x1, y1, x2, y2, x3, y3) = · 77 unmodified lines
84}|} x0 y0 x1 y1 x2 y2 x3 y3;85}|} x0 y0 x1 y1 x2 y2 x3 y3;
85;;86;;
86 87
87let isbirdseye = function
88 | Birdseye _ -> true
89 | Textentry _ | View | LinkNav _ -> false
90;;
91
92let istextentry = function
93 | Textentry _ -> true
94 | Birdseye _ | View | LinkNav _ -> false
95;;
96
97let pgscale h = truncate (float h *. conf.pgscale);;88let pgscale h = truncate (float h *. conf.pgscale);;
98 89
99let hscrollh () =90let hscrollh () =
@@ -103,19 +94,6 @@ let hscrollh () = · 3 unmodified lines
103 else 094 else 0
104;;95;;
105 96
106let vscrollw () =
107 if state.uioh#alwaysscrolly || ((conf.scrollb land scrollbvv != 0)
108 && (state.maxy > state.winh))
109 then conf.scrollbw
110 else 0
111;;
112
113let vscrollhit x =
114 if conf.leftscroll
115 then x < vscrollw ()
116 else x > state.winw - vscrollw ()
117;;
118
119let setfontsize n =97let setfontsize n =
120 fstate.fontsize <- n;98 fstate.fontsize <- n;
121 fstate.wwidth <- measurestr fstate.fontsize "w";99 fstate.wwidth <- measurestr fstate.fontsize "w";
@@ -140,15 +118,6 @@ let launchpath () = · 18 unmodified lines
140 );118 );
141;;119;;
142 120
143module G =
144 struct
145 let postRedisplay who =
146 vlog "redisplay for [%S]" who;
147 state.redisplay <- true;
148 ;;
149 end
150;;
151
152let getopaque pageno =121let getopaque pageno =
153 try Some (Hashtbl.find state.pagemap (pageno, state.gen))122 try Some (Hashtbl.find state.pagemap (pageno, state.gen))
154 with Not_found -> None123 with Not_found -> None
@@ -1156,70 +1125,6 @@ let reshape ?(firsttime=false) w h = · 1001 unmodified lines
1156 );1125 );
1157;;1126;;
1158 1127
1159let enttext () =
1160 let len = String.length state.text in
1161 let x0 = if conf.leftscroll then vscrollw () else 0 in
1162 let drawstring s =
1163 let hscrollh =
1164 match state.mode with
1165 | Textentry _ | View | LinkNav _ ->
1166 let h, _, _ = state.uioh#scrollpw in
1167 h
1168 | Birdseye _ -> 0
1169 in
1170 let rect x w =
1171 filledrect
1172 x (float (state.winh - (fstate.fontsize + 4) - hscrollh))
1173 (x+.w) (float (state.winh - hscrollh))
1174 in
1175
1176 let w = float (state.winw - 1 - vscrollw ()) in
1177 if state.progress >= 0.0 && state.progress < 1.0
1178 then (
1179 GlDraw.color (0.3, 0.3, 0.3);
1180 let w1 = w *. state.progress in
1181 rect (float x0) w1;
1182 GlDraw.color (0.0, 0.0, 0.0);
1183 rect (float x0+.w1) (float x0+.w-.w1)
1184 )
1185 else (
1186 GlDraw.color (0.0, 0.0, 0.0);
1187 rect (float x0) w;
1188 );
1189
1190 GlDraw.color (1.0, 1.0, 1.0);
1191 drawstring
1192 fstate.fontsize
1193 (if conf.leftscroll then x0 + 2 else x0 + if len > 0 then 8 else 2)
1194 (state.winh - hscrollh - 5) s;
1195 in
1196 let s =
1197 match state.mode with
1198 | Textentry ((prefix, text, _, _, _, _), _) ->
1199 let s =
1200 if len > 0
1201 then Printf.sprintf "%s%s_ [%s]" prefix text state.text
1202 else Printf.sprintf "%s%s_" prefix text
1203 in
1204 s
1205
1206 | Birdseye _ | View | LinkNav _ -> state.text
1207 in
1208 let s =
1209 if state.newerrmsgs
1210 then (
1211 if not (istextentry state.mode) && state.uioh#eformsgs
1212 then
1213 let s1 = "(press 'e' to review error messasges)" in
1214 if nonemptystr s then s ^ " " ^ s1 else s1
1215 else s
1216 )
1217 else s
1218 in
1219 if nonemptystr s
1220 then drawstring s
1221;;
1222
1223let gctiles () =1128let gctiles () =
1224 let len = Queue.length state.tilelru in1129 let len = Queue.length state.tilelru in
1225 let layout = lazy (if conf.preload1130 let layout = lazy (if conf.preload
@@ -2108,142 +2013,6 @@ let optentry mode _ key = · 882 unmodified lines
2108 TEcont state.text2013 TEcont state.text
2109;;2014;;
2110 2015
2111class type lvsource =
2112 object
2113 method getitemcount : int
2114 method getitem : int -> (string * int)
2115 method hasaction : int -> bool
2116 method exit : uioh:uioh ->
2117 cancel:bool ->
2118 active:int ->
2119 first:int ->
2120 pan:int ->
2121 uioh option
2122 method getactive : int
2123 method getfirst : int
2124 method getpan : int
2125 method getminfo : (int * int) array
2126 end;;
2127
2128class virtual lvsourcebase = object
2129 val mutable m_active = 0
2130 val mutable m_first = 0
2131 val mutable m_pan = 0
2132 method getactive = m_active
2133 method getfirst = m_first
2134 method getpan = m_pan
2135 method getminfo : (int * int) array = E.a
2136 end;;
2137
2138let textentrykeyboard
2139 key _mask ((c, text, opthist, onkey, ondone, cancelonempty), onleave) =
2140 state.text <- E.s;
2141 let enttext te =
2142 state.mode <- Textentry (te, onleave);
2143 enttext ();
2144 G.postRedisplay "textentrykeyboard enttext";
2145 in
2146 let histaction cmd =
2147 match opthist with
2148 | None -> ()
2149 | Some (action, _) ->
2150 state.mode <-
2151 Textentry (
2152 (c, action cmd, opthist, onkey, ondone, cancelonempty), onleave
2153 );
2154 G.postRedisplay "textentry histaction"
2155 in
2156 let open Keys in
2157 let kt = Wsi.kc2kt key in
2158 match [@warning "-4"] kt with
2159 | Backspace ->
2160 if emptystr text && cancelonempty
2161 then (
2162 onleave Cancel;
2163 G.postRedisplay "textentrykeyboard after cancel";
2164 )
2165 else
2166 let s = withoutlastutf8 text in
2167 enttext (c, s, opthist, onkey, ondone, cancelonempty)
2168
2169 | Enter ->
2170 ondone text;
2171 onleave Confirm;
2172 G.postRedisplay "textentrykeyboard after confirm"
2173
2174 | Up -> histaction HCprev
2175 | Down -> histaction HCnext
2176 | Home -> histaction HCfirst
2177 | End -> histaction HClast
2178
2179 | Escape ->
2180 if emptystr text
2181 then (
2182 begin match opthist with
2183 | None -> ()
2184 | Some (_, onhistcancel) -> onhistcancel ()
2185 end;
2186 onleave Cancel;
2187 state.text <- E.s;
2188 G.postRedisplay "textentrykeyboard after cancel2"
2189 )
2190 else (
2191 enttext (c, E.s, opthist, onkey, ondone, cancelonempty)
2192 )
2193
2194 | Delete -> ()
2195
2196 | Code _ | Ascii _ ->
2197 begin match onkey text kt with
2198 | TEdone text ->
2199 ondone text;
2200 onleave Confirm;
2201 G.postRedisplay "textentrykeyboard after confirm2";
2202
2203 | TEcont text ->
2204 enttext (c, text, opthist, onkey, ondone, cancelonempty);
2205
2206 | TEstop ->
2207 onleave Cancel;
2208 G.postRedisplay "textentrykeyboard after cancel3"
2209
2210 | TEswitch te ->
2211 state.mode <- Textentry (te, onleave);
2212 G.postRedisplay "textentrykeyboard switch";
2213 end
2214 | _ -> vlog "unhandled key"
2215;;
2216
2217let firstof first active =
2218 if first > active || abs (first - active) > fstate.maxrows - 1
2219 then max 0 (active - (fstate.maxrows/2))
2220 else first
2221;;
2222
2223let calcfirst first active =
2224 if active > first
2225 then
2226 let rows = active - first in
2227 if rows > fstate.maxrows then active - fstate.maxrows else first
2228 else active
2229;;
2230
2231let scrollph y maxy =
2232 let sh = float (maxy + state.winh) /. float state.winh in
2233 let sh = float state.winh /. sh in
2234 let sh = max sh (float conf.scrollh) in
2235
2236 let percent = float y /. float maxy in
2237 let position = (float state.winh -. sh) *. percent in
2238
2239 let position =
2240 if position +. sh > float state.winh
2241 then float state.winh -. sh
2242 else position
2243 in
2244 position, sh;
2245;;
2246
2247let adderrmsg src msg =2016let adderrmsg src msg =
2248 Buffer.add_string state.errmsgs msg;2017 Buffer.add_string state.errmsgs msg;
2249 state.newerrmsgs <- true;2018 state.newerrmsgs <- true;
@@ -2254,565 +2023,6 @@ let adderrfmt src fmt = · 4 unmodified lines
2254 Format.ksprintf (fun s -> adderrmsg src s) fmt;2023 Format.ksprintf (fun s -> adderrmsg src s) fmt;
2255;;2024;;
2256 2025
2257let coe s = (s :> uioh);;
2258
2259class listview ~zebra ~helpmode ~(source:lvsource) ~trusted ~modehash =
2260object (self)
2261 val m_pan = source#getpan
2262 val m_first = source#getfirst
2263 val m_active = source#getactive
2264 val m_qsearch = E.s
2265 val m_prev_uioh = state.uioh
2266
2267 method private elemunder y =
2268 if y < 0
2269 then None
2270 else
2271 let n = y / (fstate.fontsize+1) in
2272 if m_first + n < source#getitemcount
2273 then (
2274 if source#hasaction (m_first + n)
2275 then Some (m_first + n)
2276 else None
2277 )
2278 else None
2279
2280 method display =
2281 Gl.enable `blend;
2282 GlFunc.blend_func ~src:`src_alpha ~dst:`one_minus_src_alpha;
2283 GlDraw.color (0., 0., 0.) ~alpha:0.85;
2284 filledrect 0. 0. (float state.winw) (float state.winh);
2285 GlDraw.color (1., 1., 1.);
2286 Gl.enable `texture_2d;
2287 let fs = fstate.fontsize in
2288 let nfs = fs + 1 in
2289 let hw = state.winw/3 in
2290 let ww = fstate.wwidth in
2291 let tabw = 17.0*.ww in
2292 let itemcount = source#getitemcount in
2293 let minfo = source#getminfo in
2294 if conf.leftscroll
2295 then (
2296 GlMat.push ();
2297 GlMat.translate ~x:(float conf.scrollbw) ();
2298 );
2299 let x0 = 0.0 and x1 = float (state.winw - conf.scrollbw - 1) in
2300 let rec loop row =
2301 if (row - m_first) > fstate.maxrows
2302 then ()
2303 else (
2304 if row >= 0 && row < itemcount
2305 then (
2306 let (s, level) = source#getitem row in
2307 let y = (row - m_first) * nfs in
2308 let x = 5.0 +. (float (level + m_pan)) *. ww in
2309 if helpmode
2310 then GlDraw.color
2311 (let c = if row land 1 = 0 then 1.0 else 0.92 in (c,c,c));
2312
2313 if row = m_active
2314 then (
2315 Gl.disable `texture_2d;
2316 let alpha = if source#hasaction row then 0.9 else 0.3 in
2317 GlDraw.color (1., 1., 1.) ~alpha;
2318 linerect (x0 +. 1.) (float (y + 1)) (x1) (float (y + fs + 3));
2319 Gl.enable `texture_2d;
2320 );
2321 let c =
2322 if zebra && row land 1 = 1
2323 then 0.8
2324 else 1.0
2325 in
2326 GlDraw.color (c,c,c);
2327 let drawtabularstring s =
2328 let drawstr x s =
2329 let x' = truncate (x0 +. x) in
2330 let s1, s2 = splitatchar s '\000' in
2331 if emptystr s2
2332 then drawstring1 fs x' (y+nfs) s
2333 else
2334 let rec e s =
2335 if emptystr s
2336 then s
2337 else
2338 let s' = withoutlastutf8 s in
2339 let s = s' ^ Unisyms.ellipsis in
2340 let w = measurestr fs s in
2341 if float x' +. w +. ww < float (hw + x')
2342 then s
2343 else e s'
2344 in
2345 let s1 =
2346 if float x' +. ww +. measurestr fs s1 > float (hw + x')
2347 then e s1
2348 else s1
2349 in
2350 ignore (drawstring1 fs x' (y+nfs) s1);
2351 drawstring1 fs (hw + x') (y+nfs) s2
2352 in
2353 if trusted
2354 then
2355 let x = if helpmode && row > 0 then x +. ww else x in
2356 let s1, s2 = splitatchar s '\t' in
2357 if nonemptystr s2
2358 then
2359 let nx = drawstr x s1 in
2360 let sw = nx -. x in
2361 let x = x +. (max tabw sw) in
2362 drawstr x s2
2363 else
2364 let len = String.length s - 2 in
2365 if len > 0 && s.[0] = '\xc2' && s.[1] = '\xb7'
2366 then
2367 let s = String.sub s 2 len in
2368 let x = if not helpmode then x +. ww else x in
2369 GlDraw.color (1.2, 1.2, 1.2);
2370 let vinc = drawstring1 (fs+fs/4)
2371 (truncate (x -. ww)) (y+nfs) s in
2372 GlDraw.color (1., 1., 1.);
2373 vinc +. (float fs *. 0.8)
2374 else
2375 drawstr x s
2376 else
2377 drawstr x s
2378 in
2379 ignore (drawtabularstring s);
2380 loop (row+1)
2381 )
2382 )
2383 in
2384 loop m_first;
2385 GlDraw.color (1.0, 1.0, 1.0) ~alpha:0.5;
2386 let xadj = 5.0 in
2387 let rec loop row =
2388 if (row - m_first) <= fstate.maxrows
2389 then
2390 if row >= 0 && row < itemcount
2391 then (
2392 let (s, level) = source#getitem row in
2393 let pos0 = nindex s '\000' in
2394 let y = (row - m_first) * nfs in
2395 let x = float (level + m_pan) *. ww in
2396 let (first, last) = minfo.(row) in
2397 let prefix =
2398 if pos0 > 0 && first > pos0
2399 then String.sub s (pos0+1) (first-pos0-1)
2400 else String.sub s 0 first
2401 in
2402 let suffix = String.sub s first (last - first) in
2403 let w1 = measurestr fstate.fontsize prefix in
2404 let w2 = measurestr fstate.fontsize suffix in
2405 let x = x +. if conf.leftscroll then xadj else 5.0 in
2406 let x = if pos0 > 0 && first > pos0 then x +. float hw else x in
2407 let x0 = x +. w1
2408 and y0 = float (y+2) in
2409 let x1 = x0 +. w2
2410 and y1 = float (y+fs+3) in
2411 filledrect x0 y0 x1 y1;
2412 loop (row+1)
2413 )
2414 in
2415 Gl.disable `texture_2d;
2416 if Array.length minfo > 0 then loop m_first;
2417 Gl.disable `blend;
2418 if conf.leftscroll
2419 then GlMat.pop ()
2420
2421 method updownlevel incr =
2422 let len = source#getitemcount in
2423 let curlevel =
2424 if m_active >= 0 && m_active < len
2425 then snd (source#getitem m_active)
2426 else -1
2427 in
2428 let rec flow i =
2429 if i = len then i-1 else if i = -1 then 0 else
2430 let _, l = source#getitem i in
2431 if l != curlevel then i else flow (i+incr)
2432 in
2433 let active = flow m_active in
2434 let first = calcfirst m_first active in
2435 G.postRedisplay "outline updownlevel";
2436 {< m_active = active; m_first = first >}
2437
2438 method private key1 key mask =
2439 let set1 active first qsearch =
2440 coe {< m_active = active; m_first = first; m_qsearch = qsearch >}
2441 in
2442 let search active pattern incr =
2443 let active = if active = -1 then m_first else active in
2444 let dosearch re =
2445 let rec loop n =
2446 if n >= 0 && n < source#getitemcount
2447 then (
2448 let s, _ = source#getitem n in
2449 match Str.search_forward re s 0 with
2450 | exception Not_found -> loop (n + incr)
2451 | _ -> Some n
2452 )
2453 else None
2454 in
2455 loop active
2456 in
2457 let qpat = Str.quote pattern in
2458 match Str.regexp_case_fold qpat with
2459 | s -> dosearch s
2460 | exception exn ->
2461 adderrfmt "listview key1" "regexp_case_fold for `%S' failed: %S\n"
2462 qpat @@ Printexc.to_string exn;
2463 None
2464 in
2465 let itemcount = source#getitemcount in
2466 let find start incr =
2467 let rec find i =
2468 if i = -1 || i = itemcount
2469 then -1
2470 else (
2471 if source#hasaction i
2472 then i
2473 else find (i + incr)
2474 )
2475 in
2476 find start
2477 in
2478 let set active first =
2479 let first = bound first 0 (itemcount - fstate.maxrows) in
2480 state.text <- E.s;
2481 coe {< m_active = active; m_first = first; m_qsearch = E.s >}
2482 in
2483 let navigate incr =
2484 let isvisible first n = n >= first && n - first <= fstate.maxrows in
2485 let active, first =
2486 let incr1 = if incr > 0 then 1 else -1 in
2487 if isvisible m_first m_active
2488 then
2489 let next =
2490 let next = m_active + incr in
2491 let next =
2492 if next < 0 || next >= itemcount
2493 then -1
2494 else find next incr1
2495 in
2496 if abs (m_active - next) > fstate.maxrows
2497 then -1
2498 else next
2499 in
2500 if next = -1
2501 then
2502 let first = m_first + incr in
2503 let first = bound first 0 (itemcount - fstate.maxrows) in
2504 let next =
2505 let next = m_active + incr in
2506 let next = bound next 0 (itemcount - 1) in
2507 find next ~-incr1
2508 in
2509 let active =
2510 if next = -1
2511 then m_active
2512 else (
2513 if isvisible first next
2514 then next
2515 else m_active
2516 )
2517 in
2518 active, first
2519 else
2520 let first = min next m_first in
2521 let first =
2522 if abs (next - first) > fstate.maxrows
2523 then first + incr
2524 else first
2525 in
2526 next, first
2527 else
2528 let first = m_first + incr in
2529 let first = bound first 0 (itemcount - 1) in
2530 let active =
2531 let next = m_active + incr in
2532 let next = bound next 0 (itemcount - 1) in
2533 let next = find next incr1 in
2534 let active =
2535 if next = -1 || abs (m_active - first) > fstate.maxrows
2536 then (
2537 let active = if m_active = -1 then next else m_active in
2538 active
2539 )
2540 else next
2541 in
2542 if isvisible first active
2543 then active
2544 else -1
2545 in
2546 active, first
2547 in
2548 G.postRedisplay "listview navigate";
2549 set active first;
2550 in
2551 let open Keys in
2552 let kt = Wsi.kc2kt key in
2553 match [@warning "-4"] kt with
2554 | Ascii (('r'|'s') as c) when Wsi.withctrl mask ->
2555 let incr = if c = 'r' then -1 else 1 in
2556 let active, first =
2557 match search (m_active + incr) m_qsearch incr with
2558 | None ->
2559 state.text <- m_qsearch ^ " [not found]";
2560 m_active, m_first
2561 | Some active ->
2562 state.text <- m_qsearch;
2563 active, firstof m_first active
2564 in
2565 G.postRedisplay "listview ctrl-r/s";
2566 set1 active first m_qsearch;
2567
2568 | Insert when Wsi.withctrl mask ->
2569 if m_active >= 0 && m_active < source#getitemcount
2570 then (
2571 let s, _ = source#getitem m_active in
2572 selstring conf.selcmd s;
2573 );
2574 coe self
2575
2576 | Backspace ->
2577 if emptystr m_qsearch
2578 then coe self
2579 else (
2580 let qsearch = withoutlastutf8 m_qsearch in
2581 if emptystr qsearch
2582 then (
2583 state.text <- E.s;
2584 G.postRedisplay "listview empty qsearch";
2585 set1 m_active m_first E.s;
2586 )
2587 else
2588 let active, first =
2589 match search m_active qsearch ~-1 with
2590 | None ->
2591 state.text <- qsearch ^ " [not found]";
2592 m_active, m_first
2593 | Some active ->
2594 state.text <- qsearch;
2595 active, firstof m_first active
2596 in
2597 G.postRedisplay "listview backspace qsearch";
2598 set1 active first qsearch
2599 );
2600
2601 | Ascii _ | Code _ ->
2602 let utf8 =
2603 match [@warning "-8"] kt with
2604 | Ascii c -> String.make 1 c
2605 | Code code -> toutf8 code
2606 in
2607 let pattern = m_qsearch ^ utf8 in
2608 let active, first =
2609 match search m_active pattern 1 with
2610 | None ->
2611 state.text <- pattern ^ " [not found]";
2612 m_active, m_first
2613 | Some active ->
2614 state.text <- pattern;
2615 active, firstof m_first active
2616 in
2617 G.postRedisplay "listview qsearch add";
2618 set1 active first pattern;
2619
2620 | Escape ->
2621 state.text <- E.s;
2622 if emptystr m_qsearch
2623 then (
2624 G.postRedisplay "list view escape";
2625 let mx, my = state.mpos in
2626 updateunder mx my;
2627 match source#exit ~uioh:(coe self) ~cancel:true ~active:m_active
2628 ~first:m_first ~pan:m_pan with
2629 | None -> m_prev_uioh
2630 | Some uioh -> uioh
2631 )
2632 else (
2633 G.postRedisplay "list view kill qsearch";
2634 coe {< m_qsearch = E.s >}
2635 )
2636
2637 | Enter ->
2638 state.text <- E.s;
2639 let self = {< m_qsearch = E.s >} in
2640 let opt =
2641 G.postRedisplay "listview enter";
2642 let cancel = not (m_active >= 0 && m_active < source#getitemcount) in
2643 source#exit ~uioh:(coe self) ~cancel
2644 ~active:m_active ~first:m_first ~pan:m_pan;
2645 in
2646 begin match opt with
2647 | None -> m_prev_uioh
2648 | Some uioh -> uioh
2649 end
2650
2651 | Delete ->
2652 coe self
2653
2654 | Up -> navigate ~-1
2655 | Down -> navigate 1
2656 | Prior -> navigate ~-(fstate.maxrows)
2657 | Next -> navigate fstate.maxrows
2658
2659 | Right ->
2660 state.text <- E.s;
2661 G.postRedisplay "listview right";
2662 coe {< m_pan = m_pan - 1 >}
2663
2664 | Left ->
2665 state.text <- E.s;
2666 G.postRedisplay "listview left";
2667 coe {< m_pan = m_pan + 1 >}
2668
2669 | Home ->
2670 let active = find 0 1 in
2671 G.postRedisplay "listview home";
2672 set active 0;
2673
2674 | End ->
2675 let first = max 0 (itemcount - fstate.maxrows) in
2676 let active = find (itemcount - 1) ~-1 in
2677 G.postRedisplay "listview end";
2678 set active first;
2679
2680 | _ -> coe self
2681
2682 method key key mask =
2683 match state.mode with
2684 | Textentry te ->
2685 textentrykeyboard key mask te;
2686 coe self
2687 | Birdseye _ | View | LinkNav _ -> self#key1 key mask
2688
2689 method button button down x y _ =
2690 let opt =
2691 match button with
2692 | 1 when vscrollhit x ->
2693 G.postRedisplay "listview scroll";
2694 if down
2695 then
2696 let _, position, sh = self#scrollph in
2697 if y > truncate position && y < truncate (position +. sh)
2698 then (
2699 state.mstate <- Mscrolly;
2700 Some (coe self)
2701 )
2702 else
2703 let s = float (max 0 (y - conf.scrollh)) /. float state.winh in
2704 let first = truncate (s *. float source#getitemcount) in
2705 let first = min source#getitemcount first in
2706 Some (coe {< m_first = first; m_active = first >})
2707 else (
2708 state.mstate <- Mnone;
2709 Some (coe self);
2710 );
2711 | 1 when down ->
2712 begin match self#elemunder y with
2713 | Some n ->
2714 G.postRedisplay "listview click";
2715 source#exit ~uioh:(coe {< m_active = n >})
2716 ~cancel:false ~active:n ~first:m_first ~pan:m_pan
2717 | _ ->
2718 Some (coe self)
2719 end
2720 | n when (n == 4 || n == 5) && not down ->
2721 let len = source#getitemcount in
2722 let first =
2723 if n = 5 && m_first + fstate.maxrows >= len
2724 then
2725 m_first
2726 else
2727 let first = m_first + (if n == 4 then -1 else 1) in
2728 bound first 0 (len - 1)
2729 in
2730 G.postRedisplay "listview wheel";
2731 Some (coe {< m_first = first >})
2732 | n when (n = 6 || n = 7) && not down ->
2733 let inc = if n = 7 then -1 else 1 in
2734 G.postRedisplay "listview hwheel";
2735 Some (coe {< m_pan = m_pan + inc >})
2736 | _ ->
2737 Some (coe self)
2738 in
2739 match opt with
2740 | None -> m_prev_uioh
2741 | Some uioh -> uioh
2742
2743 method multiclick _ x y = self#button 1 true x y
2744
2745 method motion _ y =
2746 match state.mstate with
2747 | Mscrolly ->
2748 let s = float (max 0 (y - conf.scrollh)) /. float state.winh in
2749 let first = truncate (s *. float source#getitemcount) in
2750 let first = min source#getitemcount first in
2751 G.postRedisplay "listview motion";
2752 coe {< m_first = first; m_active = first >}
2753 | Msel _
2754 | Mpan _
2755 | Mscrollx
2756 | Mzoom _
2757 | Mzoomrect _
2758 | Mnone -> coe self
2759
2760 method pmotion x y =
2761 if x < state.winw - conf.scrollbw
2762 then
2763 let n =
2764 match self#elemunder y with
2765 | None -> Wsi.setcursor Wsi.CURSOR_INHERIT; m_active
2766 | Some n -> Wsi.setcursor Wsi.CURSOR_INFO; n
2767 in
2768 let o =
2769 if n != m_active
2770 then (G.postRedisplay "listview pmotion"; {< m_active = n >})
2771 else self
2772 in
2773 coe o
2774 else (
2775 Wsi.setcursor Wsi.CURSOR_INHERIT;
2776 coe self
2777 )
2778
2779 method infochanged _ = ()
2780
2781 method scrollpw = (0, 0.0, 0.0)
2782 method scrollph =
2783 let nfs = fstate.fontsize + 1 in
2784 let y = m_first * nfs in
2785 let itemcount = source#getitemcount in
2786 let maxi = max 0 (itemcount - fstate.maxrows) in
2787 let maxy = maxi * nfs in
2788 let p, h = scrollph y maxy in
2789 conf.scrollbw, p, h
2790
2791 method modehash = modehash
2792 method eformsgs = false
2793 method alwaysscrolly = true
2794 method scroll _ dy =
2795 let self =
2796 if dy != 0 then begin
2797 let len = source#getitemcount in
2798 let first =
2799 if dy > 0 && m_first + fstate.maxrows >= len
2800 then
2801 m_first
2802 else
2803 let first = m_first + dy / 10 in
2804 bound first 0 (len - 1)
2805 in
2806 G.postRedisplay "listview wheel";
2807 {< m_first = first >}
2808 end else
2809 self
2810 in
2811 coe self
2812
2813 method zoom _ _ _ = ()
2814end;;
2815
2816class outlinelistview ~zebra ~source =2026class outlinelistview ~zebra ~source =
2817 let settext autonarrow s =2027 let settext autonarrow s =
2818 if autonarrow2028 if autonarrow

Keyboard shortcuts

General

Show keyboard shortcuts
?
Focus the current search
/

Issues and pull requests

Open filters
f

Issues, pull requests and Inbox

Select next item
j↓
Select previous item
k↑
Open selected item
Enter
Dismiss filters or clear selection
Esc

Repository code

Go to file
t