6 external init
: Unix.file_descr
-> params
-> unit = "ml_init";;
7 external seltext
: opaque
-> (int * int * int * int) -> unit = "ml_seltext";;
8 external hassel
: opaque
-> bool = "ml_hassel";;
9 external copysel
: Unix.file_descr
-> opaque
-> unit = "ml_copysel";;
10 external getpdimrect
: int -> float array
= "ml_getpdimrect";;
11 external whatsunder
: opaque
-> int -> int -> under
= "ml_whatsunder";;
12 external markunder
: opaque
-> int -> int -> mark
-> bool = "ml_markunder";;
13 external clearmark
: opaque
-> unit = "ml_clearmark";;
14 external zoomforh
: int -> int -> int -> int -> float = "ml_zoom_for_height";;
15 external getmaxw
: unit -> float = "ml_getmaxw";;
16 external drawstr
: int -> int -> int -> string -> float = "ml_draw_string";;
17 external measurestr
: int -> string -> float = "ml_measure_string";;
18 external postprocess
:
19 opaque
-> int -> int -> int -> (int * string * int) -> int
21 external pagebbox
: opaque
-> (int * int * int * int) = "ml_getpagebox";;
22 external setaalevel
: int -> unit = "ml_setaalevel";;
23 external realloctexts
: int -> bool = "ml_realloctexts";;
24 external findlink
: opaque
-> linkdir
-> link
= "ml_findlink";;
25 external getlink
: opaque
-> int -> under
= "ml_getlink";;
26 external getlinkrect
: opaque
-> int -> irect
= "ml_getlinkrect";;
27 external getlinkcount
: opaque
-> int = "ml_getlinkcount";;
28 external findpwl
: int -> int -> pagewithlinks
= "ml_find_page_with_links";;
29 external getpbo
: width
-> height
-> colorspace
-> opaque
= "ml_getpbo";;
30 external freepbo
: opaque
-> unit = "ml_freepbo";;
31 external unmappbo
: opaque
-> unit = "ml_unmappbo";;
32 external bousable
: unit -> bool = "ml_bo_usable";;
33 external unproject
: opaque
-> int -> int -> (int * int) option
35 external project
: opaque
-> int -> int -> float -> float -> (float * float)
37 external drawtile
: tileparams
-> opaque
-> unit = "ml_drawtile";;
38 external rectofblock
: opaque
-> int -> int -> float array
option
40 external begintiles
: unit -> unit = "ml_begintiles";;
41 external endtiles
: unit -> unit = "ml_endtiles";;
42 external addannot
: opaque
-> int -> int -> string -> unit = "ml_addannot";;
43 external modannot
: opaque
-> slinkindex
-> string -> unit = "ml_modannot";;
44 external delannot
: opaque
-> slinkindex
-> unit = "ml_delannot";;
45 external hasunsavedchanges
: unit -> bool = "ml_hasunsavedchanges";;
46 external savedoc
: string -> unit = "ml_savedoc";;
47 external getannotcontents
: opaque
-> slinkindex
-> string
48 = "ml_getannotcontents";;
49 external drawprect
: opaque
-> int -> int -> float array
-> unit =
51 external wcmd
: Unix.file_descr
-> bytes
-> int -> unit = "ml_wcmd";;
52 external rcmd
: Unix.file_descr
-> string = "ml_rcmd";;
53 external transformpagepoint
: int -> int -> int -> float array
54 = "ml_transform_page_point";;
55 let selfexec = ref E.s
;;
56 let opengl_has_pbo = ref false;;
58 let drawstring size x y s
=
60 Gl.enable `texture_2d
;
61 GlFunc.blend_func ~src
:`src_alpha ~dst
:`one_minus_src_alpha
;
62 ignore
(drawstr size x y s
);
64 Gl.disable `texture_2d
;
67 let drawstring1 size x y s
=
71 let drawstring2 size x y fmt
=
72 Printf.kprintf
(drawstring size
(x
+1) (y
+size
+1)) fmt
76 dolog
"l %d dim=%d {" l
.pageno l
.pagedimno
;
77 dolog
" WxH %dx%d" l
.pagew l
.pageh
;
78 dolog
" vWxH %dx%d" l
.pagevw l
.pagevh
;
79 dolog
" pagex,y %d,%d" l
.pagex l
.pagey
;
80 dolog
" dispx,y %d,%d" l
.pagedispx l
.pagedispy
;
81 dolog
" column %d" l
.pagecol
;
85 let debugrect (x0
, y0
, x1
, y1
, x2
, y2
, x3
, y3
) =
87 dolog
" x0,y0=(% f, % f)" x0 y0
;
88 dolog
" x1,y1=(% f, % f)" x1 y1
;
89 dolog
" x2,y2=(% f, % f)" x2 y2
;
90 dolog
" x3,y3=(% f, % f)" x3 y3
;
94 let isbirdseye = function
101 let istextentry = function
102 | Textentry _
-> true
108 let wtmode = ref false;;
109 let cxack = ref false;;
111 let pgscale h
= truncate
(float h
*. conf
.pgscale);;
114 if state
.uioh#alwaysscrolly
|| ((conf
.scrollb
land scrollbhv
!= 0)
115 && (state
.w
> state
.winw
))
121 if state
.uioh#alwaysscrolly
|| ((conf
.scrollb
land scrollbvv
!= 0)
122 && (state
.maxy
> state
.winh
))
130 else x
> state
.winw
- vscrollw ()
134 fstate
.fontsize
<- n
;
135 fstate
.wwidth
<- measurestr fstate
.fontsize
"w";
136 fstate
.maxrows
<- (state
.winh
- fstate
.fontsize
- 1) / (fstate
.fontsize
+ 1);
142 else Printf.kprintf ignore fmt
146 if emptystr conf
.pathlauncher
147 then dolog
"%s" state
.path
149 let command = Str.global_replace percentsre state
.path conf
.pathlauncher
in
150 match spawn
command [] with
153 dolog
"failed to execute `%s': %s" command @@ exntos exn
159 let postRedisplay who
=
160 vlog "redisplay for [%S]" who
;
161 state
.redisplay
<- true;
165 let getopaque pageno
=
166 try Some
(Hashtbl.find state
.pagemap
(pageno
, state
.gen
))
167 with Not_found
-> None
170 let pagetranslatepoint l x y
=
171 let dy = y
- l
.pagedispy
in
172 let y = dy + l
.pagey
in
173 let dx = x
- l
.pagedispx
in
174 let x = dx + l
.pagex
in
178 let onppundermouse g
x y d
=
181 begin match getopaque l
.pageno
with
183 let x0 = l
.pagedispx
in
184 let x1 = x0 + l
.pagevw
in
185 let y0 = l
.pagedispy
in
186 let y1 = y0 + l
.pagevh
in
187 if y >= y0 && y <= y1 && x >= x0 && x <= x1
189 let px, py
= pagetranslatepoint l
x y in
190 match g opaque l
px py
with
203 let g opaque l
px py
=
206 match rectofblock opaque
px py
with
207 | Some
[|x0;x1;y0;y1|] ->
208 let rect = (x0, y0, x1, y0, x1, y1, x0, y1) in
209 let color = (0.0, 0.0, 1.0 /. (l
.pageno
mod 3 |> float), 0.5) in
210 state
.rects
<- [l
.pageno
, color, rect];
211 G.postRedisplay "getunder";
214 let under = whatsunder opaque
px py
in
215 if under = Unone
then None
else Some
under
217 onppundermouse g x y Unone
222 match unproject opaque
x y with
223 | Some
(x, y) -> Some
(Some
(opaque
, l
.pageno
, x, y))
226 onppundermouse g x y None
;
230 state
.text
<- Printf.sprintf
"%c%s" c s
;
231 G.postRedisplay "showtext";
235 Format.ksprintf
(fun s
-> showtext '
!' s
) fmt
;
238 let pipesel opaque cmd
=
241 match Unix.pipe
() with
242 | (exception exn
) -> dolog
"pipesel cannot create pipe: %S" @@ exntos exn
;
244 let doclose what fd
=
245 Ne.clo fd
(fun msg
-> dolog
"%s close failed: %s" what msg
)
248 try spawn cmd
[r
, 0; w
, -1]
250 dolog
"cannot execute %S: %s" cmd
@@ exntos exn
;
256 G.postRedisplay "pipesel";
258 else doclose "pipesel pipe/w" w
;
259 doclose "pipesel pipe/r" r
;
263 let g opaque l
px py
=
264 if markunder opaque
px py conf
.paxmark
267 match getopaque l
.pageno
with
269 | Some opaque
-> pipesel opaque conf
.paxcmd
274 G.postRedisplay "paxunder";
275 if conf
.paxmark
= Mark_page
278 match getopaque l
.pageno
with
280 | Some opaque
-> clearmark opaque
) state
.layout
;
281 state
.roam
<- onppundermouse g x y (fun () -> impmsg "whoopsie daisy");
285 match Unix.pipe
() with
286 | (exception exn
) -> impmsg "pipe failed: %s" @@ exntos exn
289 Ne.clo fd
(fun msg
-> impmsg "failed to close %s: %s" cap msg
)
292 try spawn conf
.selcmd
[r
, 0; w
, -1]
294 impmsg "failed to execute %s: %s" conf
.selcmd
@@ exntos exn
;
300 let l = String.length s
in
301 let bytes = Bytes.unsafe_of_string s
in
302 let n = tempfailureretry
(Unix.write w
bytes 0) l in
304 then impmsg "failed to write %d characters to sel pipe, wrote %d"
307 impmsg "failed to write to sel pipe: %s" @@ exntos exn
310 clo "selstring pipe/r" r
;
311 clo "selstring pipe/w" w
;
314 let undertext ?
(nopath
=false) = function
317 | Ulinkgoto
(pageno
, _
) ->
319 then "page " ^ string_of_int
(pageno
+1)
320 else Printf.sprintf
"%s: page %d" state
.path
(pageno
+1)
321 | Utext s
-> "font: " ^ s
322 | Uunexpected s
-> "unexpected: " ^ s
323 | Ulaunch s
-> "launch: " ^ s
324 | Unamed s
-> "named: " ^ s
325 | Uremote
(filename
, pageno
) ->
326 Printf.sprintf
"%s: page %d" filename
(pageno
+1)
327 | Uremotedest
(filename
, destname
) ->
328 Printf.sprintf
"%s: destination %S" filename destname
329 | Uannotation
(opaque
, slinkindex
) ->
330 "annotation: " ^ getannotcontents opaque slinkindex
333 let updateunder x y =
334 match getunder x y with
335 | Unone
-> Wsi.setcursor
Wsi.CURSOR_INHERIT
337 if conf
.underinfo
then showtext 'u'
("ri: " ^ uri
);
338 Wsi.setcursor
Wsi.CURSOR_INFO
339 | Ulinkgoto
(pageno
, _
) ->
341 then showtext 'p'
("age: " ^ string_of_int
(pageno
+1));
342 Wsi.setcursor
Wsi.CURSOR_INFO
344 if conf
.underinfo
then showtext '
f'
("ont: " ^ s
);
345 Wsi.setcursor
Wsi.CURSOR_TEXT
347 if conf
.underinfo
then showtext 'u'
("nexpected: " ^ s
);
348 Wsi.setcursor
Wsi.CURSOR_INHERIT
350 if conf
.underinfo
then showtext '
l'
("aunch: " ^ s
);
351 Wsi.setcursor
Wsi.CURSOR_INHERIT
353 if conf
.underinfo
then showtext '
n'
("amed: " ^ s
);
354 Wsi.setcursor
Wsi.CURSOR_INHERIT
355 | Uremote
(filename
, pageno
) ->
356 if conf
.underinfo
then showtext 'r'
357 (Printf.sprintf
"emote: %s (%d)" filename
(pageno
+1));
358 Wsi.setcursor
Wsi.CURSOR_INFO
359 | Uremotedest
(filename
, destname
) ->
360 if conf
.underinfo
then showtext 'r'
361 (Printf.sprintf
"emote destination: %s (%S)" filename destname
);
362 Wsi.setcursor
Wsi.CURSOR_INFO
364 if conf
.underinfo
then showtext 'a'
"nnotation";
365 Wsi.setcursor
Wsi.CURSOR_INFO
368 let showlinktype under =
369 if conf
.underinfo
&& under != Unone
370 then showtext ' '
@@ undertext under
373 let intentry_with_suffix text key
=
375 if key
>= 32 && key
< 127
377 let c = Char.chr key
in
382 | 'k'
| 'm'
| '
g'
| 'K'
| 'M'
| 'G'
->
383 addchar
text @@ asciilower
c
385 state
.text <- Printf.sprintf
"invalid key (%d, `%c')" key
c;
388 state
.text <- Printf.sprintf
"invalid key %d" key
;
396 let b = Buffer.create
16 in
397 Buffer.add_string
b "llll";
400 let b = Buffer.to_bytes
b in
401 wcmd state
.ss
b @@ Bytes.length
b
405 let nogeomcmds cmds
=
407 | s
, [] -> emptystr s
411 let layoutN ((columns
, coverA
, coverB
), b) x y sw sh
=
412 let rec fold accu
n =
413 if n = Array.length
b
416 let pdimno, dx, vy
, (_
, w
, h
, xoff
) = b.(n) in
419 || n = state
.pagecount
- coverB
420 || (n - coverA
) mod columns
= columns
- 1)
426 let pagey = max
0 (y - vy
) in
427 let pagedispy = if pagey > 0 then 0 else vy
- y in
428 let pagedispx, pagex
=
430 if n = coverA
- 1 || n = state
.pagecount
- coverB
431 then x + (sw
- w
) / 2
439 let vw = sw
- pagedispx in
440 let pw = w
- pagex
in
443 let pagevh = min
(h
- pagey) (sh
- pagedispy) in
444 if pagevw > 0 && pagevh > 0
455 ; pagedispx = pagedispx
456 ; pagedispy = pagedispy
468 if Array.length
b = 0
470 else List.rev
(fold [] (page_of_y
y))
473 let layoutS (columns
, b) x y sw sh
=
474 let rec fold accu n =
475 if n = Array.length
b
478 let pdimno, px, vy
, (_
, pagew
, pageh
, xoff
) = b.(n) in
486 let pagey = max
0 (y - vy
) in
487 let pagedispy = if pagey > 0 then 0 else vy
- y in
488 let pagedispx, pagex
=
502 let pagecolw = pagew
/columns
in
505 then pagedispx + ((sw
- pagecolw) / 2)
509 let vw = sw
- pagedispx in
510 let pw = pagew
- pagex
in
513 let pagevw = min
pagevw pagecolw in
514 let pagevh = min
(pageh
- pagey) (sh
- pagedispy) in
515 if pagevw > 0 && pagevh > 0
526 ; pagedispx = pagedispx
527 ; pagedispy = pagedispy
528 ; pagecol
= n mod columns
542 let layout x y sw sh
=
543 if nogeomcmds state
.geomcmds
545 match conf
.columns
with
546 | Csingle
b -> layoutN ((1, 0, 0), b) x y sw sh
547 | Cmulti
c -> layoutN c x y sw sh
548 | Csplit s
-> layoutS s
x y sw sh
553 let y = state
.y + incr
in
555 let y = min
y (state
.maxy
- (if conf
.maxhfit
then state
.winh
else 0)) in
560 let tilex = l.pagex
mod conf
.tilew
in
561 let tiley = l.pagey mod conf
.tileh
in
563 let col = l.pagex
/ conf
.tilew
in
564 let row = l.pagey / conf
.tileh
in
566 let rec rowloop row y0 dispy h
=
570 let dh = conf
.tileh
- y0 in
572 let rec colloop col x0 dispx w
=
576 let dw = conf
.tilew
- x0 in
578 f col row dispx dispy
x0 y0 dw dh;
579 colloop (col+1) 0 (dispx
+dw) (w
-dw)
582 colloop col tilex l.pagedispx l.pagevw;
583 rowloop (row+1) 0 (dispy
+dh) (h
-dh)
586 if l.pagevw > 0 && l.pagevh > 0
587 then rowloop row tiley l.pagedispy l.pagevh;
590 let gettileopaque l col row =
592 l.pageno
, state
.gen
, conf
.colorspace
, conf
.angle
, l.pagew
, l.pageh
, col, row
594 try Some
(Hashtbl.find state
.tilemap
key)
595 with Not_found
-> None
598 let puttileopaque l col row gen colorspace angle opaque size elapsed
=
599 let key = l.pageno
, gen
, colorspace
, angle
, l.pagew
, l.pageh
, col, row in
600 Hashtbl.add state
.tilemap
key (opaque
, size
, elapsed
)
603 let filledrect2 x0 y0 x1 y1 x2 y2 x3 y3
=
604 Raw.sets_float state
.vraw ~pos
:0 [| x0; y0; x1; y1; x2
; y2
; x3
; y3
|];
605 GlArray.vertex `two state
.vraw
;
606 GlArray.draw_arrays `triangle_strip ~first
:0 ~count
:4;
609 let filledrect1 x0 y0 x1 y1 = filledrect2 x0 y0 x0 y1 x1 y0 x1 y1;;
611 let filledrect x0 y0 x1 y1 =
612 GlArray.disable `texture_coord
;
613 filledrect1 x0 y0 x1 y1;
614 GlArray.enable `texture_coord
;
617 let linerect x0 y0 x1 y1 =
618 GlArray.disable `texture_coord
;
619 Raw.sets_float state
.vraw ~pos
:0 [| x0; y0; x0; y1; x1; y1; x1; y0 |];
620 GlArray.vertex `two state
.vraw
;
621 GlArray.draw_arrays `line_loop ~first
:0 ~count
:4;
622 GlArray.enable `texture_coord
;
625 let drawtiles l color =
628 let f col row x y tilex tiley w h
=
629 match gettileopaque l col row with
630 | Some
(opaque
, _
, t
) ->
631 let params = x, y, w
, h
, tilex, tiley in
633 then GlTex.env
(`mode `blend
);
634 drawtile
params opaque
;
636 then GlTex.env
(`mode `modulate
);
640 let s = Printf.sprintf
644 let w = measurestr fstate
.fontsize
s in
645 GlDraw.color (0.0, 0.0, 0.0);
646 filledrect (float (x-2))
649 (float (y + fstate
.fontsize
+ 2));
651 drawstring fstate
.fontsize
x (y + fstate
.fontsize
- 1) s;
658 let lw = state
.winw
- x in
661 let lh = state
.winh
- y in
665 then GlTex.env
(`mode `blend
);
666 begin match state
.checkerstexid
with
668 Gl.enable `texture_2d
;
669 GlTex.bind_texture ~target
:`texture_2d id
;
673 and y1 = float (y+h
) in
675 let tw = float w /. 16.0
676 and th
= float h
/. 16.0 in
677 let tx0 = float tilex /. 16.0
678 and ty0
= float tiley /. 16.0 in
680 and ty1
= ty0
+. th
in
681 Raw.sets_float state
.vraw ~pos
:0
682 [| x0; y0; x0; y1; x1; y0; x1; y1 |];
683 Raw.sets_float state
.traw ~pos
:0
684 [| tx0; ty0
; tx0; ty1
; tx1; ty0
; tx1; ty1
|];
685 GlArray.vertex `two state
.vraw
;
686 GlArray.tex_coord `two state
.traw
;
687 GlArray.draw_arrays `triangle_strip ~first
:0 ~count
:4;
688 Gl.disable `texture_2d
;
691 GlDraw.color (1.0, 1.0, 1.0);
692 filledrect (float x) (float y) (float (x+w)) (float (y+h
));
695 then GlTex.env
(`mode `modulate
);
696 if w > 128 && h
> fstate
.fontsize
+ 10
698 let c = if conf
.invert
then 1.0 else 0.0 in
699 GlDraw.color (c, c, c);
702 then (col*conf
.tilew
, row*conf
.tileh
)
705 drawstring2 fstate
.fontsize
x y "Loading %d [%d,%d]" l.pageno
c r
;
714 let pagevisible layout n = List.exists
(fun l -> l.pageno
= n) layout;;
716 let tilevisible1 l x y =
718 and ax1
= l.pagex
+ l.pagevw
720 and ay1
= l.pagey + l.pagevh in
724 let bx1 = min
(bx0 + conf
.tilew
) l.pagew
725 and by1
= min
(by0
+ conf
.tileh
) l.pageh
in
727 let rx0 = max
ax0 bx0
728 and ry0
= max ay0 by0
729 and rx1
= min ax1
bx1
730 and ry1
= min ay1 by1
in
732 let nonemptyintersection = rx1
> rx0 && ry1
> ry0
in
736 let tilevisible layout n x y =
737 let rec findpageinlayout m
= function
738 | l :: rest
when l.pageno
= n ->
739 tilevisible1 l x y || (
740 match conf
.columns
with
741 | Csplit
(c, _
) when c > m
-> findpageinlayout (m
+1) rest
746 | _
:: rest
-> findpageinlayout 0 rest
749 findpageinlayout 0 layout;
752 let tileready l x y =
753 tilevisible1 l x y &&
754 gettileopaque l (x/conf
.tilew
) (y/conf
.tileh
) != None
757 let tilepage n p
layout =
758 let rec loop = function
762 let f col row _ _ _ _ _ _
=
763 if state
.currently
= Idle
765 match gettileopaque l col row with
768 let x = col*conf
.tilew
769 and y = row*conf
.tileh
in
771 let w = l.pagew
- x in
775 let h = l.pageh
- y in
780 then getpbo
w h conf
.colorspace
783 wcmd "tile %s %d %d %d %d %s"
784 (~
> p
) x y w h (~
> pbo);
787 l, p
, conf
.colorspace
, conf
.angle
,
788 state
.gen
, col, row, conf
.tilew
, conf
.tileh
797 if nogeomcmds state
.geomcmds
801 let preloadlayout x y sw sh
=
802 let y = if y < sh
then 0 else y - sh
in
803 let x = min
0 (x + sw
) in
811 if state
.currently
!= Idle
816 begin match getopaque l.pageno
with
818 wcmd "page %d %d" l.pageno
l.pagedimno
;
819 state
.currently
<- Loading
(l, state
.gen
);
821 tilepage l.pageno opaque pages
;
826 if nogeomcmds state
.geomcmds
832 if conf
.preload && state
.currently
= Idle
833 then load (preloadlayout state
.x state
.y state
.winw state
.winh
);
836 let layoutready layout =
837 let rec fold all ls
=
840 let seen = ref false in
841 let allvisible = ref true in
842 let foo col row _ _ _ _ _ _
=
844 allvisible := !allvisible &&
845 begin match gettileopaque l col row with
851 fold (!seen && !allvisible) rest
854 let alltilesvisible = fold true layout in
859 let y = bound
y 0 state
.maxy
in
860 let y, layout, proceed
=
861 match conf
.maxwait
with
862 | Some time
when state
.ghyll
== noghyll
->
863 begin match state
.throttle
with
865 let layout = layout x y state
.winw state
.winh
in
866 let ready = layoutready layout in
870 state
.throttle
<- Some
(layout, y, now
());
872 else G.postRedisplay "gotoxy showall (None)";
874 | Some
(_
, _
, started
) ->
875 let dt = now
() -. started
in
878 state
.throttle
<- None
;
879 let layout = layout x y state
.winw state
.winh
in
881 G.postRedisplay "maxwait";
888 let layout = layout x y state
.winw state
.winh
in
889 if not
!wtmode || layoutready layout
890 then G.postRedisplay "gotoxy ready";
897 state
.layout <- layout;
898 begin match state
.mode
with
901 | Ltexact
(pageno
, linkno
) ->
902 let rec loop = function
904 state
.mode
<- LinkNav
(Ltgendir
0)
905 | l :: _
when l.pageno
= pageno
->
906 begin match getopaque pageno
with
907 | None
-> state
.mode
<- LinkNav
(Ltnotready
(pageno
, 0))
909 let x0, y0, x1, y1 = getlinkrect opaque linkno
in
910 if not
(x0 >= l.pagex
&& x1 <= l.pagex
+ l.pagevw
911 && y0 >= l.pagey && y1 <= l.pagey + l.pagevh)
912 then state
.mode
<- LinkNav
(Ltgendir
0)
914 | _
:: rest
-> loop rest
917 | Ltnotready _
| Ltgendir _
-> ()
923 begin match state
.mode
with
924 | Birdseye
(conf
, leftx
, pageno
, hooverpageno
, anchor
) ->
925 if not
(pagevisible layout pageno
)
927 match state
.layout with
930 state
.mode
<- Birdseye
(
931 conf
, leftx
, l.pageno
, hooverpageno
, anchor
936 | Ltnotready
(_
, dir
)
939 let rec loop = function
942 match getopaque l.pageno
with
943 | None
-> Ltnotready
(l.pageno
, dir
)
948 then LDfirstvisible
(l.pagex
, l.pagey, dir
)
950 if dir
> 0 then LDfirst
else LDlast
956 | Lnotfound
-> loop rest
958 showlinktype (getlink opaque
n);
959 Ltexact
(l.pageno
, n)
963 state
.mode
<- LinkNav
linknav
971 state
.ghyll
<- noghyll
;
974 let mx, my
= state
.mpos
in
979 let conttiling pageno opaque
=
980 tilepage pageno opaque
982 then preloadlayout state
.x state
.y state
.winw state
.winh
986 let gotoxy_and_clear_text x y =
987 if not conf
.verbose
then state
.text <- E.s;
991 let getanchory (n, top
, dtop
) =
992 let y, h = getpageyh
n in
995 let ips = calcips
h in
996 y + truncate
(top
*.float h -. dtop
*.float ips) + ips;
998 y + truncate
(top
*.float h -. dtop
*.float conf
.interpagespace
)
1001 let gotoanchor anchor
=
1002 gotoxy state
.x (getanchory anchor
);
1006 cbput state
.hists
.nav
(getanchor
());
1010 let anchor = cbgetc state
.hists
.nav dir
in
1014 let gotoghyll1 single
y =
1015 let scroll f n a
b =
1016 (* http://devmaster.net/forums/topic/9796-ease-in-ease-out-algorithm/ *)
1018 let s x = 3.0*.x**2.0 -. 2.0*.x**3.0 in
1020 then s (float f /. float a
)
1023 then 1.0 -. s ((float (f-b) /. float (n-b)))
1029 let ins = float a
*. 0.5
1030 and outs
= float (n-b) *. 0.5 in
1032 ins +. outs
+. float ones
1034 let rec set nab
y sy
=
1035 let (_N
, _A
, _B
), y =
1038 let scl = if y > sy
then 2 else -2 in
1039 let _N, _
, _
= nab
in
1040 (_N,0,_N), y+conf
.scrollstep
*scl
1042 let sum = summa
_N _A _B
in
1043 let dy = float (y - sy
) in
1047 then state
.ghyll
<- noghyll
1050 let s = scroll n _N _A _B
in
1051 let y1 = y1 +. ((s *. dy) /. sum) in
1052 gotoxy_and_clear_text state
.x (truncate
y1);
1053 state
.ghyll
<- gf (n+1) y1;
1057 | Some
y'
when single
-> set nab
y' state
.y
1058 | Some
y'
-> set (_N/2, 1, 1) y' state
.y
1060 gf 0 (float state
.y)
1063 match conf
.ghyllscroll
with
1064 | Some nab
when not conf
.presentation
->
1065 if state
.ghyll
== noghyll
1066 then set nab
y state
.y
1067 else state
.ghyll
(Some
y)
1069 gotoxy_and_clear_text state
.x y
1072 let gotoghyll = gotoghyll1 false;;
1074 let gotopage n top
=
1075 let y, h = getpageyh
n in
1076 let y = y + (truncate
(top
*. float h)) in
1080 let gotopage1 n top
=
1081 let y = getpagey
n in
1086 let invalidate s f =
1087 state
.redisplay
<- false;
1092 match state
.geomcmds
with
1093 | ps
, [] when emptystr ps
->
1095 state
.geomcmds
<- s, [];
1098 state
.geomcmds
<- ps
, [s, f];
1100 | ps
, (s'
, _
) :: rest
when s'
= s ->
1101 state
.geomcmds
<- ps
, ((s, f) :: rest
);
1104 state
.geomcmds
<- ps
, ((s, f) :: cmds
);
1108 Hashtbl.iter
(fun _ opaque
->
1109 wcmd "freepage %s" (~
> opaque
);
1111 Hashtbl.clear state
.pagemap
;
1115 if not
(Queue.is_empty state
.tilelru
)
1117 Queue.iter
(fun (k
, p
, s) ->
1118 wcmd "freetile %s" (~
> p
);
1119 state
.memused
<- state
.memused
- s;
1120 Hashtbl.remove state
.tilemap k
;
1122 state
.uioh#infochanged Memused
;
1123 Queue.clear state
.tilelru
;
1129 let h = truncate
(float h*.conf
.zoom
) in
1130 let d = conf
.interpagespace
lsl (if conf
.presentation
then 1 else 0) in
1134 let opendoc path password
=
1136 state
.password
<- password
;
1137 state
.gen
<- state
.gen
+ 1;
1138 state
.docinfo
<- [];
1139 state
.outlines
<- [||];
1142 setaalevel conf
.aalevel
;
1144 if emptystr state
.origin
1148 Wsi.settitle
("llpp " ^
(mbtoutf8
(Filename.basename
titlepath)));
1149 wcmd "open %d %d %s\000%s\000" (btod
!wtmode) (btod
!cxack) path password
;
1150 invalidate "reqlayout"
1152 wcmd "reqlayout %d %d %d %s\000"
1153 conf
.angle
(FMTE.to_int conf
.fitmodel
)
1154 (stateh state
.winh
) state
.nameddest
1159 state
.anchor <- getanchor
();
1160 opendoc state
.path state
.password
;
1164 let c = c *. conf
.colorscale
in
1168 let scalecolor2 (r
, g, b) =
1169 (r
*. conf
.colorscale
, g *. conf
.colorscale
, b *. conf
.colorscale
);
1172 let docolumns columns
=
1175 let a = Array.make state
.pagecount
(-1, -1, -1, (-1, -1, -1, -1)) in
1176 let rec loop pageno
pdimno pdim
y ph pdims
=
1177 if pageno
= state
.pagecount
1180 let pdimno, ((_
, w, h, xoff
) as pdim
), pdims
=
1182 | ((pageno'
, _
, _
, _
) as pdim
) :: rest
when pageno'
= pageno
->
1183 pdimno+1, pdim
, rest
1187 let x = max
0 (((state
.winw
- w) / 2) - xoff
) in
1189 (if conf
.presentation
1190 then (if pageno
= 0 then calcips
h else calcips ph
+ calcips
h)
1191 else (if pageno
= 0 then 0 else conf
.interpagespace
)
1194 a.(pageno
) <- (pdimno, x, y, pdim
);
1195 loop (pageno
+1) pdimno pdim
(y + h) h pdims
1197 loop 0 ~
-1 (-1,-1,-1,-1) 0 0 state
.pdims
;
1198 conf
.columns
<- Csingle
a;
1200 | Cmulti
((columns
, coverA
, coverB
), _
) ->
1201 let a = Array.make state
.pagecount
(-1, -1, -1, (-1, -1, -1, -1)) in
1202 let rec loop pageno
pdimno pdim
x y rowh pdims
=
1203 let rec fixrow m
= if m
= pageno
then () else
1204 let (pdimno, x, y, ((_
, _
, h, _
) as pdim
)) = a.(m
) in
1207 let y = y + (rowh
- h) / 2 in
1208 a.(m
) <- (pdimno, x, y, pdim
);
1212 if pageno
= state
.pagecount
1213 then fixrow (((pageno
- 1) / columns
) * columns
)
1215 let pdimno, ((_
, w, h, xoff
) as pdim
), pdims
=
1217 | ((pageno'
, _
, _
, _
) as pdim
) :: rest
when pageno'
= pageno
->
1218 pdimno+1, pdim
, rest
1223 if pageno
= coverA
- 1 || pageno
= state
.pagecount
- coverB
1225 let x = (state
.winw
- w) / 2 in
1227 if conf
.presentation
then calcips
h else conf
.interpagespace
in
1228 x, y + ips + rowh
, h
1231 if (pageno
- coverA
) mod columns
= 0
1233 let x = max
0 (state
.winw
- state
.w) / 2 in
1235 if conf
.presentation
1237 let ips = calcips
h in
1238 y + (if pageno
= 0 then 0 else calcips rowh
+ ips)
1240 y + (if pageno
= 0 then 0 else conf
.interpagespace
)
1244 else x, y, max rowh
h
1248 if pageno
> 1 && (pageno
- coverA
) mod columns
= 0
1251 if pageno
= columns
&& conf
.presentation
1253 let ips = calcips rowh
in
1254 for i
= 0 to pred columns
1256 let (pdimno, x, y, pdim
) = a.(i
) in
1257 a.(i
) <- (pdimno, x, y+ips, pdim
)
1263 fixrow (pageno
- columns
);
1268 a.(pageno
) <- (pdimno, x, y, pdim
);
1269 let x = x + w + xoff
*2 + conf
.interpagespace
in
1270 loop (pageno
+1) pdimno pdim
x y rowh' pdims
1272 loop 0 ~
-1 (-1,-1,-1,-1) 0 0 0 state
.pdims
;
1273 conf
.columns
<- Cmulti
((columns
, coverA
, coverB
), a);
1276 let a = Array.make
(state
.pagecount
*c) (-1, -1, -1, (-1, -1, -1, -1)) in
1277 let rec loop pageno
pdimno pdim
y pdims
=
1278 if pageno
= state
.pagecount
1281 let pdimno, ((_
, w, h, _
) as pdim
), pdims
=
1283 | ((pageno'
, _
, _
, _
) as pdim
) :: rest
when pageno'
= pageno
->
1284 pdimno+1, pdim
, rest
1289 let rec loop1 n x y =
1290 if n = c then y else (
1291 a.(pageno
*c + n) <- (pdimno, x, y, pdim
);
1292 loop1 (n+1) (x+cw) (y + h + conf
.interpagespace
)
1295 let y = loop1 0 0 y in
1296 loop (pageno
+1) pdimno pdim
y pdims
1298 loop 0 ~
-1 (-1,-1,-1,-1) 0 state
.pdims
;
1299 conf
.columns
<- Csplit
(c, a);
1303 docolumns conf
.columns
;
1304 state
.maxy
<- calcheight
();
1305 if state
.reprf
== noreprf
1307 match state
.mode
with
1308 | Birdseye
(_
, _
, pageno
, _
, _
) ->
1309 let y, h = getpageyh pageno
in
1310 let top = (state
.winh
- h) / 2 in
1311 gotoxy state
.x (max
0 (y - top))
1315 let y = getanchory state
.anchor in
1316 let y = min
y (state
.maxy
- state
.winh
) in
1321 state
.reprf
<- noreprf
;
1325 let reshape ?
(firsttime
=false) w h =
1326 GlDraw.viewport ~
x:0 ~
y:0 ~
w ~
h;
1327 if not firsttime
&& nogeomcmds state
.geomcmds
1328 then state
.anchor <- getanchor
();
1331 let w = truncate
(float w *. conf
.zoom
) in
1334 setfontsize fstate
.fontsize
;
1335 GlMat.mode `modelview
;
1336 GlMat.load_identity
();
1338 GlMat.mode `projection
;
1339 GlMat.load_identity
();
1340 GlMat.rotate ~
x:1.0 ~angle
:180.0 ();
1341 GlMat.translate ~
x:~
-.1.0 ~
y:~
-.1.0 ();
1342 GlMat.scale3
(2.0 /. float state
.winw
, 2.0 /. float state
.winh
, 1.0);
1347 else float state
.x /. float state
.w
1349 invalidate "geometry"
1353 then state
.x <- truncate
(relx *. float w);
1355 match conf
.columns
with
1357 | Cmulti
((c, _
, _
), _
) -> (w - (c-1)*conf
.interpagespace
) / c
1358 | Csplit
(c, _
) -> w * c
1360 wcmd "geometry %d %d %d"
1361 w (stateh h) (FMTE.to_int conf
.fitmodel
)
1366 let len = String.length state
.text in
1367 let x0 = if conf
.leftscroll
then vscrollw () else 0 in
1370 match state
.mode
with
1371 | Textentry _
| View
| LinkNav _
->
1372 let h, _
, _
= state
.uioh#scrollpw
in
1377 filledrect x (float (state
.winh
- (fstate
.fontsize
+ 4) - hscrollh))
1378 (x+.w) (float (state
.winh
- hscrollh))
1381 let w = float (state
.winw
- 1 - vscrollw ()) in
1382 if state
.progress
>= 0.0 && state
.progress
< 1.0
1384 GlDraw.color (0.3, 0.3, 0.3);
1385 let w1 = w *. state
.progress
in
1387 GlDraw.color (0.0, 0.0, 0.0);
1388 rect (float x0+.w1) (float x0+.w-.w1)
1391 GlDraw.color (0.0, 0.0, 0.0);
1395 GlDraw.color (1.0, 1.0, 1.0);
1396 drawstring fstate
.fontsize
1397 (if conf
.leftscroll
then x0 + 2 else x0 + if len > 0 then 8 else 2)
1398 (state
.winh
- hscrollh - 5) s;
1401 match state
.mode
with
1402 | Textentry
((prefix
, text, _
, _
, _
, _
), _
) ->
1406 Printf.sprintf
"%s%s_ [%s]" prefix
text state
.text
1408 Printf.sprintf
"%s%s_" prefix
text
1414 | LinkNav _
-> state
.text
1419 if not
(istextentry state
.mode
) && state
.uioh#eformsgs
1421 let s1 = "(press 'e' to review error messasges)" in
1422 if nonemptystr
s then s ^
" " ^
s1 else s1
1432 let len = Queue.length state
.tilelru
in
1434 match state
.throttle
with
1437 then preloadlayout state
.x state
.y state
.winw state
.winh
1439 | Some
(layout, _
, _
) ->
1443 if state
.memused
<= conf
.memlimit
1448 let (k
, p
, s) as lruitem
= Queue.pop state
.tilelru
in
1449 let n, gen
, colorspace
, angle
, pagew
, pageh
, col, row = k
in
1450 let (_
, pw, ph
, _
) = getpagedim
n in
1453 && colorspace
= conf
.colorspace
1454 && angle
= conf
.angle
1458 let x = col*conf
.tilew
1459 and y = row*conf
.tileh
in
1460 tilevisible (Lazy.force_val
layout) n x y
1462 then Queue.push lruitem state
.tilelru
1465 wcmd "freetile %s" (~
> p
);
1466 state
.memused
<- state
.memused
- s;
1467 state
.uioh#infochanged Memused
;
1468 Hashtbl.remove state
.tilemap k
;
1476 let onpagerect pageno
f =
1478 match conf
.columns
with
1479 | Cmulti
(_
, b) -> b
1481 | Csplit
(_
, b) -> b
1483 if pageno
>= 0 && pageno
< Array.length
b
1485 let (_
, _
, _
, (_
, w, h, _
)) = b.(pageno
) in
1489 let gotopagexy1 wtmode pageno
x y =
1490 let _,w1,h1
,leftx
= getpagedim pageno
in
1491 let top = y /. (float h1
) in
1492 let left = x /. (float w1) in
1493 let py, w, h = getpageywh pageno
in
1494 let wh = state
.winh
in
1495 let x = left *. (float w) in
1496 let x = leftx
+ state
.x + truncate
x in
1498 if x < 0 || x >= state
.winw
1502 let pdy = truncate
(top *. float h) in
1503 let y'
= py + pdy in
1504 let dy = y'
- state
.y in
1506 if x != state
.x || not
(dy > 0 && dy < wh)
1508 if conf
.presentation
1510 if abs
(py - y'
) > wh
1517 if state
.x != sx || state
.y != sy
1522 let ww = state
.winw
in
1524 and qy
= pdy / wh in
1526 and y = py + qy
* wh in
1527 let x = if -x + ww > w1 then -(w1-ww) else x
1528 and y'
= if y + wh > state
.maxy
then state
.maxy
- wh else y in
1530 if conf
.presentation
1532 if abs
(py - y'
) > wh
1541 gotoxy_and_clear_text x y;
1543 else gotoxy_and_clear_text state
.x state
.y;
1546 let gotopagexy wtmode pageno
x y =
1547 match state
.mode
with
1548 | Birdseye
_ -> gotopage pageno
0.0
1551 | LinkNav
_ -> gotopagexy1 wtmode pageno
x y
1554 let getpassword () =
1555 let passcmd = getenvwithdef
"LLPP_ASKPASS" conf
.passcmd in
1560 impmsg "error getting password: %s" s;
1561 dolog
"%s" s) passcmd;
1564 let pgoto opaque pageno
x y =
1565 let pdimno = getpdimno pageno
in
1566 let x, y = project opaque pageno
pdimno x y in
1567 gotopagexy false pageno
x y;
1571 (* dolog "%S" cmds; *)
1572 let spl = splitatspace cmds
in
1574 try Scanf.sscanf
s fmt
f
1576 dolog
"error processing '%S': %s" cmds
@@ exntos exn
;
1579 let addoutline outline
=
1580 match state
.currently
with
1581 | Outlining outlines
->
1582 state
.currently
<- Outlining
(outline
:: outlines
)
1583 | Idle
-> state
.currently
<- Outlining
[outline
]
1586 dolog
"invalid outlining state";
1587 logcurrently state
.currently
1591 state
.uioh#infochanged Pdim
;
1594 | "clearrects", "" ->
1595 state
.rects
<- state
.rects1
;
1596 G.postRedisplay "clearrects";
1598 | "continue", args
->
1599 let n = scan args
"%u" (fun n -> n) in
1600 state
.pagecount
<- n;
1601 begin match state
.currently
with
1603 state
.currently
<- Idle
;
1604 state
.outlines
<- Array.of_list
(List.rev
l)
1610 let cur, cmds
= state
.geomcmds
in
1612 then failwith
"umpossible";
1614 begin match List.rev cmds
with
1616 state
.geomcmds
<- E.s, [];
1617 state
.throttle
<- None
;
1621 state
.geomcmds
<- s, List.rev rest
;
1623 if conf
.maxwait
= None
&& not
!wtmode
1624 then G.postRedisplay "continue";
1631 then showtext ' ' args
1634 Buffer.add_string state
.errmsgs args
;
1635 state
.newerrmsgs
<- true;
1636 G.postRedisplay "error message"
1638 | "progress", args
->
1639 let progress, text =
1642 f, String.sub args pos
(String.length args
- pos
))
1645 state
.progress <- progress;
1646 G.postRedisplay "progress"
1648 | "firstmatch", args
->
1649 let pageno, c, x0, y0, x1, y1, x2
, y2
, x3
, y3
=
1650 scan args
"%u %d %f %f %f %f %f %f %f %f"
1651 (fun p
c x0 y0 x1 y1 x2 y2 x3 y3
->
1652 (p
, c, x0, y0, x1, y1, x2
, y2
, x3
, y3
))
1654 let y = (getpagey
pageno) + truncate
y0 in
1662 let color = (0.0, 0.0, 1.0 /. float c, 0.5) in
1663 state
.rects1
<- [pageno, color, (x0, y0, x1, y1, x2
, y2
, x3
, y3
)]
1666 let pageno, c, x0, y0, x1, y1, x2
, y2
, x3
, y3
=
1667 scan args
"%u %d %f %f %f %f %f %f %f %f"
1668 (fun p
c x0 y0 x1 y1 x2 y2 x3 y3
->
1669 (p
, c, x0, y0, x1, y1, x2
, y2
, x3
, y3
))
1671 let color = (0.0, 0.0, 1.0 /. float c, 0.5) in
1673 (pageno, color, (x0, y0, x1, y1, x2
, y2
, x3
, y3
)) :: state
.rects1
1676 let pageopaques, t
= scan args
"%s %f" (fun p t
-> p
, t
) in
1677 let pageopaque = ~
< pageopaques in
1678 begin match state
.currently
with
1679 | Loading
(l, gen
) ->
1680 vlog "page %d took %f sec" l.pageno t
;
1681 Hashtbl.replace state
.pagemap
(l.pageno, gen
) pageopaque;
1682 begin match state
.throttle
with
1684 let preloadedpages =
1686 then preloadlayout state
.x state
.y state
.winw state
.winh
1691 List.fold_left
(fun s l -> IntSet.add
l.pageno s)
1692 IntSet.empty
preloadedpages
1695 Hashtbl.fold (fun ((pageno, _) as key) opaque
accu ->
1696 if not
(IntSet.mem
pageno set)
1698 wcmd "freepage %s" (~
> opaque
);
1704 List.iter
(Hashtbl.remove state
.pagemap
) evictedpages;
1707 state
.currently
<- Idle
;
1710 tilepage l.pageno pageopaque state
.layout;
1712 load preloadedpages;
1713 let visible = pagevisible state
.layout l.pageno in
1716 match state
.mode
with
1717 | LinkNav
(Ltnotready
(pageno, dir
)) ->
1718 if pageno = l.pageno
1723 then LDfirstvisible
(l.pagex
, l.pagey, dir
)
1725 if dir
> 0 then LDfirst
else LDlast
1728 findlink
pageopaque ld
1733 showlinktype (getlink
pageopaque n);
1734 state
.mode
<- LinkNav
(Ltexact
(l.pageno, n))
1736 | LinkNav
(Ltgendir
_)
1737 | LinkNav
(Ltexact
_)
1743 if visible && layoutready state
.layout
1745 G.postRedisplay "page";
1749 | Some
(layout, _, _) ->
1750 state
.currently
<- Idle
;
1751 tilepage l.pageno pageopaque layout;
1758 dolog
"Inconsistent loading state";
1759 logcurrently state
.currently
;
1764 let (x, y, opaques
, size
, t
) =
1765 scan args
"%u %u %s %u %f"
1766 (fun x y p size t
-> (x, y, p
, size
, t
))
1768 let opaque = ~
< opaques
in
1769 begin match state
.currently
with
1770 | Tiling
(l, pageopaque, cs
, angle
, gen
, col, row, tilew
, tileh
) ->
1771 vlog "tile %d [%d,%d] took %f sec" l.pageno col row t
;
1774 if tilew
!= conf
.tilew
|| tileh
!= conf
.tileh
1776 wcmd "freetile %s" (~
> opaque);
1777 state
.currently
<- Idle
;
1781 puttileopaque l col row gen cs angle
opaque size t
;
1782 state
.memused
<- state
.memused
+ size
;
1783 state
.uioh#infochanged Memused
;
1785 Queue.push
((l.pageno, gen
, cs
, angle
, l.pagew
, l.pageh
, col, row),
1786 opaque, size
) state
.tilelru
;
1789 match state
.throttle
with
1790 | None
-> state
.layout
1791 | Some
(layout, _, _) -> layout
1794 state
.currently
<- Idle
;
1796 && conf
.colorspace
= cs
1797 && conf
.angle
= angle
1798 && tilevisible layout l.pageno x y
1799 then conttiling l.pageno pageopaque;
1801 begin match state
.throttle
with
1803 preload state
.layout;
1805 && conf
.colorspace
= cs
1806 && conf
.angle
= angle
1807 && tilevisible state
.layout l.pageno x y
1808 && (not
!wtmode || layoutready state
.layout)
1809 then G.postRedisplay "tile nothrottle";
1811 | Some
(layout, y, _) ->
1812 let ready = layoutready layout in
1816 state
.layout <- layout;
1817 state
.throttle
<- None
;
1818 G.postRedisplay "throttle";
1827 dolog
"Inconsistent tiling state";
1828 logcurrently state
.currently
;
1833 let (n, w, h, _) as pdim
=
1834 scan args
"%u %u %u %u" (fun n w h x -> n, w, h, x)
1837 match conf
.fitmodel
with
1839 | FitPage
| FitProportional
->
1840 match conf
.columns
with
1841 | Csplit
_ -> (n, w, h, 0)
1842 | Csingle
_ | Cmulti
_ -> pdim
1844 state
.uioh#infochanged Pdim
;
1845 state
.pdims
<- pdim :: state
.pdims
1848 let (l, n, t
, h, pos
) =
1849 scan args
"%u %u %d %u %n"
1850 (fun l n t
h pos
-> l, n, t
, h, pos
)
1852 let s = String.sub args pos
(String.length args
- pos
) in
1853 addoutline (s, l, Oanchor
(n, float t
/. float h, 0.0))
1856 let (l, len, pos
) = scan args
"%u %u %n" (fun l len pos
-> l, len, pos
) in
1857 let s = String.sub args pos
len in
1858 let pos2 = pos
+ len + 1 in
1859 let uri = String.sub args
pos2 (String.length args
- pos2) in
1860 addoutline (s, l, Ouri
uri)
1863 let (l, pos
) = scan args
"%u %n" (fun l pos
-> l, pos
) in
1864 let s = String.sub args pos
(String.length args
- pos
) in
1865 addoutline (s, l, Onone
)
1869 scan args
"%u %d %d" (fun n l t
-> n, l, t
)
1871 state
.reprf
<- (fun () -> gotopagexy !wtmode n (float l) (float t
))
1874 let pos = nindex args '
\t'
in
1875 if pos >= 0 && String.sub args
0 pos = "Title"
1877 let s = String.sub args
(pos+1) @@ String.length args
- pos - 1 in
1881 state
.docinfo
<- (1, args
) :: state
.docinfo
1884 state
.uioh#infochanged Docinfo
;
1885 state
.docinfo
<- List.rev state
.docinfo
1889 then Wsi.settitle
"Wrong password";
1890 let password = getpassword () in
1891 if emptystr
password
1892 then error
"document is password protected"
1893 else opendoc state
.path
password
1896 error
"unknown cmd `%S'" cmds
1901 let action = function
1902 | HCprev
-> cbget cb ~
-1
1903 | HCnext
-> cbget cb
1
1904 | HCfirst
-> cbget cb ~
-(cb
.rc)
1905 | HClast
-> cbget cb
(cb
.len - 1 - cb
.rc)
1906 and cancel
() = cb
.rc <- rc
1910 let search pattern forward
=
1911 match conf
.columns
with
1912 | Csplit
_ -> impmsg "searching does not work properly in split columns mode"
1915 if nonemptystr pattern
1918 match state
.layout with
1921 l.pageno, (l.pagey + if forward
then 0 else 0*l.pagevh)
1923 wcmd "search %d %d %d %d,%s\000"
1924 (btod conf
.icase
) pn py (btod forward
) pattern
;
1927 let intentry text key =
1929 if key >= 32 && key < 127
1931 let c = Char.chr
key in
1933 | '
0'
.. '
9'
-> addchar
text c
1935 state
.text <- Printf.sprintf
"invalid char (%d, `%c')" key c;
1938 state
.text <- Printf.sprintf
"invalid key (%d)" key;
1949 let l = String.length
s in
1950 let rec loop pos n = if pos = l then n else
1951 let m = Char.code
s.[pos] - (if pos = 0 && l > 1 then 96 else 97) in
1952 loop (pos+1) (n*26 + m)
1955 let rec loop n = function
1958 match getopaque l.pageno with
1959 | None
-> loop n rest
1961 let m = getlinkcount
opaque in
1964 let under = getlink
opaque n in
1967 else loop (n-m) rest
1969 loop n state
.layout;
1973 let linknentry text key =
1974 if key >= 32 && key < 127
1976 let text = addchar
text (Char.chr
key) in
1977 linknact (fun under -> state
.text <- undertext ~nopath
:true under) text;
1980 state
.text <- Printf.sprintf
"invalid key %d" key;
1985 let textentry text key =
1986 if Wsi.isspecialkey
key
1988 else TEcont
(text ^ toutf8
key)
1991 let reqlayout angle fitmodel
=
1992 match state
.throttle
with
1994 if nogeomcmds state
.geomcmds
1995 then state
.anchor <- getanchor
();
1996 conf
.angle
<- angle
mod 360;
1999 match state
.mode
with
2000 | LinkNav
_ -> state
.mode
<- View
2005 conf
.fitmodel
<- fitmodel
;
2006 invalidate "reqlayout"
2008 wcmd "reqlayout %d %d %d"
2009 conf
.angle
(FMTE.to_int conf
.fitmodel
) (stateh state
.winh
)
2014 let settrim trimmargins trimfuzz
=
2015 if nogeomcmds state
.geomcmds
2016 then state
.anchor <- getanchor
();
2017 conf
.trimmargins
<- trimmargins
;
2018 conf
.trimfuzz
<- trimfuzz
;
2019 let x0, y0, x1, y1 = trimfuzz
in
2020 invalidate "settrim"
2022 wcmd "settrim %d %d %d %d %d" (btod conf
.trimmargins
) x0 y0 x1 y1);
2027 match state
.throttle
with
2029 let zoom = max
0.0001 zoom in
2030 if zoom <> conf
.zoom
2032 state
.prevzoom
<- (conf
.zoom, state
.x);
2034 reshape state
.winw state
.winh
;
2035 state
.text <- Printf.sprintf
"zoom is now %-5.2f" (zoom *. 100.0);
2038 | Some
(layout, y, started
) ->
2040 match conf
.maxwait
with
2044 let dt = now
() -. started
in
2052 let pivotzoom ?
(vw=min state
.w state
.winw
)
2053 ?
(vh
=min
(state
.maxy
-state
.y) state
.winh
)
2054 ?
(x=vw/2) ?
(y=vh
/2) zoom =
2055 let w = float state
.w /. zoom in
2056 let hw = w /. 2.0 in
2057 let ratio = float vh
/. float vw in
2058 let hh = hw *. ratio in
2059 let x0 = if zoom < 1.0 then 0.0 else float x -. hw in
2060 let y0 = float y -. hh in
2061 gotoxy (state
.x - truncate
x0) (state
.y + truncate
y0);
2065 let pivotzoom ?
vw ?vh ?
x ?
y zoom =
2066 if nogeomcmds state
.geomcmds
then pivotzoom ?
vw ?vh ?
x ?
y zoom
2069 let setcolumns mode columns coverA coverB
=
2070 state
.prevcolumns
<- Some
(conf
.columns
, conf
.zoom);
2074 then impmsg "split mode doesn't work in bird's eye"
2076 conf
.columns
<- Csplit
(-columns
, E.a);
2084 conf
.columns
<- Csingle
E.a;
2089 conf
.columns
<- Cmulti
((columns
, coverA
, coverB
), E.a);
2093 reshape state
.winw state
.winh
;
2096 let resetmstate () =
2097 state
.mstate
<- Mnone
;
2098 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
2101 let enterbirdseye () =
2102 let zoom = float conf
.thumbw
/. float state
.winw
in
2103 let birdseyepageno =
2104 let cy = state
.winh
/ 2 in
2108 let rec fold best
= function
2111 let d = cy - (l.pagedispy + l.pagevh/2)
2112 and dbest
= cy - (best
.pagedispy + best
.pagevh/2) in
2113 if abs
d < abs dbest
2120 state
.mode
<- Birdseye
(
2121 { conf
with zoom = conf
.zoom }, state
.x, birdseyepageno, -1, getanchor
()
2125 conf
.presentation
<- false;
2126 conf
.interpagespace
<- 10;
2127 conf
.hlinks
<- false;
2128 conf
.fitmodel
<- FitPage
;
2130 conf
.maxwait
<- None
;
2132 match conf
.beyecolumns
with
2135 Cmulti
((c, 0, 0), E.a)
2136 | None
-> Csingle
E.a
2140 state
.text <- Printf.sprintf
"birds eye mode on (zoom %3.1f%%)"
2145 reshape state
.winw state
.winh
;
2148 let leavebirdseye (c, leftx
, pageno, _, anchor) goback
=
2150 conf
.zoom <- c.zoom;
2151 conf
.presentation
<- c.presentation
;
2152 conf
.interpagespace
<- c.interpagespace
;
2153 conf
.maxwait
<- c.maxwait
;
2154 conf
.hlinks
<- c.hlinks
;
2155 conf
.fitmodel
<- c.fitmodel
;
2156 conf
.beyecolumns
<- (
2157 match conf
.columns
with
2158 | Cmulti
((c, _, _), _) -> Some
c
2160 | Csplit
_ -> failwith
"leaving bird's eye split mode"
2163 match c.columns
with
2164 | Cmulti
(c, _) -> Cmulti
(c, E.a)
2165 | Csingle
_ -> Csingle
E.a
2166 | Csplit
(c, _) -> Csplit
(c, E.a)
2170 state
.text <- Printf.sprintf
"birds eye mode off (zoom %3.1f%%)"
2173 reshape state
.winw state
.winh
;
2174 state
.anchor <- if goback
then anchor else (pageno, 0.0, 1.0);
2178 let togglebirdseye () =
2179 match state
.mode
with
2180 | Birdseye vals
-> leavebirdseye vals
true
2181 | View
-> enterbirdseye ()
2186 let upbirdseye incr
(conf
, leftx
, pageno, hooverpageno
, anchor) =
2187 let pageno = max
0 (pageno - incr
) in
2188 let rec loop = function
2189 | [] -> gotopage1 pageno 0
2190 | l :: _ when l.pageno = pageno ->
2191 if l.pagedispy >= 0 && l.pagey = 0
2192 then G.postRedisplay "upbirdseye"
2193 else gotopage1 pageno 0
2194 | _ :: rest
-> loop rest
2198 state
.mode
<- Birdseye
(conf
, leftx
, pageno, hooverpageno
, anchor)
2201 let downbirdseye incr
(conf
, leftx
, pageno, hooverpageno
, anchor) =
2202 let pageno = min
(state
.pagecount
- 1) (pageno + incr
) in
2203 state
.mode
<- Birdseye
(conf
, leftx
, pageno, hooverpageno
, anchor);
2204 let rec loop = function
2206 let y, h = getpageyh
pageno in
2207 let dy = (y - state
.y) - (state
.winh
- h - conf
.interpagespace
) in
2208 gotoxy state
.x (clamp dy)
2209 | l :: _ when l.pageno = pageno ->
2210 if l.pagevh != l.pageh
2211 then gotoxy state
.x (clamp (l.pageh
- l.pagevh + conf
.interpagespace
))
2212 else G.postRedisplay "downbirdseye"
2213 | _ :: rest
-> loop rest
2219 let optentry mode
_ key =
2220 let btos b = if b then "on" else "off" in
2221 if key >= 32 && key < 127
2223 let c = Char.chr
key in
2227 try conf
.scrollstep
<- int_of_string
s with exn
->
2228 state
.text <- Printf.sprintf
"bad integer `%s': %s" s @@ exntos exn
2230 TEswitch
("scroll step: ", E.s, None
, intentry, ondone, true)
2235 conf
.autoscrollstep
<- boundastep state
.winh
(int_of_string
s);
2236 if state
.autoscroll
<> None
2237 then state
.autoscroll
<- Some conf
.autoscrollstep
2239 state
.text <- Printf.sprintf
"bad integer `%s': %s" s @@ exntos exn
2241 TEswitch
("auto scroll step: ", E.s, None
, intentry, ondone, true)
2246 let n, a, b = multicolumns_of_string
s in
2247 setcolumns mode
n a b;
2249 state
.text <- Printf.sprintf
"bad columns `%s': %s" s @@ exntos exn
2251 TEswitch
("columns: ", E.s, None
, textentry, ondone, true)
2256 let zoom = float (int_of_string
s) /. 100.0 in
2259 state
.text <- Printf.sprintf
"bad integer `%s': %s" s @@ exntos exn
2261 TEswitch
("zoom: ", E.s, None
, intentry, ondone, true)
2266 conf
.thumbw
<- bound
(int_of_string
s) 2 4096;
2268 Printf.sprintf
"thumbnail width is set to %d" conf
.thumbw
;
2269 begin match mode
with
2271 leavebirdseye beye
false;
2278 state
.text <- Printf.sprintf
"bad integer `%s': %s" s @@ exntos exn
2280 TEswitch
("thumbnail width: ", E.s, None
, intentry, ondone, true)
2284 match int_of_string
s with
2285 | angle
-> reqlayout angle conf
.fitmodel
2288 Printf.sprintf
"bad integer `%s': %s" s @@ exntos exn
2290 TEswitch
("rotation: ", E.s, None
, intentry, ondone, true)
2293 conf
.icase
<- not conf
.icase
;
2294 TEdone
("case insensitive search " ^
(btos conf
.icase
))
2297 conf
.preload <- not conf
.preload;
2298 gotoxy state
.x state
.y;
2299 TEdone
("preload " ^
(btos conf
.preload))
2302 conf
.verbose
<- not conf
.verbose
;
2303 TEdone
("verbose " ^
(btos conf
.verbose
))
2306 conf
.debug
<- not conf
.debug
;
2307 TEdone
("debug " ^
(btos conf
.debug
))
2310 conf
.maxhfit
<- not conf
.maxhfit
;
2311 state
.maxy
<- calcheight
();
2312 TEdone
("maxhfit " ^
(btos conf
.maxhfit
))
2315 conf
.crophack
<- not conf
.crophack
;
2316 TEdone
("crophack " ^
btos conf
.crophack
)
2320 match conf
.maxwait
with
2322 conf
.maxwait
<- Some infinity
;
2323 "always wait for page to complete"
2325 conf
.maxwait
<- None
;
2326 "show placeholder if page is not ready"
2331 conf
.underinfo
<- not conf
.underinfo
;
2332 TEdone
("underinfo " ^
btos conf
.underinfo
)
2335 conf
.savebmarks
<- not conf
.savebmarks
;
2336 TEdone
("persistent bookmarks " ^
btos conf
.savebmarks
)
2342 match state
.layout with
2347 conf
.interpagespace
<- int_of_string
s;
2348 docolumns conf
.columns
;
2349 state
.maxy
<- calcheight
();
2350 let y = getpagey
pageno in
2351 gotoxy state
.x (y + py)
2353 state
.text <- Printf.sprintf
"bad integer `%s': %s" s @@ exntos exn
2355 TEswitch
("vertical margin: ", E.s, None
, intentry, ondone, true)
2359 match conf
.fitmodel
with
2360 | FitProportional
-> FitWidth
2361 | FitWidth
| FitPage
-> FitProportional
2363 reqlayout conf
.angle
fm;
2364 TEdone
("proportional display " ^
btos (fm == FitProportional
))
2367 settrim (not conf
.trimmargins
) conf
.trimfuzz
;
2368 TEdone
("trim margins " ^
btos conf
.trimmargins
)
2371 conf
.invert
<- not conf
.invert
;
2372 TEdone
("invert colors " ^
btos conf
.invert
)
2376 cbput state
.hists
.sel
s;
2379 TEswitch
("selection command: ", E.s, Some
(onhist state
.hists
.sel
),
2380 textentry, ondone, true)
2384 then conf
.pax
<- Some
(ref (0.0, 0, 0))
2385 else conf
.pax
<- None
;
2386 TEdone
("PAX " ^
btos (conf
.pax
!= None
))
2389 state
.text <- Printf.sprintf
"bad option %d `%c'" key c;
2395 class type lvsource
= object
2396 method getitemcount
: int
2397 method getitem
: int -> (string * int)
2398 method hasaction
: int -> bool
2406 method getactive
: int
2407 method getfirst
: int
2409 method getminfo
: (int * int) array
2412 class virtual lvsourcebase
= object
2413 val mutable m_active
= 0
2414 val mutable m_first
= 0
2415 val mutable m_pan
= 0
2416 method getactive
= m_active
2417 method getfirst
= m_first
2418 method getpan
= m_pan
2419 method getminfo
: (int * int) array
= E.a
2422 let textentrykeyboard
2423 key _mask
((c, text, opthist
, onkey
, ondone, cancelonempty
), onleave
) =
2425 let key = Wsi.keypadtodigitkey
key in
2427 state
.mode
<- Textentry
(te
, onleave
);
2429 G.postRedisplay "textentrykeyboard enttext";
2431 let histaction cmd
=
2434 | Some
(action, _) ->
2435 state
.mode
<- Textentry
(
2436 (c, action cmd
, opthist
, onkey
, ondone, cancelonempty
), onleave
2438 G.postRedisplay "textentry histaction"
2442 if emptystr
text && cancelonempty
2445 G.postRedisplay "textentrykeyboard after cancel";
2448 let s = withoutlastutf8
text in
2449 enttext (c, s, opthist
, onkey
, ondone, cancelonempty
)
2451 | @enter
| @kpenter
->
2454 G.postRedisplay "textentrykeyboard after confirm"
2456 | @up
| @kpup
-> histaction HCprev
2457 | @down
| @kpdown
-> histaction HCnext
2458 | @home
| @kphome
-> histaction HCfirst
2459 | @jend
| @kpend
-> histaction HClast
2464 begin match opthist
with
2466 | Some
(_, onhistcancel
) -> onhistcancel
()
2470 G.postRedisplay "textentrykeyboard after cancel2"
2473 enttext (c, E.s, opthist
, onkey
, ondone, cancelonempty
)
2476 | @delete
| @kpdelete
-> ()
2478 | _ when key != 0 && not
(Wsi.isspecialkey
key) ->
2479 begin match onkey
text key with
2483 G.postRedisplay "textentrykeyboard after confirm2";
2486 enttext (c, text, opthist
, onkey
, ondone, cancelonempty
);
2490 G.postRedisplay "textentrykeyboard after cancel3"
2493 state
.mode
<- Textentry
(te
, onleave
);
2494 G.postRedisplay "textentrykeyboard switch";
2498 vlog "unhandled key %s" (Wsi.keyname
key)
2501 let firstof first active
=
2502 if first
> active
|| abs
(first
- active
) > fstate
.maxrows
- 1
2503 then max
0 (active
- (fstate
.maxrows
/2))
2507 let calcfirst first active
=
2510 let rows = active
- first
in
2511 if rows > fstate
.maxrows
then active
- fstate
.maxrows
else first
2515 let scrollph y maxy
=
2516 let sh = float (maxy
+ state
.winh
) /. float state
.winh
in
2517 let sh = float state
.winh
/. sh in
2518 let sh = max
sh (float conf
.scrollh
) in
2520 let percent = float y /. float maxy
in
2521 let position = (float state
.winh
-. sh) *. percent in
2524 if position +. sh > float state
.winh
2525 then float state
.winh
-. sh
2531 let adderrmsg src msg
=
2532 Buffer.add_string state
.errmsgs msg
;
2533 state
.newerrmsgs
<- true;
2537 let adderrfmt src fmt
=
2538 Format.ksprintf
(fun s -> adderrmsg src
s) fmt
;
2541 let coe s = (s :> uioh
);;
2543 class listview ~zebra ~helpmode ~
(source
:lvsource
) ~trusted ~modehash
=
2545 val m_pan
= source#getpan
2546 val m_first
= source#getfirst
2547 val m_active
= source#getactive
2549 val m_prev_uioh
= state
.uioh
2551 method private elemunder
y =
2555 let n = y / (fstate
.fontsize
+1) in
2556 if m_first
+ n < source#getitemcount
2558 if source#hasaction
(m_first
+ n)
2559 then Some
(m_first
+ n)
2566 GlFunc.blend_func ~src
:`src_alpha ~dst
:`one_minus_src_alpha
;
2567 GlDraw.color (0., 0., 0.) ~alpha
:0.85;
2568 filledrect 0. 0. (float state
.winw
) (float state
.winh
);
2569 GlDraw.color (1., 1., 1.);
2570 Gl.enable `texture_2d
;
2571 let fs = fstate
.fontsize
in
2573 let hw = state
.winw
/3 in
2574 let ww = fstate
.wwidth
in
2575 let tabw = 17.0*.ww in
2576 let itemcount = source#getitemcount
in
2577 let minfo = source#getminfo
in
2581 GlMat.translate ~
x:(float conf
.scrollbw
) ();
2583 let x0 = 0.0 and x1 = float (state
.winw
- conf
.scrollbw
- 1) in
2585 if (row - m_first
) > fstate
.maxrows
2588 if row >= 0 && row < itemcount
2590 let (s, level
) = source#getitem
row in
2591 let y = (row - m_first
) * nfs in
2592 let x = 5.0 +. (float (level
+ m_pan
)) *. ww in
2595 (let c = if row land 1 = 0 then 1.0 else 0.92 in (c,c,c));
2599 Gl.disable `texture_2d
;
2600 let alpha = if source#hasaction
row then 0.9 else 0.3 in
2601 GlDraw.color (1., 1., 1.) ~
alpha;
2602 linerect (x0 +. 1.) (float (y + 1)) (x1) (float (y + fs + 3));
2603 Gl.enable `texture_2d
;
2606 if zebra
&& row land 1 = 1
2610 GlDraw.color (c,c,c);
2611 let drawtabularstring s =
2613 let x'
= truncate
(x0 +. x) in
2614 let pos = nindex
s '
\000'
in
2616 then drawstring1 fs x'
(y+nfs) s
2618 let s1 = String.sub
s 0 pos
2619 and s2
= String.sub
s (pos+1) (String.length
s - pos - 1) in
2624 let s'
= withoutlastutf8
s in
2625 let s = s' ^
"@Uellipsis" in
2626 let w = measurestr
fs s in
2627 if float x'
+. w +. ww < float (hw + x'
)
2632 if float x'
+. ww +. measurestr
fs s1 > float (hw + x'
)
2636 ignore
(drawstring1 fs x'
(y+nfs) s1);
2637 drawstring1 fs (hw + x'
) (y+nfs) s2
2641 let x = if helpmode
&& row > 0 then x +. ww else x in
2642 let tabpos = nindex
s '
\t'
in
2645 let len = String.length
s - tabpos - 1 in
2646 let s1 = String.sub
s 0 tabpos
2647 and s2
= String.sub
s (tabpos + 1) len in
2648 let nx = drawstr x s1 in
2650 let x = x +. (max
tabw sw) in
2653 let len = String.length
s - 2 in
2654 if len > 0 && s.[0] = '
\xc2'
&& s.[1] = '
\xb7'
2656 let s = String.sub
s 2 len in
2657 let x = if not helpmode
then x +. ww else x in
2658 GlDraw.color (1.2, 1.2, 1.2);
2659 let vinc = drawstring1 (fs+fs/4)
2660 (truncate
(x -. ww)) (y+nfs) s in
2661 GlDraw.color (1., 1., 1.);
2662 vinc +. (float fs *. 0.8)
2668 ignore
(drawtabularstring s);
2674 GlDraw.color (1.0, 1.0, 1.0) ~
alpha:0.5;
2677 if (row - m_first
) > fstate
.maxrows
2680 if row >= 0 && row < itemcount
2682 let (s, level
) = source#getitem
row in
2683 let pos0 = nindex
s '
\000'
in
2684 let y = (row - m_first
) * nfs in
2685 let x = float (level
+ m_pan
) *. ww in
2686 let (first
, last
) = minfo.(row) in
2688 if pos0 > 0 && first
> pos0
2689 then String.sub
s (pos0+1) (first
-pos0-1)
2690 else String.sub
s 0 first
2692 let suffix = String.sub
s first
(last
- first
) in
2693 let w1 = measurestr fstate
.fontsize
prefix in
2694 let w2 = measurestr fstate
.fontsize
suffix in
2695 let x = x +. if conf
.leftscroll
then xadj else 5.0 in
2696 let x = if pos0 > 0 && first
> pos0 then x +. float hw else x in
2698 and y0 = float (y+2) in
2700 and y1 = float (y+fs+3) in
2701 filledrect x0 y0 x1 y1;
2706 Gl.disable `texture_2d
;
2707 if Array.length
minfo > 0 then loop m_first
;
2712 method updownlevel incr
=
2713 let len = source#getitemcount
in
2715 if m_active
>= 0 && m_active
< len
2716 then snd
(source#getitem m_active
)
2720 if i
= len then i
-1 else if i
= -1 then 0 else
2721 let _, l = source#getitem i
in
2722 if l != curlevel then i
else flow (i
+incr
)
2724 let active = flow m_active
in
2725 let first = calcfirst m_first
active in
2726 G.postRedisplay "outline updownlevel";
2727 {< m_active
= active; m_first
= first >}
2729 method private key1
key mask
=
2730 let set1 active first qsearch
=
2731 coe {< m_active
= active; m_first
= first; m_qsearch
= qsearch
>}
2733 let search active pattern incr
=
2734 let active = if active = -1 then m_first
else active in
2737 if n >= 0 && n < source#getitemcount
2739 let s, _ = source#getitem
n in
2740 match Str.search_forward re
s 0 with
2741 | (exception Not_found
) -> loop (n + incr
)
2748 let qpat = Str.quote pattern
in
2749 match Str.regexp_case_fold
qpat with
2752 adderrfmt "listview key1" "regexp_case_fold for `%S' failed: %S\n"
2753 qpat @@ Printexc.to_string exn
;
2756 let itemcount = source#getitemcount
in
2757 let find start incr
=
2759 if i
= -1 || i
= itemcount
2762 if source#hasaction i
2764 else find (i
+ incr
)
2769 let set active first =
2770 let first = bound
first 0 (itemcount - fstate
.maxrows
) in
2772 coe {< m_active
= active; m_first
= first; m_qsearch
= E.s >}
2775 let isvisible first n = n >= first && n - first <= fstate
.maxrows
in
2777 let incr1 = if incr
> 0 then 1 else -1 in
2778 if isvisible m_first m_active
2781 let next = m_active
+ incr
in
2783 if next < 0 || next >= itemcount
2785 else find next incr1
2787 if abs
(m_active
- next) > fstate
.maxrows
2793 let first = m_first
+ incr
in
2794 let first = bound
first 0 (itemcount - fstate
.maxrows
) in
2796 let next = m_active
+ incr
in
2797 let next = bound
next 0 (itemcount - 1) in
2804 if isvisible first next
2811 let first = min
next m_first
in
2813 if abs
(next - first) > fstate
.maxrows
2819 let first = m_first
+ incr
in
2820 let first = bound
first 0 (itemcount - 1) in
2822 let next = m_active
+ incr
in
2823 let next = bound
next 0 (itemcount - 1) in
2824 let next = find next incr1 in
2826 if next = -1 || abs
(m_active
- first) > fstate
.maxrows
2828 let active = if m_active
= -1 then next else m_active
in
2833 if isvisible first active
2839 G.postRedisplay "listview navigate";
2843 | (@r
|@s) when Wsi.withctrl mask
->
2844 let incr = if key = @r
then -1 else 1 in
2846 match search (m_active
+ incr) m_qsearch
incr with
2848 state
.text <- m_qsearch ^
" [not found]";
2851 state
.text <- m_qsearch
;
2852 active, firstof m_first
active
2854 G.postRedisplay "listview ctrl-r/s";
2855 set1 active first m_qsearch
;
2857 | @insert
when Wsi.withctrl mask
->
2858 if m_active
>= 0 && m_active
< source#getitemcount
2860 let s, _ = source#getitem m_active
in
2866 if emptystr m_qsearch
2869 let qsearch = withoutlastutf8 m_qsearch
in
2873 G.postRedisplay "listview empty qsearch";
2874 set1 m_active m_first
E.s;
2878 match search m_active
qsearch ~
-1 with
2880 state
.text <- qsearch ^
" [not found]";
2883 state
.text <- qsearch;
2884 active, firstof m_first
active
2886 G.postRedisplay "listview backspace qsearch";
2887 set1 active first qsearch
2890 | key when (key != 0 && not
(Wsi.isspecialkey
key)) ->
2891 let pattern = m_qsearch ^ toutf8
key in
2893 match search m_active
pattern 1 with
2895 state
.text <- pattern ^
" [not found]";
2898 state
.text <- pattern;
2899 active, firstof m_first
active
2901 G.postRedisplay "listview qsearch add";
2902 set1 active first pattern;
2906 if emptystr m_qsearch
2908 G.postRedisplay "list view escape";
2909 let mx, my
= state
.mpos
in
2913 source#exit ~uioh
:(coe self
)
2914 ~cancel
:true ~
active:m_active ~
first:m_first ~pan
:m_pan
2916 | None
-> m_prev_uioh
2921 G.postRedisplay "list view kill qsearch";
2922 coe {< m_qsearch
= E.s >}
2925 | @enter
| @kpenter
->
2927 let self = {< m_qsearch
= E.s >} in
2929 G.postRedisplay "listview enter";
2930 if m_active
>= 0 && m_active
< source#getitemcount
2932 source#exit ~uioh
:(coe self) ~cancel
:false
2933 ~
active:m_active ~
first:m_first ~pan
:m_pan
;
2936 source#exit ~uioh
:(coe self) ~cancel
:true
2937 ~
active:m_active ~
first:m_first ~pan
:m_pan
;
2940 begin match opt with
2941 | None
-> m_prev_uioh
2945 | @delete
| @kpdelete
->
2948 | @up
| @kpup
-> navigate ~
-1
2949 | @down
| @kpdown
-> navigate 1
2950 | @prior
| @kpprior
-> navigate ~
-(fstate
.maxrows
)
2951 | @next | @kpnext
-> navigate fstate
.maxrows
2953 | @right
| @kpright
->
2955 G.postRedisplay "listview right";
2956 coe {< m_pan
= m_pan
- 1 >}
2958 | @left | @kpleft
->
2960 G.postRedisplay "listview left";
2961 coe {< m_pan
= m_pan
+ 1 >}
2963 | @home
| @kphome
->
2964 let active = find 0 1 in
2965 G.postRedisplay "listview home";
2969 let first = max
0 (itemcount - fstate
.maxrows
) in
2970 let active = find (itemcount - 1) ~
-1 in
2971 G.postRedisplay "listview end";
2974 | key when (key = 0 || Wsi.isspecialkey
key) ->
2978 dolog
"listview unknown key %#x" key; coe self
2980 method key key mask
=
2981 match state
.mode
with
2982 | Textentry te
-> textentrykeyboard key mask te
; coe self
2985 | LinkNav
_ -> self#key1
key mask
2987 method button button down
x y _ =
2990 | 1 when vscrollhit x ->
2991 G.postRedisplay "listview scroll";
2994 let _, position, sh = self#
scrollph in
2995 if y > truncate
position && y < truncate
(position +. sh)
2997 state
.mstate
<- Mscrolly
;
3001 let s = float (max
0 (y - conf
.scrollh
)) /. float state
.winh
in
3002 let first = truncate
(s *. float source#getitemcount
) in
3003 let first = min source#getitemcount
first in
3004 Some
(coe {< m_first
= first; m_active
= first >})
3006 state
.mstate
<- Mnone
;
3010 begin match self#elemunder
y with
3012 G.postRedisplay "listview click";
3013 source#exit ~uioh
:(coe {< m_active
= n >})
3014 ~cancel
:false ~
active:n ~
first:m_first ~pan
:m_pan
3018 | n when (n == 4 || n == 5) && not down
->
3019 let len = source#getitemcount
in
3021 if n = 5 && m_first
+ fstate
.maxrows
>= len
3025 let first = m_first
+ (if n == 4 then -1 else 1) in
3026 bound
first 0 (len - 1)
3028 G.postRedisplay "listview wheel";
3029 Some
(coe {< m_first
= first >})
3030 | n when (n = 6 || n = 7) && not down
->
3031 let inc = if n = 7 then -1 else 1 in
3032 G.postRedisplay "listview hwheel";
3033 Some
(coe {< m_pan
= m_pan
+ inc >})
3038 | None
-> m_prev_uioh
3041 method multiclick
_ x y = self#button
1 true x y
3044 match state
.mstate
with
3046 let s = float (max
0 (y - conf
.scrollh
)) /. float state
.winh
in
3047 let first = truncate
(s *. float source#getitemcount
) in
3048 let first = min source#getitemcount
first in
3049 G.postRedisplay "listview motion";
3050 coe {< m_first
= first; m_active
= first >}
3058 method pmotion
x y =
3059 if x < state
.winw
- conf
.scrollbw
3062 match self#elemunder
y with
3063 | None
-> Wsi.setcursor
Wsi.CURSOR_INHERIT
; m_active
3064 | Some
n -> Wsi.setcursor
Wsi.CURSOR_INFO
; n
3068 then (G.postRedisplay "listview pmotion"; {< m_active
= n >})
3073 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
3077 method infochanged
_ = ()
3079 method scrollpw
= (0, 0.0, 0.0)
3081 let nfs = fstate
.fontsize
+ 1 in
3082 let y = m_first
* nfs in
3083 let itemcount = source#getitemcount
in
3084 let maxi = max
0 (itemcount - fstate
.maxrows
) in
3085 let maxy = maxi * nfs in
3086 let p, h = scrollph y maxy in
3089 method modehash
= modehash
3090 method eformsgs
= false
3091 method alwaysscrolly
= true
3094 class outlinelistview ~zebra ~source
=
3095 let settext autonarrow
s =
3098 let ss = source#statestr
in
3102 else "{" ^
ss ^
"} [" ^
s ^
"]"
3103 else state
.text <- s
3109 ~source
:(source
:> lvsource
)
3111 ~modehash
:(findkeyhash conf
"outline")
3114 val m_autonarrow
= false
3116 method! key key mask
=
3118 if emptystr state
.text
3120 else fstate
.maxrows - 2
3122 let calcfirst first active =
3125 let rows = active - first in
3126 if rows > maxrows then active - maxrows else first
3130 let active = m_active
+ incr in
3131 let active = bound
active 0 (source#getitemcount
- 1) in
3132 let first = calcfirst m_first
active in
3133 G.postRedisplay "outline navigate";
3134 coe {< m_active
= active; m_first
= first >}
3136 let navscroll first =
3138 let dist = m_active
- first in
3144 else first + maxrows
3147 G.postRedisplay "outline navscroll";
3148 coe {< m_first
= first; m_active
= active >}
3150 let ctrl = Wsi.withctrl mask
in
3155 then (source#denarrow
; E.s)
3157 let pattern = source#renarrow
in
3158 if nonemptystr m_qsearch
3159 then (source#narrow m_qsearch
; m_qsearch
)
3163 settext (not m_autonarrow
) text;
3164 G.postRedisplay "toggle auto narrowing";
3165 coe {< m_first
= 0; m_active
= 0; m_autonarrow
= not m_autonarrow
>}
3167 | @slash
when emptystr m_qsearch
&& not m_autonarrow
->
3169 G.postRedisplay "toggle auto narrowing";
3170 coe {< m_first
= 0; m_active
= 0; m_autonarrow
= true >}
3173 source#narrow m_qsearch
;
3175 then source#add_narrow_pattern m_qsearch
;
3176 G.postRedisplay "outline ctrl-n";
3177 coe {< m_first
= 0; m_active
= 0 >}
3180 let active = source#calcactive
(getanchor
()) in
3181 let first = firstof m_first
active in
3182 G.postRedisplay "outline ctrl-s";
3183 coe {< m_first
= first; m_active
= active >}
3186 G.postRedisplay "outline ctrl-u";
3187 if m_autonarrow
&& nonemptystr m_qsearch
3189 ignore
(source#renarrow
);
3190 settext m_autonarrow
E.s;
3191 coe {< m_first
= 0; m_active
= 0; m_qsearch
= E.s >}
3194 source#del_narrow_pattern
;
3195 let pattern = source#renarrow
in
3197 if emptystr
pattern then E.s else "Narrowed to " ^
pattern
3199 settext m_autonarrow
text;
3200 coe {< m_first
= 0; m_active
= 0; m_qsearch
= E.s >}
3204 let first = max
0 (m_active
- (fstate
.maxrows / 2)) in
3205 G.postRedisplay "outline ctrl-l";
3206 coe {< m_first
= first >}
3208 | @tab
when m_autonarrow
->
3209 if nonemptystr m_qsearch
3211 G.postRedisplay "outline list view tab";
3212 source#add_narrow_pattern m_qsearch
;
3214 coe {< m_qsearch
= E.s >}
3218 | @escape
when m_autonarrow
->
3219 if nonemptystr m_qsearch
3220 then source#add_narrow_pattern m_qsearch
;
3223 | @enter
| @kpenter
when m_autonarrow
->
3224 if nonemptystr m_qsearch
3225 then source#add_narrow_pattern m_qsearch
;
3228 | key when m_autonarrow
&& (not
(Wsi.isspecialkey
key)) ->
3229 let pattern = m_qsearch ^ toutf8
key in
3230 G.postRedisplay "outlinelistview autonarrow add";
3231 source#narrow
pattern;
3232 settext true pattern;
3233 coe {< m_first
= 0; m_active
= 0; m_qsearch
= pattern >}
3235 | key when m_autonarrow
&& key = @backspace
->
3236 if emptystr m_qsearch
3239 let pattern = withoutlastutf8 m_qsearch
in
3240 G.postRedisplay "outlinelistview autonarrow backspace";
3241 ignore
(source#renarrow
);
3242 source#narrow
pattern;
3243 settext true pattern;
3244 coe {< m_first
= 0; m_active
= 0; m_qsearch
= pattern >}
3246 | @up
| @kpup
when ctrl ->
3247 navscroll (max
0 (m_first
- 1))
3249 | @down
| @kpdown
when ctrl ->
3250 navscroll (min
(source#getitemcount
- 1) (m_first
+ 1))
3252 | @up
| @kpup
-> navigate ~
-1
3253 | @down
| @kpdown
-> navigate 1
3254 | @prior
| @kpprior
-> navigate ~
-(fstate
.maxrows)
3255 | @next | @kpnext
-> navigate fstate
.maxrows
3257 | @right
| @kpright
->
3261 G.postRedisplay "outline ctrl right";
3262 {< m_pan
= m_pan
+ 1 >}
3264 else self#updownlevel
1
3268 | @left | @kpleft
->
3272 G.postRedisplay "outline ctrl left";
3273 {< m_pan
= m_pan
- 1 >}
3275 else self#updownlevel ~
-1
3279 | @home
| @kphome
->
3280 G.postRedisplay "outline home";
3281 coe {< m_first
= 0; m_active
= 0 >}
3284 let active = source#getitemcount
- 1 in
3285 let first = max
0 (active - fstate
.maxrows) in
3286 G.postRedisplay "outline end";
3287 coe {< m_active
= active; m_first
= first >}
3289 | _ -> super#
key key mask
3292 let genhistoutlines () =
3294 |> List.sort
(fun (_, c1
, _, _, _, _) (_, c2
, _, _, _, _) ->
3295 compare c2
.lastvisit c1
.lastvisit
)
3297 (fun ((path
, c, _, _, _, origin
) as hist
) ->
3298 let path = if nonemptystr origin
then origin
else path in
3299 let base = mbtoutf8
@@ Filename.basename
path in
3300 (base ^
"\000" ^
c.title
, 1, Ohistory hist
)
3305 let gotohist (path, c, bookmarks
, x, anchor, origin
) =
3306 Config.save
leavebirdseye;
3307 state
.anchor <- anchor;
3308 state
.bookmarks
<- bookmarks
;
3309 state
.origin
<- origin
;
3312 let x0, y0, x1, y1 = conf
.trimfuzz
in
3313 wcmd "trimset %d %d %d %d %d" (btod conf
.trimmargins
) x0 y0 x1 y1;
3314 reshape ~firsttime
:true state
.winw state
.winh
;
3315 opendoc path origin
;
3319 let makecheckers () =
3320 (* Based on lablGL-1.04/LablGlut/examples/lablGL/checker.ml which had
3322 converted by Issac Trotts. July 25, 2002 *)
3323 let image = GlPix.create `ubyte ~format
:`luminance ~width
:2 ~height
:2 in
3324 Raw.sets_string
(GlPix.to_raw
image) ~
pos:0 "\255\200\200\255";
3325 let id = GlTex.gen_texture
() in
3326 GlTex.bind_texture ~target
:`texture_2d
id;
3327 GlPix.store
(`unpack_alignment
1);
3328 GlTex.image2d
image;
3329 List.iter
(GlTex.parameter ~target
:`texture_2d
)
3330 [ `mag_filter `nearest
; `min_filter `nearest
];
3334 let setcheckers enabled
=
3335 match state
.checkerstexid
with
3337 if enabled
then state
.checkerstexid
<- Some
(makecheckers ())
3339 | Some checkerstexid
->
3342 GlTex.delete_texture checkerstexid
;
3343 state
.checkerstexid
<- None
;
3347 let describe_location () =
3348 let fn = page_of_y state
.y in
3349 let ln = page_of_y
(state
.y + state
.winh
- 1) in
3350 let maxy = state
.maxy - (if conf
.maxhfit
then state
.winh
else 0) in
3354 else (100. *. (float state
.y /. float maxy))
3358 Printf.sprintf
"page %d of %d [%.2f%%]"
3359 (fn+1) state
.pagecount
percent
3362 "pages %d-%d of %d [%.2f%%]"
3363 (fn+1) (ln+1) state
.pagecount
percent
3366 let setpresentationmode v
=
3367 let n = page_of_y state
.y in
3368 state
.anchor <- (n, 0.0, 1.0);
3369 conf
.presentation
<- v
;
3370 if conf
.fitmodel
= FitPage
3371 then reqlayout conf
.angle conf
.fitmodel
;
3375 let setbgcol (r
, g, b) =
3377 let r = r *. 255.0 |> truncate
3378 and g = g *. 255.0 |> truncate
3379 and b = b *. 255.0 |> truncate
in
3380 r lsl 16 |> (lor) (g lsl 8) |> (lor) b
3382 Wsi.setwinbgcol
col;
3386 let btos b = if b then "@Uradical" else E.s in
3387 let showextended = ref false in
3388 let leave mode
_ = state
.mode
<- mode
in
3391 val mutable m_l
= []
3392 val mutable m_a
= E.a
3393 val mutable m_prev_uioh
= nouioh
3394 val mutable m_prev_mode
= View
3396 inherit lvsourcebase
3398 method reset prev_mode prev_uioh
=
3399 m_a
<- Array.of_list
(List.rev m_l
);
3401 m_prev_mode
<- prev_mode
;
3402 m_prev_uioh
<- prev_uioh
;
3404 method int name get
set =
3406 (name
, `
int get
, 1, Action
(
3409 try set (int_of_string
s)
3411 state
.text <- Printf.sprintf
"bad integer `%s': %s"
3415 let te = name ^
": ", E.s, None
, intentry, ondone, true in
3416 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3420 method int_with_suffix name get
set =
3422 (name
, `intws get
, 1, Action
(
3425 try set (int_of_string_with_suffix
s)
3427 state
.text <- Printf.sprintf
"bad integer `%s': %s"
3432 name ^
": ", E.s, None
, intentry_with_suffix, ondone, true
3434 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3438 method bool ?
(offset
=1) ?
(btos=btos) name get
set =
3440 (name
, `
bool (btos, get
), offset
, Action
(
3447 method color name get
set =
3449 (name
, `
color get
, 1, Action
(
3451 let invalid = (nan
, nan
, nan
) in
3454 try color_of_string
s
3456 state
.text <- Printf.sprintf
"bad color `%s': %s"
3463 let te = name ^
": ", E.s, None
, textentry, ondone, true in
3464 state
.text <- color_to_string
(get
());
3465 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3469 method string name get
set =
3471 (name
, `
string get
, 1, Action
(
3473 let ondone s = set s in
3474 let te = name ^
": ", E.s, None
, textentry, ondone, true in
3475 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3479 method colorspace name get
set =
3481 (name
, `
string get
, 1, Action
(
3485 inherit lvsourcebase
3488 m_active
<- CSTE.to_int conf
.colorspace
;
3491 method getitemcount
=
3492 Array.length
CSTE.names
3495 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3496 ignore
(uioh
, first, pan
);
3497 if not cancel
then set active;
3499 method hasaction
_ = true
3503 let modehash = findkeyhash conf
"info" in
3504 coe (new listview ~zebra
:false ~helpmode
:false
3505 ~
source ~trusted
:true ~
modehash)
3508 method paxmark name get
set =
3510 (name
, `
string get
, 1, Action
(
3514 inherit lvsourcebase
3517 m_active
<- MTE.to_int conf
.paxmark
;
3520 method getitemcount
= Array.length
MTE.names
3521 method getitem
n = (MTE.names
.(n), 0)
3522 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3523 ignore
(uioh
, first, pan
);
3524 if not cancel
then set active;
3526 method hasaction
_ = true
3530 let modehash = findkeyhash conf
"info" in
3531 coe (new listview ~zebra
:false ~helpmode
:false
3532 ~
source ~trusted
:true ~
modehash)
3535 method fitmodel name get
set =
3537 (name
, `
string get
, 1, Action
(
3541 inherit lvsourcebase
3544 m_active
<- FMTE.to_int conf
.fitmodel
;
3547 method getitemcount
= Array.length
FMTE.names
3548 method getitem
n = (FMTE.names
.(n), 0)
3549 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3550 ignore
(uioh
, first, pan
);
3551 if not cancel
then set active;
3553 method hasaction
_ = true
3557 let modehash = findkeyhash conf
"info" in
3558 coe (new listview ~zebra
:false ~helpmode
:false
3559 ~
source ~trusted
:true ~
modehash)
3562 method caption
s offset
=
3563 m_l
<- (s, `empty
, offset
, Noaction
) :: m_l
3565 method caption2
s f offset
=
3566 m_l
<- (s, `
string f, offset
, Noaction
) :: m_l
3568 method getitemcount
= Array.length m_a
3571 let tostr = function
3572 | `
int f -> string_of_int
(f ())
3573 | `intws
f -> string_with_suffix_of_int
(f ())
3575 | `
color f -> color_to_string
(f ())
3576 | `
bool (btos, f) -> btos (f ())
3579 let name, t
, offset
, _ = m_a
.(n) in
3580 ((let s = tostr t
in
3582 then Printf.sprintf
"%s\t%s" name s
3586 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3591 match m_a
.(active) with
3592 | _, _, _, Action
f -> f uioh
3593 | _, _, _, Noaction
-> uioh
3604 method hasaction
n =
3606 | _, _, _, Action
_ -> true
3607 | _, _, _, Noaction
-> false
3609 initializer m_active
<- 1
3612 let rec fillsrc prevmode prevuioh
=
3613 let sep () = src#caption
E.s 0 in
3614 let colorp name get
set =
3616 (fun () -> color_to_string
(get
()))
3619 let c = color_of_string
v in
3622 state
.text <- Printf.sprintf
"bad color `%s': %s" v @@ exntos exn
3625 let oldmode = state
.mode
in
3626 let birdseye = isbirdseye state
.mode
in
3628 src#caption
(if birdseye then "Setup (Bird's eye)" else "Setup") 0;
3630 src#
bool "presentation mode"
3631 (fun () -> conf
.presentation
)
3632 (fun v -> setpresentationmode v);
3634 src#
bool "ignore case in searches"
3635 (fun () -> conf
.icase
)
3636 (fun v -> conf
.icase
<- v);
3639 (fun () -> conf
.preload)
3640 (fun v -> conf
.preload <- v);
3642 src#
bool "highlight links"
3643 (fun () -> conf
.hlinks
)
3644 (fun v -> conf
.hlinks
<- v);
3646 src#
bool "under info"
3647 (fun () -> conf
.underinfo
)
3648 (fun v -> conf
.underinfo
<- v);
3650 src#
bool "persistent bookmarks"
3651 (fun () -> conf
.savebmarks
)
3652 (fun v -> conf
.savebmarks
<- v);
3654 src#fitmodel
"fit model"
3655 (fun () -> FMTE.to_string conf
.fitmodel
)
3656 (fun v -> reqlayout conf
.angle
(FMTE.of_int
v));
3658 src#
bool "trim margins"
3659 (fun () -> conf
.trimmargins
)
3660 (fun v -> settrim v conf
.trimfuzz
; fillsrc prevmode prevuioh
);
3662 src#
bool "persistent location"
3663 (fun () -> conf
.jumpback
)
3664 (fun v -> conf
.jumpback
<- v);
3667 src#
int "inter-page space"
3668 (fun () -> conf
.interpagespace
)
3670 conf
.interpagespace
<- n;
3671 docolumns conf
.columns
;
3673 match state
.layout with
3678 state
.maxy <- calcheight
();
3679 let y = getpagey
pageno in
3680 gotoxy state
.x (y + py)
3684 (fun () -> conf
.pagebias
)
3685 (fun v -> conf
.pagebias
<- v);
3687 src#
int "scroll step"
3688 (fun () -> conf
.scrollstep
)
3689 (fun n -> conf
.scrollstep
<- n);
3691 src#
int "horizontal scroll step"
3692 (fun () -> conf
.hscrollstep
)
3693 (fun v -> conf
.hscrollstep
<- v);
3695 src#
int "auto scroll step"
3697 match state
.autoscroll
with
3699 | _ -> conf
.autoscrollstep
)
3701 let n = boundastep state
.winh
n in
3702 if state
.autoscroll
<> None
3703 then state
.autoscroll
<- Some
n;
3704 conf
.autoscrollstep
<- n);
3707 (fun () -> truncate
(conf
.zoom *. 100.))
3708 (fun v -> pivotzoom ((float v) /. 100.));
3711 (fun () -> conf
.angle
)
3712 (fun v -> reqlayout v conf
.fitmodel
);
3714 src#
int "scroll bar width"
3715 (fun () -> conf
.scrollbw
)
3718 reshape state
.winw state
.winh
;
3721 src#
int "scroll handle height"
3722 (fun () -> conf
.scrollh
)
3723 (fun v -> conf
.scrollh
<- v;);
3725 src#
int "thumbnail width"
3726 (fun () -> conf
.thumbw
)
3728 conf
.thumbw
<- min
4096 v;
3731 leavebirdseye beye
false;
3738 let mode = state
.mode in
3739 src#
string "columns"
3741 match conf
.columns
with
3743 | Cmulti
(multi
, _) -> multicolumns_to_string multi
3744 | Csplit
(count
, _) -> "-" ^ string_of_int count
3747 let n, a, b = multicolumns_of_string
v in
3748 setcolumns mode n a b);
3751 src#caption
"Pixmap cache" 0;
3752 src#int_with_suffix
"size (advisory)"
3753 (fun () -> conf
.memlimit
)
3754 (fun v -> conf
.memlimit
<- v);
3757 (fun () -> Printf.sprintf
"%s bytes, %d tiles"
3758 (string_with_suffix_of_int state
.memused
)
3759 (Hashtbl.length state
.tilemap
)) 1;
3762 src#caption
"Layout" 0;
3763 src#caption2
"Dimension"
3765 Printf.sprintf
"%dx%d (virtual %dx%d)"
3766 state
.winw state
.winh
3771 src#caption2
"Position" (fun () ->
3772 Printf.sprintf
"%dx%d" state
.x state
.y
3775 src#caption2
"Position" (fun () -> describe_location ()) 1
3779 src#
bool ~offset
:0 ~
btos:(fun v -> if v then "(on)" else "(off)")
3780 "Save these parameters as global defaults at exit"
3781 (fun () -> conf
.bedefault
)
3782 (fun v -> conf
.bedefault
<- v)
3786 let btos b = if b then "@Ulguillemet" else "@Urguillemet" in
3787 src#
bool ~offset
:0 ~
btos "Extended parameters"
3788 (fun () -> !showextended)
3789 (fun v -> showextended := v; fillsrc prevmode prevuioh
);
3793 (fun () -> conf
.checkers
)
3794 (fun v -> conf
.checkers
<- v; setcheckers v);
3795 src#
bool "update cursor"
3796 (fun () -> conf
.updatecurs
)
3797 (fun v -> conf
.updatecurs
<- v);
3798 src#
bool "scroll-bar on the left"
3799 (fun () -> conf
.leftscroll
)
3800 (fun v -> conf
.leftscroll
<- v);
3802 (fun () -> conf
.verbose
)
3803 (fun v -> conf
.verbose
<- v);
3804 src#
bool "invert colors"
3805 (fun () -> conf
.invert
)
3806 (fun v -> conf
.invert
<- v);
3808 (fun () -> conf
.maxhfit
)
3809 (fun v -> conf
.maxhfit
<- v);
3811 (fun () -> conf
.pax
!= None
)
3814 then conf
.pax
<- Some
(ref (now
(), 0, 0))
3815 else conf
.pax
<- None
);
3816 src#
string "uri launcher"
3817 (fun () -> conf
.urilauncher
)
3818 (fun v -> conf
.urilauncher
<- v);
3819 src#
string "path launcher"
3820 (fun () -> conf
.pathlauncher
)
3821 (fun v -> conf
.pathlauncher
<- v);
3822 src#
string "tile size"
3823 (fun () -> Printf.sprintf
"%dx%d" conf
.tilew conf
.tileh
)
3826 let w, h = Scanf.sscanf
v "%dx%d" (fun w h -> w, h) in
3827 conf
.tilew
<- max
64 w;
3828 conf
.tileh
<- max
64 h;
3831 state
.text <- Printf.sprintf
"bad tile size `%s': %s"
3834 src#
int "texture count"
3835 (fun () -> conf
.texcount
)
3838 then conf
.texcount
<- v
3839 else impmsg "failed to set texture count please retry later"
3841 src#
int "slice height"
3842 (fun () -> conf
.sliceheight
)
3844 conf
.sliceheight
<- v;
3845 wcmd "sliceh %d" conf
.sliceheight
;
3847 src#
int "anti-aliasing level"
3848 (fun () -> conf
.aalevel
)
3850 conf
.aalevel
<- bound
v 0 8;
3851 state
.anchor <- getanchor
();
3852 opendoc state
.path state
.password;
3854 src#
string "page scroll scaling factor"
3855 (fun () -> string_of_float conf
.pgscale)
3858 let s = float_of_string
v in
3861 state
.text <- Printf.sprintf
3862 "bad page scroll scaling factor `%s': %s" v @@ exntos exn
3865 src#
int "ui font size"
3866 (fun () -> fstate
.fontsize
)
3867 (fun v -> setfontsize (bound
v 5 100));
3868 src#
int "hint font size"
3869 (fun () -> conf
.hfsize
)
3870 (fun v -> conf
.hfsize
<- bound
v 5 100);
3871 colorp "background color"
3872 (fun () -> conf
.bgcolor
)
3873 (fun v -> conf
.bgcolor
<- v; setbgcol v);
3874 src#
bool "crop hack"
3875 (fun () -> conf
.crophack
)
3876 (fun v -> conf
.crophack
<- v);
3877 src#
string "trim fuzz"
3878 (fun () -> irect_to_string conf
.trimfuzz
)
3881 conf
.trimfuzz
<- irect_of_string
v;
3883 then settrim true conf
.trimfuzz
;
3885 state
.text <- Printf.sprintf
"bad irect `%s': %s" v @@ exntos exn
3887 src#
string "throttle"
3889 match conf
.maxwait
with
3890 | None
-> "show place holder if page is not ready"
3893 then "wait for page to fully render"
3895 "wait " ^ string_of_float
time
3896 ^
" seconds before showing placeholder"
3900 let f = float_of_string
v in
3902 then conf
.maxwait
<- None
3903 else conf
.maxwait
<- Some
f
3905 state
.text <- Printf.sprintf
"bad time `%s': %s" v @@ exntos exn
3907 src#
string "ghyll scroll"
3909 match conf
.ghyllscroll
with
3911 | Some nab
-> ghyllscroll_to_string nab
3914 try conf
.ghyllscroll
<- ghyllscroll_of_string
v
3917 state
.text <- Printf.sprintf
"bad ghyll `%s': %s" v msg
3919 state
.text <- Printf.sprintf
"bad ghyll `%s': %s" v @@ exntos exn
3921 src#
string "selection command"
3922 (fun () -> conf
.selcmd
)
3923 (fun v -> conf
.selcmd
<- v);
3924 src#
string "synctex command"
3925 (fun () -> conf
.stcmd
)
3926 (fun v -> conf
.stcmd
<- v);
3927 src#
string "pax command"
3928 (fun () -> conf
.paxcmd
)
3929 (fun v -> conf
.paxcmd
<- v);
3930 src#
string "ask password command"
3931 (fun () -> conf
.passcmd)
3932 (fun v -> conf
.passcmd <- v);
3933 src#
string "save path command"
3934 (fun () -> conf
.savecmd
)
3935 (fun v -> conf
.savecmd
<- v);
3936 src#colorspace
"color space"
3937 (fun () -> CSTE.to_string conf
.colorspace
)
3939 conf
.colorspace
<- CSTE.of_int
v;
3943 src#paxmark
"pax mark method"
3944 (fun () -> MTE.to_string conf
.paxmark
)
3945 (fun v -> conf
.paxmark
<- MTE.of_int
v);
3946 if bousable
() && !opengl_has_pbo
3949 (fun () -> conf
.usepbo
)
3950 (fun v -> conf
.usepbo
<- v);
3951 src#
bool "mouse wheel scrolls pages"
3952 (fun () -> conf
.wheelbypage
)
3953 (fun v -> conf
.wheelbypage
<- v);
3954 src#
bool "open remote links in a new instance"
3955 (fun () -> conf
.riani
)
3956 (fun v -> conf
.riani
<- v);
3957 src#
bool "edit annotations inline"
3958 (fun () -> conf
.annotinline
)
3959 (fun v -> conf
.annotinline
<- v);
3960 src#
bool "coarse positioning in presentation mode"
3961 (fun () -> conf
.coarseprespos
)
3962 (fun v -> conf
.coarseprespos
<- v);
3966 src#caption
"Document" 0;
3967 List.iter
(fun (_, s) -> src#caption
s 1) state
.docinfo
;
3968 src#caption2
"Pages"
3969 (fun () -> string_of_int state
.pagecount
) 1;
3970 src#caption2
"Dimensions"
3971 (fun () -> string_of_int
(List.length state
.pdims
)) 1;
3975 src#caption
"Trimmed margins" 0;
3976 src#caption2
"Dimensions"
3977 (fun () -> string_of_int
(List.length state
.pdims
)) 1;
3981 src#caption
"OpenGL" 0;
3982 src#caption
(Printf.sprintf
"Vendor\t%s" (GlMisc.get_string `vendor
)) 1;
3983 src#caption
(Printf.sprintf
"Renderer\t%s" (GlMisc.get_string `renderer
)) 1;
3986 src#caption
"Location" 0;
3987 if nonemptystr state
.origin
3988 then src#caption
("Orign\t" ^ mbtoutf8 state
.origin
) 1;
3989 src#caption
("Path\t" ^ mbtoutf8 state
.path) 1;
3991 src#reset prevmode prevuioh
;
3996 let prevmode = state
.mode
3997 and prevuioh
= state
.uioh in
3998 fillsrc prevmode prevuioh
;
3999 let source = (src :> lvsource
) in
4000 let modehash = findkeyhash conf
"info" in
4001 state
.uioh <- coe (object (self)
4002 inherit listview ~zebra
:false ~helpmode
:false
4003 ~
source ~trusted
:true ~
modehash as super
4004 val mutable m_prevmemused
= 0
4005 method! infochanged
= function
4007 if m_prevmemused
!= state
.memused
4009 m_prevmemused
<- state
.memused
;
4010 G.postRedisplay "memusedchanged";
4012 | Pdim
-> G.postRedisplay "pdimchanged"
4013 | Docinfo
-> fillsrc prevmode prevuioh
4015 method! key key mask
=
4016 if not
(Wsi.withctrl mask
)
4019 | @left | @kpleft
-> coe (self#updownlevel ~
-1)
4020 | @right
| @kpright
-> coe (self#updownlevel
1)
4021 | _ -> super#
key key mask
4022 else super#
key key mask
4024 G.postRedisplay "info";
4030 inherit lvsourcebase
4031 method getitemcount
= Array.length state
.help
4033 let s, l, _ = state
.help
.(n) in
4036 method exit ~
uioh ~cancel ~
active ~
first ~pan
=
4040 match state
.help
.(active) with
4041 | _, _, Action
f -> Some
(f uioh)
4042 | _, _, Noaction
-> Some
uioh
4051 method hasaction
n =
4052 match state
.help
.(n) with
4053 | _, _, Action
_ -> true
4054 | _, _, Noaction
-> false
4060 let modehash = findkeyhash conf
"help" in
4062 state
.uioh <- coe (new listview
4063 ~zebra
:false ~helpmode
:true
4064 ~
source ~trusted
:true ~
modehash);
4065 G.postRedisplay "help";
4071 inherit lvsourcebase
4072 val mutable m_items
= E.a
4074 method getitemcount
= 1 + Array.length m_items
4079 else m_items
.(n-1), 0
4081 method exit ~
uioh ~cancel ~
active ~
first ~pan
=
4086 then Buffer.clear state
.errmsgs
;
4093 method hasaction
n =
4097 state
.newerrmsgs
<- false;
4098 let l = Str.split newlinere
(Buffer.contents state
.errmsgs
) in
4099 m_items
<- Array.of_list
l
4108 let source = (msgsource :> lvsource
) in
4109 let modehash = findkeyhash conf
"listview" in
4110 state
.uioh <- coe (object
4111 inherit listview ~zebra
:false ~helpmode
:false
4112 ~
source ~trusted
:false ~
modehash as super
4115 then msgsource#reset
;
4118 G.postRedisplay "msgs";
4122 let editor = getenvwithdef
"EDITOR" E.s in
4126 let tmppath = Filename.temp_file
"llpp" "note" in
4129 let oc = open_out
tmppath in
4133 let execstr = editor ^
" " ^
tmppath in
4135 match spawn
execstr [] with
4136 | (exception exn
) ->
4137 impmsg "spawn(%S) failed: %s" execstr @@ exntos exn
;
4140 match Unix.waitpid
[] pid with
4141 | (exception exn
) ->
4142 impmsg "waitpid(%d) failed: %s" pid @@ exntos exn
;
4146 | Unix.WEXITED
0 -> filecontents
tmppath
4148 impmsg "editor process(%s) exited abnormally: %d" execstr n;
4150 | Unix.WSIGNALED
n ->
4151 impmsg "editor process(%s) was killed by signal %d" execstr n;
4153 | Unix.WSTOPPED
n ->
4154 impmsg "editor(%s) process was stopped by signal %d" execstr n;
4157 match Unix.unlink
tmppath with
4158 | (exception exn
) ->
4159 impmsg "failed to ulink %S: %s" tmppath @@ exntos exn
;
4164 let enterannotmode opaque slinkindex
=
4167 inherit lvsourcebase
4168 val mutable m_text
= E.s
4169 val mutable m_items
= E.a
4171 method getitemcount
= Array.length m_items
4174 let label, _func
= m_items
.(n) in
4177 method exit ~
uioh ~cancel ~
active ~
first ~pan
=
4178 ignore
(uioh, first, pan
);
4181 let _label, func
= m_items
.(active) in
4186 method hasaction
n = nonemptystr
@@ fst m_items
.(n)
4189 let rec split accu b i
=
4191 if p = String.length
s
4192 then (String.sub
s b (p-b), unit) :: accu
4194 if (i
> 70 && s.[p] = ' '
) || s.[p] = '
\r'
|| s.[p] = '
\n'
4196 let ss = if i
= 0 then E.s else String.sub
s b i
in
4197 split ((ss, unit)::accu) (p+1) 0
4202 wcmd "freepage %s" (~
> opaque);
4204 Hashtbl.fold (fun key opaque'
accu ->
4205 if opaque'
= opaque'
4206 then key :: accu else accu) state
.pagemap
[]
4208 List.iter
(Hashtbl.remove state
.pagemap
) keys;
4210 gotoxy state
.x state
.y
4213 delannot
opaque slinkindex
;
4216 let edit inline
() =
4221 modannot
opaque slinkindex
s;
4227 let mode = state
.mode in
4230 ("annotation: ", m_text
, None
, textentry, update, true),
4231 fun _ -> state
.mode <- mode);
4235 let s = getusertext m_text
in
4240 ( "[Copy]", fun () -> selstring m_text
)
4241 :: ("[Delete]", dele)
4242 :: ("[Edit]", edit conf
.annotinline
)
4244 :: split [] 0 0 |> List.rev
|> Array.of_list
4251 let s = getannotcontents
opaque slinkindex
in
4254 let source = (msgsource :> lvsource
) in
4255 let modehash = findkeyhash conf
"listview" in
4256 state
.uioh <- coe (object
4257 inherit listview ~zebra
:false ~helpmode
:false
4258 ~
source ~trusted
:false ~
modehash
4260 G.postRedisplay "enterannotmode";
4263 let gotounder under =
4264 let getpath filename
=
4266 if nonemptystr filename
4268 if Filename.is_relative filename
4270 let dir = Filename.dirname state
.path in
4272 if Filename.is_implicit
dir
4273 then Filename.concat
(Sys.getcwd
()) dir
4276 Filename.concat
dir filename
4280 if Sys.file_exists
path
4285 | Ulinkgoto
(pageno, top) ->
4290 if conf
.presentation
&& conf
.coarseprespos
4294 gotopage1 pageno top;
4298 let re = Str.regexp
{|\
(([a-z
]\
)+://|} in
4299 if Str.string_match
re s 0
4301 match Str.matched_group
1 s with
4302 | "file" -> dolog
"remote!"
4306 Scanf.sscanf
s "#%d,%d,%d" (fun n x y ->
4310 let _, h = getpageyh
n in
4311 let p = transformpagepoint
(n-1) x y in
4313 if conf
.coarseprespos
4315 else h - truncate
p.(1)
4324 | Uremote
(filename
, pageno) ->
4325 let path = getpath filename
in
4330 let command = Printf.sprintf
"%s -page %d %S" !selfexec pageno path in
4331 match spawn
command [] with
4333 | (exception exn
) ->
4334 dolog
"failed to execute `%s': %s" command @@ exntos exn
4336 let anchor = getanchor
() in
4337 let ranchor = state
.path, state
.password, anchor, state
.origin
in
4338 state
.origin
<- E.s;
4339 state
.anchor <- (pageno, 0.0, 0.0);
4340 state
.ranchors
<- ranchor :: state
.ranchors
;
4343 else impmsg "cannot find %s" filename
4345 | Uremotedest
(filename
, destname
) ->
4346 let path = getpath filename
in
4351 let command = !selfexec ^
" " ^
path ^
" -dest " ^ destname
in
4352 match spawn
command [] with
4353 | (exception exn
) ->
4354 dolog
"failed to execute `%s': %s" command @@ exntos exn
4357 let anchor = getanchor
() in
4358 let ranchor = state
.path, state
.password, anchor, state
.origin
in
4359 state
.origin
<- E.s;
4360 state
.nameddest
<- destname
;
4361 state
.ranchors
<- ranchor :: state
.ranchors
;
4364 else impmsg "cannot find %s" filename
4366 | Uunexpected
_ | Ulaunch
_ | Unamed
_ | Utext
_ | Unone
-> ()
4367 | Uannotation
(opaque, slinkindex
) -> enterannotmode opaque slinkindex
4370 let gotooutline (_, _, kind
) =
4374 let (pageno, y, _) = anchor in
4376 (if conf
.presentation
then (pageno, y, 1.0) else anchor)
4380 | Ouri
uri -> gotounder (Ulinkuri
uri)
4381 | Olaunch cmd
-> gotounder (Ulaunch cmd
)
4382 | Oremote remote
-> gotounder (Uremote remote
)
4383 | Ohistory hist
-> gotohist hist
4384 | Oremotedest remotedest
-> gotounder (Uremotedest remotedest
)
4387 class outlinesoucebase fetchoutlines
= object (self)
4388 inherit lvsourcebase
4389 val mutable m_items
= E.a
4390 val mutable m_minfo
= E.a
4391 val mutable m_orig_items
= E.a
4392 val mutable m_orig_minfo
= E.a
4393 val mutable m_narrow_patterns
= []
4394 val mutable m_gen
= -1
4396 method getitemcount
= Array.length m_items
4399 let s, n, _ = m_items
.(n) in
4402 method exit ~
(uioh:uioh) ~cancel ~
active ~
(first:int) ~pan
:
4404 ignore
(uioh, first);
4406 if m_narrow_patterns
= []
4407 then m_orig_items
, m_orig_minfo
4408 else m_items
, m_minfo
4415 gotooutline m_items
.(active);
4423 method hasaction
(_:int) = true
4426 if Array.length m_items
!= Array.length m_orig_items
4429 match m_narrow_patterns
with
4431 | many
-> String.concat
"@Uellipsis" (List.rev many
)
4433 "Narrowed to " ^
s ^
" (ctrl-u to restore)"
4437 match m_narrow_patterns
with
4440 | head
:: _ -> "@Uellipsis" ^ head
4442 method narrow
pattern =
4443 match Str.regexp_case_fold
pattern with
4444 | (exception _) -> ()
4446 let rec loop accu minfo n =
4449 m_items
<- Array.of_list
accu;
4450 m_minfo
<- Array.of_list
minfo;
4453 let (s, _, _) as o = m_items
.(n) in
4455 match Str.search_forward
re s 0 with
4456 | (exception Not_found
) -> accu, minfo
4457 | first -> o :: accu, (first, Str.match_end
()) :: minfo
4459 loop accu minfo (n-1)
4461 loop [] [] (Array.length m_items
- 1)
4463 method! getminfo
= m_minfo
4466 m_orig_items
<- fetchoutlines
();
4467 m_minfo
<- m_orig_minfo
;
4468 m_items
<- m_orig_items
4470 method add_narrow_pattern
pattern =
4471 m_narrow_patterns
<- pattern :: m_narrow_patterns
4473 method del_narrow_pattern
=
4474 match m_narrow_patterns
with
4475 | _ :: rest
-> m_narrow_patterns
<- rest
4480 match m_narrow_patterns
with
4481 | pattern :: [] -> self#narrow
pattern; pattern
4483 List.fold_left
(fun accu pattern ->
4484 self#narrow
pattern;
4485 pattern ^
"@Uellipsis" ^
accu) E.s list
4487 method calcactive
(_:anchor) = 0
4489 method reset
anchor items =
4490 if state
.gen
!= m_gen
4492 m_orig_items
<- items;
4494 m_narrow_patterns
<- [];
4496 m_orig_minfo
<- E.a;
4500 if items != m_orig_items
4502 m_orig_items
<- items;
4503 if m_narrow_patterns
== []
4504 then m_items
<- items;
4507 let active = self#calcactive
anchor in
4509 m_first
<- firstof m_first
active
4513 let outlinesource fetchoutlines
=
4515 inherit outlinesoucebase fetchoutlines
4516 method! calcactive
anchor =
4517 let rely = getanchory anchor in
4518 let rec loop n best bestd
=
4519 if n = Array.length m_items
4522 let _, _, kind
= m_items
.(n) in
4525 let orely = getanchory anchor in
4526 let d = abs
(orely - rely) in
4529 else loop (n+1) best bestd
4530 | Onone
| Oremote
_ | Olaunch
_
4531 | Oremotedest
_ | Ouri
_ | Ohistory
_ ->
4532 loop (n+1) best bestd
4538 let enteroutlinemode, enterbookmarkmode
, enterhistmode
=
4539 let mkselector sourcetype
=
4540 let fetchoutlines () =
4541 match sourcetype
with
4542 | `bookmarks
-> Array.of_list state
.bookmarks
4543 | `outlines
-> state
.outlines
4544 | `history
-> genhistoutlines ()
4547 if sourcetype
= `history
4548 then new outlinesoucebase
fetchoutlines
4549 else outlinesource fetchoutlines
4552 let outlines = fetchoutlines () in
4553 if Array.length
outlines = 0
4555 showtext ' ' errmsg
;
4559 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
4560 let anchor = getanchor
() in
4561 source#reset
anchor outlines;
4562 state
.text <- source#greetmsg
;
4564 coe (new outlinelistview ~zebra
:(sourcetype
=`history
) ~
source);
4565 G.postRedisplay "enter selector";
4568 let mkenter sourcetype errmsg
=
4569 let enter = mkselector sourcetype
in
4570 fun () -> enter errmsg
4572 mkenter `
outlines "document has no outline"
4573 , mkenter `bookmarks
"document has no bookmarks (yet)"
4574 , mkenter `history
"history is empty"
4577 let quickbookmark ?title
() =
4578 match state
.layout with
4584 let tm = Unix.localtime
(now
()) in
4586 "Quick (page %d) (bookmarked at %02d/%02d/%d %02d:%02d)"
4590 (tm.Unix.tm_year
+ 1900)
4593 | Some
title -> title
4595 state
.bookmarks
<- (title, 0, Oanchor
(getanchor1
l)) :: state
.bookmarks
4598 let setautoscrollspeed step goingdown
=
4599 let incr = max
1 ((abs step
) / 2) in
4600 let incr = if goingdown
then incr else -incr in
4601 let astep = boundastep state
.winh
(step
+ incr) in
4602 state
.autoscroll
<- Some
astep;
4606 match conf
.columns
with
4608 | Csingle
_ | Cmulti
_ -> state
.x != 0 || conf
.zoom > 1.0
4611 let panbound x = bound
x (-state
.w) state
.winw
;;
4613 let existsinrow pageno (columns
, coverA
, coverB
) p =
4614 let last = ((pageno - coverA
) mod columns
) + columns
in
4615 let rec any = function
4618 if l.pageno = coverA
- 1 || l.pageno = state
.pagecount
- coverB
4622 then (if l.pageno = last then false else any rest
)
4630 match state
.layout with
4632 let pageno = page_of_y state
.y in
4633 gotoghyll (getpagey
(pageno+1))
4635 match conf
.columns
with
4637 if conf
.presentation
&& rest
== [] && l.pageh
> l.pagey + l.pagevh
4639 let y = clamp (pgscale state
.winh
) in
4642 let pageno = min
(l.pageno+1) (state
.pagecount
-1) in
4643 gotoghyll (getpagey
pageno)
4644 | Cmulti
((c, _, _) as cl
, _) ->
4645 if conf
.presentation
4646 && (existsinrow l.pageno cl
4647 (fun l -> l.pageh
> l.pagey + l.pagevh))
4649 let y = clamp (pgscale state
.winh
) in
4652 let pageno = min
(l.pageno+c) (state
.pagecount
-1) in
4653 gotoghyll (getpagey
pageno)
4655 if l.pageno < state
.pagecount
- 1 || l.pagecol
< n - 1
4657 let pagey, pageh
= getpageyh
l.pageno in
4658 let pagey = pagey + pageh
* l.pagecol
in
4659 let ips = if l.pagecol
= 0 then 0 else conf
.interpagespace
in
4660 gotoghyll (pagey + pageh
+ ips)
4664 match state
.layout with
4666 let pageno = page_of_y state
.y in
4667 gotoghyll (getpagey
(pageno-1))
4669 match conf
.columns
with
4671 if conf
.presentation
&& l.pagey != 0
4673 gotoghyll (clamp (pgscale ~
-(state
.winh
)))
4675 let pageno = max
0 (l.pageno-1) in
4676 gotoghyll (getpagey
pageno)
4677 | Cmulti
((c, _, coverB
) as cl
, _) ->
4678 if conf
.presentation
&&
4679 (existsinrow l.pageno cl
(fun l -> l.pagey != 0))
4681 gotoghyll (clamp (pgscale ~
-(state
.winh
)))
4684 if l.pageno = state
.pagecount
- coverB
4688 let pageno = max
0 (l.pageno-decr) in
4689 gotoghyll (getpagey
pageno)
4697 let pageno = max
0 (l.pageno-1) in
4698 let pagey, pageh
= getpageyh
pageno in
4701 let pagey, pageh
= getpageyh
l.pageno in
4702 pagey + pageh
* (l.pagecol
-1) - conf
.interpagespace
4708 if emptystr conf
.savecmd
4709 then error
"don't know where to save modified document"
4711 let savecmd = Str.global_replace percentsre state
.path conf
.savecmd in
4714 (fun s -> error
"failed to obtain path to the saved copy: %s" s)
4719 let tmp = path ^
".tmp" in
4721 Unix.rename
tmp path;
4724 let viewkeyboard key mask
=
4726 let mode = state
.mode in
4727 state
.mode <- Textentry
(te, fun _ -> state
.mode <- mode);
4730 G.postRedisplay "view:enttext"
4732 let ctrl = Wsi.withctrl mask
in
4733 let key = Wsi.keypadtodigitkey
key in
4738 if hasunsavedchanges
()
4742 if conf
.angle
mod 360 = 0 && not
(isbirdseye state
.mode)
4744 state
.mode <- LinkNav
(Ltgendir
0);
4745 gotoxy state
.x state
.y;
4747 else impmsg "keyboard link navigation does not work under rotation"
4750 begin match state
.mstate
with
4753 G.postRedisplay "kill rect";
4756 | Mscrolly
| Mscrollx
4759 begin match state
.mode with
4762 G.postRedisplay "esc leave linknav"
4766 match state
.ranchors
with
4768 | (path, password, anchor, origin
) :: rest
->
4769 state
.ranchors
<- rest
;
4770 state
.anchor <- anchor;
4771 state
.origin
<- origin
;
4772 state
.nameddest
<- E.s;
4773 opendoc path password
4778 gotoghyll (getnav ~
-1)
4789 Hashtbl.iter
(fun _ opaque ->
4791 Hashtbl.clear state
.prects
) state
.pagemap
;
4792 G.postRedisplay "dehighlight";
4794 | @slash
| @question
->
4795 let ondone isforw
s =
4796 cbput state
.hists
.pat
s;
4797 state
.searchpattern
<- s;
4800 let s = String.make
1 (Char.chr
key) in
4801 enttext (s, E.s, Some
(onhist state
.hists
.pat
),
4802 textentry, ondone (key = @slash
), true)
4804 | @plus
| @kpplus
| @equals
when ctrl ->
4805 let incr = if conf
.zoom +. 0.01 > 0.1 then 0.1 else 0.01 in
4806 pivotzoom (conf
.zoom +. incr)
4808 | @plus
| @kpplus
->
4811 try int_of_string
s with exn
->
4812 state
.text <- Printf.sprintf
"bad integer `%s': %s" s @@ exntos exn
;
4818 state
.text <- "page bias is now " ^ string_of_int
n;
4821 enttext ("page bias: ", E.s, None
, intentry, ondone, true)
4823 | @minus
| @kpminus
when ctrl ->
4824 let decr = if conf
.zoom -. 0.1 < 0.1 then 0.01 else 0.1 in
4825 pivotzoom (max
0.01 (conf
.zoom -. decr))
4827 | @minus
| @kpminus
->
4828 let ondone msg
= state
.text <- msg
in
4830 "option [acfhilpstvxACFPRSZTISM]: ", E.s, None
,
4831 optentry state
.mode, ondone, true
4836 then gotoxy 0 state
.y
4839 | (@1 | @2) when ctrl && conf
.fitmodel
!= FitPage
-> (* ctrl-1/2 *)
4841 match conf
.columns
with
4842 | Csingle
_ | Cmulti
_ -> 1
4843 | Csplit
(n, _) -> n
4845 let h = state
.winh
-
4846 conf
.interpagespace
lsl (if conf
.presentation
then 1 else 0)
4848 let zoom = zoomforh state
.winw
h 0 cols in
4849 if zoom > 0.0 && (key = @2 || zoom < 1.0)
4854 match conf
.fitmodel
with
4855 | FitWidth
-> FitProportional
4856 | FitProportional
-> FitPage
4857 | FitPage
-> FitWidth
4859 state
.text <- "fit model: " ^
FMTE.to_string
fm;
4860 reqlayout conf
.angle
fm
4862 | @4 when ctrl -> (* ctrl-4 *)
4863 let zoom = getmaxw
() /. float state
.winw
in
4864 if zoom > 0.0 then setzoom zoom
4872 | (48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57)
4873 when not
ctrl -> (* 0..9 *)
4876 try int_of_string
s with exn
->
4877 state
.text <- Printf.sprintf
"bad integer `%s': %s" s @@ exntos exn
;
4883 cbput state
.hists
.pag
(string_of_int
n);
4884 gotopage1 (n + conf
.pagebias
- 1) 0;
4887 let pageentry text key =
4888 match Char.unsafe_chr
key with
4889 | '
g'
-> TEdone
text
4890 | _ -> intentry text key
4892 let text = String.make
1 (Char.chr
key) in
4893 enttext (":", text, Some
(onhist state
.hists
.pag
),
4894 pageentry, ondone, true)
4897 conf
.scrollb
<- if conf
.scrollb
= 0 then (scrollbvv
lor scrollbhv
) else 0;
4898 G.postRedisplay "toggle scrollbar";
4901 state
.bzoom
<- not state
.bzoom
;
4903 showtext ' '
("block zoom " ^
if state
.bzoom
then "on" else "off")
4906 conf
.hlinks
<- not conf
.hlinks
;
4907 state
.text <- "highlightlinks " ^
if conf
.hlinks
then "on" else "off";
4908 G.postRedisplay "toggle highlightlinks";
4911 if conf
.angle
mod 360 = 0
4913 state
.glinks
<- true;
4914 let mode = state
.mode in
4917 (":", E.s, None
, linknentry, linknact gotounder, false),
4919 state
.glinks
<- false;
4923 G.postRedisplay "view:linkent(F)"
4925 else impmsg "hint mode does not work under rotation"
4928 state
.glinks
<- true;
4929 let mode = state
.mode in
4930 state
.mode <- Textentry
(
4932 ":", E.s, None
, linknentry, linknact (fun under ->
4933 selstring (undertext under);
4937 state
.glinks
<- false;
4941 G.postRedisplay "view:linkent"
4944 begin match state
.autoscroll
with
4946 conf
.autoscrollstep
<- step
;
4947 state
.autoscroll
<- None
4949 if conf
.autoscrollstep
= 0
4950 then state
.autoscroll
<- Some
1
4951 else state
.autoscroll
<- Some conf
.autoscrollstep
4955 launchpath () (* XXX where do error messages go? *)
4958 setpresentationmode (not conf
.presentation
);
4959 showtext ' '
("presentation mode " ^
4960 if conf
.presentation
then "on" else "off");
4963 if List.mem
Wsi.Fullscreen state
.winstate
4964 then Wsi.reshape conf
.cwinw conf
.cwinh
4965 else Wsi.fullscreen
()
4968 search state
.searchpattern
false
4971 search state
.searchpattern
true
4974 begin match state
.layout with
4977 gotoghyll (getpagey
l.pageno)
4983 | @delete
| @kpdelete
-> (* delete *)
4987 showtext ' '
(describe_location ());
4990 begin match state
.layout with
4993 Wsi.reshape l.pagew
l.pageh
;
4998 enterbookmarkmode
()
5006 | @e when Buffer.length state
.errmsgs
> 0 ->
5011 match state
.layout with
5016 (s, 0, Oanchor
(getanchor1
l)) :: state
.bookmarks
5019 enttext ("bookmark: ", E.s, None
, textentry, ondone, true)
5023 showtext ' '
"Quick bookmark added";
5026 begin match state
.layout with
5028 let rect = getpdimrect
l.pagedimno
in
5032 (truncate
(1.8 *. (rect.(1) -. rect.(0))),
5033 truncate
(1.2 *. (rect.(3) -. rect.(0))))
5035 (truncate
(rect.(1) -. rect.(0)),
5036 truncate
(rect.(3) -. rect.(0)))
5038 let w = truncate
((float w)*.conf
.zoom)
5039 and h = truncate
((float h)*.conf
.zoom) in
5042 state
.anchor <- getanchor
();
5043 Wsi.reshape w (h + conf
.interpagespace
)
5045 G.postRedisplay "z";
5050 | @x -> state
.roam
()
5053 reqlayout (conf
.angle
+
5054 (if key = @Gt
then 30 else -30)) conf
.fitmodel
5058 bound
(conf
.colorscale
+. (if key = 93 then 0.1 else -0.1)) 0.0 1.0
5060 G.postRedisplay "brightness";
5062 | @c when state
.mode = View
->
5067 let m = (state
.winw
- state
.w) / 2 in
5068 gotoxy_and_clear_text m state
.y
5072 match state
.prevcolumns
with
5073 | None
-> (1, 0, 0), 1.0
5074 | Some
(columns
, z
) ->
5077 | Csplit
(c, _) -> -c, 0, 0
5078 | Cmulti
((c, a, b), _) -> c, a, b
5079 | Csingle
_ -> 1, 0, 0
5083 setcolumns View
c a b;
5086 | @down
| @up
when ctrl && Wsi.withshift mask
->
5087 let zoom, x = state
.prevzoom
in
5091 | @k
| @up
| @kpup
->
5092 begin match state
.autoscroll
with
5094 begin match state
.mode with
5095 | Birdseye beye
-> upbirdseye 1 beye
5100 then gotoxy_and_clear_text state
.x (clamp ~
-(state
.winh
/2))
5102 if not
(Wsi.withshift mask
) && conf
.presentation
5104 else gotoghyll1 true (clamp (-conf
.scrollstep
))
5108 setautoscrollspeed n false
5111 | @j
| @down
| @kpdown
->
5112 begin match state
.autoscroll
with
5114 begin match state
.mode with
5115 | Birdseye beye
-> downbirdseye 1 beye
5120 then gotoxy_and_clear_text state
.x (clamp (state
.winh
/2))
5122 if not
(Wsi.withshift mask
) && conf
.presentation
5124 else gotoghyll1 true (clamp (conf
.scrollstep
))
5128 setautoscrollspeed n true
5131 | @left | @right
| @kpleft
| @kpright
when not
(Wsi.withalt mask
) ->
5137 else conf
.hscrollstep
5139 let dx = if key = @left || key = @kpleft
then dx else -dx in
5140 gotoxy_and_clear_text (panbound (state
.x + dx)) state
.y
5143 G.postRedisplay "left/right"
5146 | @prior
| @kpprior
->
5150 match state
.layout with
5152 | l :: _ -> state
.y - l.pagey
5154 clamp (pgscale (-state
.winh
))
5158 | @next | @kpnext
->
5162 match List.rev state
.layout with
5164 | l :: _ -> getpagey
l.pageno
5166 clamp (pgscale state
.winh
)
5170 | @g | @home
| @kphome
->
5173 | @G
| @jend
| @kpend
->
5175 gotoghyll (clamp state
.maxy)
5177 | @right
| @kpright
when Wsi.withalt mask
->
5178 gotoghyll (getnav 1)
5179 | @left | @kpleft
when Wsi.withalt mask
->
5180 gotoghyll (getnav ~
-1)
5185 | @v when conf
.debug
->
5188 match getopaque l.pageno with
5191 let x0, y0, x1, y1 = pagebbox
opaque in
5192 let rect = (float x0, float y0,
5195 float x0, float y1) in
5197 let color = (0.0, 0.0, 1.0 /. (l.pageno mod 3 |> float), 0.5) in
5198 state
.rects
<- (l.pageno, color, rect) :: state
.rects
;
5200 G.postRedisplay "v";
5203 let mode = state
.mode in
5204 let cmd = ref E.s in
5205 let onleave = function
5206 | Cancel
-> state
.mode <- mode
5209 match getopaque l.pageno with
5210 | Some
opaque -> pipesel opaque !cmd
5211 | None
-> ()) state
.layout;
5215 cbput state
.hists
.sel
s;
5219 "| ", !cmd, Some
(onhist state
.hists
.sel
), textentry, ondone, true
5221 G.postRedisplay "|";
5222 state
.mode <- Textentry
(te, onleave);
5225 vlog "huh? %s" (Wsi.keyname
key)
5228 let linknavkeyboard key mask
linknav =
5229 let getpage pageno =
5230 let rec loop = function
5232 | l :: _ when l.pageno = pageno -> Some
l
5233 | _ :: rest
-> loop rest
5234 in loop state
.layout
5236 let doexact (pageno, n) =
5237 match getopaque pageno, getpage pageno with
5238 | Some
opaque, Some
l ->
5239 if key = @enter || key = @kpenter
5241 let under = getlink
opaque n in
5242 G.postRedisplay "link gotounder";
5249 Some
(findlink
opaque LDfirst
), -1
5252 Some
(findlink
opaque LDlast
), 1
5255 Some
(findlink
opaque (LDleft
n)), -1
5258 Some
(findlink
opaque (LDright
n)), 1
5261 Some
(findlink
opaque (LDup
n)), -1
5264 Some
(findlink
opaque (LDdown
n)), 1
5269 begin match findpwl
l.pageno dir with
5273 state
.mode <- LinkNav
(Ltgendir
dir);
5274 let y, h = getpageyh
pageno in
5277 then y + h - state
.winh
5282 begin match getopaque pageno, getpage pageno with
5283 | Some
opaque, Some
_ ->
5285 let ld = if dir > 0 then LDfirst
else LDlast
in
5288 begin match link with
5290 showlinktype (getlink
opaque m);
5291 state
.mode <- LinkNav
(Ltexact
(pageno, m));
5292 G.postRedisplay "linknav jpage";
5293 | Lnotfound
-> notfound dir
5299 begin match opt with
5300 | Some Lnotfound
-> pwl l dir;
5301 | Some
(Lfound
m) ->
5305 let _, y0, _, y1 = getlinkrect
opaque m in
5307 then gotopage1 l.pageno y0
5309 let d = fstate
.fontsize
+ 1 in
5310 if y1 - l.pagey > l.pagevh - d
5311 then gotopage1 l.pageno (y1 - state
.winh
+ d)
5312 else G.postRedisplay "linknav";
5314 showlinktype (getlink
opaque m);
5315 state
.mode <- LinkNav
(Ltexact
(l.pageno, m));
5318 | None
-> viewkeyboard key mask
5320 | _ -> viewkeyboard key mask
5325 G.postRedisplay "leave linknav"
5329 | Ltgendir
_ | Ltnotready
_ -> viewkeyboard key mask
5330 | Ltexact exact
-> doexact exact
5333 let keyboard key mask
=
5334 if (key = @g && Wsi.withctrl mask
) && not
(istextentry state
.mode)
5335 then wcmd "interrupt"
5336 else state
.uioh <- state
.uioh#
key key mask
5339 let birdseyekeyboard key mask
5340 ((oconf
, leftx
, pageno, hooverpageno
, anchor) as beye
) =
5342 match conf
.columns
with
5344 | Cmulti
((c, _, _), _) -> c
5345 | Csplit
_ -> failwith
"bird's eye split mode"
5347 let pgh layout = List.fold_left
5348 (fun m l -> max
l.pageh
m) state
.winh
layout in
5350 | @l when Wsi.withctrl mask
->
5351 let y, h = getpageyh
pageno in
5352 let top = (state
.winh
- h) / 2 in
5353 gotoxy state
.x (max
0 (y - top))
5354 | @enter | @kpenter
-> leavebirdseye beye
false
5355 | @escape
-> leavebirdseye beye
true
5356 | @up
-> upbirdseye incr beye
5357 | @down
-> downbirdseye incr beye
5358 | @left -> upbirdseye 1 beye
5359 | @right
-> downbirdseye 1 beye
5362 begin match state
.layout with
5366 state
.mode <- Birdseye
(
5367 oconf
, leftx
, l.pageno, hooverpageno
, anchor
5369 gotopage1 l.pageno 0;
5372 let layout = layout state
.x (state
.y-state
.winh
)
5374 (pgh state
.layout) in
5376 | [] -> gotoxy state
.x (clamp (-state
.winh
))
5378 state
.mode <- Birdseye
(
5379 oconf
, leftx
, l.pageno, hooverpageno
, anchor
5381 gotopage1 l.pageno 0
5384 | [] -> gotoxy state
.x (clamp (-state
.winh
))
5388 begin match List.rev state
.layout with
5390 let layout = layout state
.x
5391 (state
.y + (pgh state
.layout))
5392 state
.winw state
.winh
in
5393 begin match layout with
5395 let incr = l.pageh
- l.pagevh in
5400 oconf
, leftx
, state
.pagecount
- 1, hooverpageno
, anchor
5402 G.postRedisplay "birdseye pagedown";
5404 else gotoxy state
.x (clamp (incr + conf
.interpagespace
*2));
5408 Birdseye
(oconf
, leftx
, l.pageno, hooverpageno
, anchor);
5409 gotopage1 l.pageno 0;
5412 | [] -> gotoxy state
.x (clamp state
.winh
)
5416 state
.mode <- Birdseye
(oconf
, leftx
, 0, hooverpageno
, anchor);
5420 let pageno = state
.pagecount
- 1 in
5421 state
.mode <- Birdseye
(oconf
, leftx
, pageno, hooverpageno
, anchor);
5422 if not
(pagevisible state
.layout pageno)
5425 match List.rev state
.pdims
with
5427 | (_, _, h, _) :: _ -> h
5431 (max
0 (getpagey
pageno - (state
.winh
- h - conf
.interpagespace
)))
5432 else G.postRedisplay "birdseye end";
5434 | _ -> viewkeyboard key mask
5439 match state
.mode with
5440 | Textentry
_ -> scalecolor 0.4
5442 | View
-> scalecolor 1.0
5443 | Birdseye
(_, _, pageno, hooverpageno
, _) ->
5444 if l.pageno = hooverpageno
5447 if l.pageno = pageno
5449 let c = scalecolor 1.0 in
5451 GlDraw.line_width
3.0;
5452 let dispx = l.pagedispx in
5454 (float (dispx-1)) (float (l.pagedispy-1))
5455 (float (dispx+l.pagevw+1))
5456 (float (l.pagedispy+l.pagevh+1))
5458 GlDraw.line_width
1.0;
5467 let postdrawpage l linkindexbase
=
5468 match getopaque l.pageno with
5470 if tileready l l.pagex
l.pagey
5472 let x = l.pagedispx - l.pagex
5473 and y = l.pagedispy - l.pagey in
5475 match conf
.columns
with
5476 | Csingle
_ | Cmulti
_ ->
5477 (if conf
.hlinks
then 1 else 0)
5479 && not
(isbirdseye state
.mode) then 2 else 0)
5483 match state
.mode with
5484 | Textentry
((_, s, _, _, _, _), _) when state
.glinks
-> s
5490 Hashtbl.find_all state
.prects
l.pageno |>
5491 List.iter
(fun vals
-> drawprect
opaque x y vals
);
5492 let n = postprocess
opaque hlmask x y (linkindexbase
, s, conf
.hfsize
) in
5494 then (state
.redisplay
<- true; 0)
5500 let scrollindicator () =
5501 let sbw, ph
, sh = state
.uioh#
scrollph in
5502 let sbh, pw, sw = state
.uioh#scrollpw
in
5507 else ((state
.winw
- sbw), state
.winw
, 0)
5511 GlFunc.blend_func ~
src:`src_alpha ~dst
:`one_minus_src_alpha
;
5512 GlDraw.color (0.64, 0.64, 0.64) ~
alpha:0.7;
5513 filledrect (float x0) 0. (float x1) (float state
.winh
);
5515 (float hx0
) (float (state
.winh
- sbh))
5516 (float (hx0
+ state
.winw
)) (float state
.winh
)
5518 GlDraw.color (0.0, 0.0, 0.0) ~
alpha:0.7;
5520 filledrect (float x0) ph
(float x1) (ph
+. sh);
5521 let pw = pw +. float hx0
in
5522 filledrect pw (float (state
.winh
- sbh)) (pw +. sw) (float state
.winh
);
5527 match state
.mstate
with
5528 | Mnone
| Mscrolly
| Mscrollx
| Mpan
_ | Mzoom
_ | Mzoomrect
_ ->
5531 | Msel
((x0, y0), (x1, y1)) ->
5532 let identify opaque l px py = Some
(opaque, l.pageno, px, py) in
5533 let o0,n0
,px0
,py0
= onppundermouse identify x0 y0 (~
< E.s, -1, 0, 0) in
5534 let _o1,n1
,px1
,py1
= onppundermouse identify x1 y1 (~
< E.s, -1, 0, 0) in
5535 if n0
!= -1 && n0
= n1
then seltext
o0 (px0
, py0
, px1
, py1
);
5538 let showrects = function [] -> () | rects
->
5540 GlDraw.color (0.0, 0.0, 1.0) ~
alpha:0.5;
5541 GlFunc.blend_func ~
src:`src_alpha ~dst
:`one_minus_src_alpha
;
5543 (fun (pageno, c, (x0, y0, x1, y1, x2
, y2
, x3
, y3
)) ->
5545 if l.pageno = pageno
5547 let dx = float (l.pagedispx - l.pagex
) in
5548 let dy = float (l.pagedispy - l.pagey) in
5549 let r, g, b, alpha = c in
5550 GlDraw.color (r, g, b) ~
alpha;
5551 filledrect2 (x0+.dx) (y0+.dy)
5563 begin match conf
.columns
, state
.layout with
5564 | Csingle
_, _ :: _ ->
5565 GlDraw.color (scalecolor2 conf
.bgcolor
);
5567 List.fold_left
(fun y l ->
5570 let x1 = l.pagedispx in
5571 let y1 = (l.pagedispy + l.pagevh) in
5572 filledrect (float x0) (float y0) (float x1) (float y1);
5573 let x0 = x1 + l.pagevw in
5574 let x1 = state
.winw
in
5575 filledrect1 (float x0) (float y0) (float x1) (float y1);
5579 and x1 = state
.winw
in
5581 and y1 = l.pagedispy in
5582 filledrect1 (float x0) (float y0) (float x1) (float y1);
5584 l.pagedispy + l.pagevh) 0 state
.layout
5587 and x1 = state
.winw
in
5589 and y1 = state
.winh
in
5590 filledrect1 (float x0) (float y0) (float x1) (float y1)
5591 | (Cmulti
_ | Csplit
_), _ | Csingle
_, [] ->
5592 GlClear.color (scalecolor2 conf
.bgcolor
);
5593 GlClear.clear
[`
color];
5595 List.iter
drawpage state
.layout;
5597 match state
.mode with
5598 | LinkNav
(Ltexact
(pageno, linkno
)) ->
5599 begin match getopaque pageno with
5601 let x0, y0, x1, y1 = getlinkrect
opaque linkno
in
5602 let color = (0.0, 0.0, 0.5, 0.5) in
5609 | None
-> state
.rects
5611 | LinkNav
(Ltgendir
_) | LinkNav
(Ltnotready
_)
5614 | View
-> state
.rects
5617 let rec postloop linkindexbase
= function
5619 let linkindexbase = linkindexbase + postdrawpage l linkindexbase in
5620 postloop linkindexbase rest
5624 postloop 0 state
.layout;
5626 begin match state
.mstate
with
5627 | Mzoomrect
((x0, y0), (x1, y1)) ->
5629 GlDraw.color (0.3, 0.3, 0.3) ~
alpha:0.5;
5630 GlFunc.blend_func ~
src:`src_alpha ~dst
:`one_minus_src_alpha
;
5631 filledrect (float x0) (float y0) (float x1) (float y1);
5635 | Mscrolly
| Mscrollx
5644 let zoomrect x y x1 y1 =
5647 and y0 = min
y y1 in
5648 let zoom = (float state
.w) /. float (x1 - x0) in
5651 if state
.w < state
.winw
5652 then (state
.winw
- state
.w) / 2
5655 match conf
.fitmodel
with
5656 | FitWidth
| FitProportional
-> simple ()
5658 match conf
.columns
with
5660 onppundermouse (fun _ l _ _ -> Some
l.pagedispx) x0 y0 x0
5661 | Cmulti
_ | Csingle
_ -> simple ()
5663 gotoxy ((state
.x + margin) - x0) (state
.y + y0);
5664 state
.anchor <- getanchor
();
5669 let annot inline
x y =
5670 match unproject x y with
5671 | Some
(opaque, n, ux
, uy
) ->
5673 addannot
opaque ux uy
text;
5674 wcmd "freepage %s" (~
> opaque);
5675 Hashtbl.remove state
.pagemap
(n, state
.gen
);
5677 gotoxy state
.x state
.y
5681 let ondone s = add s in
5682 let mode = state
.mode in
5683 state
.mode <- Textentry
(
5684 ("annotation: ", E.s, None
, textentry, ondone, true),
5685 fun _ -> state
.mode <- mode);
5688 G.postRedisplay "annot"
5690 add @@ getusertext E.s
5695 let g opaque l px py =
5696 match rectofblock
opaque px py with
5698 let x0 = a.(0) -. 20. in
5699 let x1 = a.(1) +. 20. in
5700 let y0 = a.(2) -. 20. in
5701 let zoom = (float state
.w) /. (x1 -. x0) in
5702 let pagey = getpagey
l.pageno in
5703 let margin = (state
.w - l.pagew
)/2 in
5704 let nx = -truncate
x0 - margin in
5705 gotoxy_and_clear_text nx (pagey + truncate
y0);
5706 state
.anchor <- getanchor
();
5711 match conf
.columns
with
5713 impmsg "block zooming does not work properly in split columns mode"
5714 | Cmulti
_ | Csingle
_ -> onppundermouse g x y ()
5718 let winw = state
.winw - 1 in
5719 let s = float x /. float winw in
5720 let destx = truncate
(float (state
.w + winw) *. s) in
5721 gotoxy_and_clear_text (winw - destx) state
.y;
5722 state
.mstate
<- Mscrollx
;
5726 let s = float y /. float state
.winh
in
5727 let desty = truncate
(float (state
.maxy -
5728 (if conf
.maxhfit
then state
.winh
else 0))
5730 gotoxy_and_clear_text state
.x desty;
5731 state
.mstate
<- Mscrolly
;
5734 let viewmulticlick clicks
x y mask
=
5735 let g opaque l px py =
5743 if markunder
opaque px py mark
5747 match getopaque l.pageno with
5749 | Some
opaque -> pipesel opaque cmd
5751 state
.roam
<- (fun () -> dopipe conf
.paxcmd
);
5752 if not
(Wsi.withctrl mask
) then dopipe conf
.selcmd
;
5757 G.postRedisplay "viewmulticlick";
5758 onppundermouse g x y (fun () -> impmsg "nothing to select") ();
5762 match conf
.columns
with
5764 | Csingle
_ | Cmulti
_ -> conf
.angle
mod 360 = 0
5767 let viewmouse button down
x y mask
=
5769 | n when (n == 4 || n == 5) && not down
->
5770 if Wsi.withctrl mask
5772 match state
.mstate
with
5773 | Mzoom
(oldn
, i
, (ftx
, fty
)) ->
5776 then abs
(ftx
- x) > 5 || abs
(fty
- y) > 5
5786 if conf
.zoom +. 0.01 > 0.1 then 0.1 else 0.01
5788 if conf
.zoom -. 0.1 < 0.1 then -0.01 else -0.1
5790 let zoom = conf
.zoom -. incr in
5792 then pivotzoom ~
x ~
y zoom
5793 else pivotzoom zoom;
5794 state
.mstate
<- Mzoom
(n, 0, (x, y));
5796 state
.mstate
<- Mzoom
(n, i
+1, (ftx
, fty
));
5798 else state
.mstate
<- Mzoom
(n, 0, (ftx
, fty
))
5802 | Mscrolly
| Mscrollx
5804 | Mnone
-> state
.mstate
<- Mzoom
(n, 0, (0, 0))
5807 match state
.autoscroll
with
5808 | Some step
-> setautoscrollspeed step
(n=4)
5810 if conf
.wheelbypage
|| conf
.presentation
5819 then -conf
.scrollstep
5820 else conf
.scrollstep
5822 let incr = incr * 2 in
5823 let y = clamp incr in
5824 gotoxy_and_clear_text state
.x y
5827 | n when (n = 6 || n = 7) && not down
&& canpan () ->
5829 panbound (state
.x + (if n = 7 then -2 else 2) * conf
.hscrollstep
) in
5830 gotoxy_and_clear_text x state
.y
5832 | 1 when Wsi.withshift mask
->
5833 state
.mstate
<- Mnone
;
5836 match unproject x y with
5838 | Some
(_, pageno, ux
, uy
) ->
5839 let cmd = Printf.sprintf
5841 conf
.stcmd state
.path pageno ux uy
5843 match spawn
cmd [] with
5844 | (exception exn
) ->
5845 impmsg "execution of synctex command(%S) failed: %S"
5846 conf
.stcmd
@@ exntos exn
5850 | 1 when Wsi.withctrl mask
->
5853 Wsi.setcursor
Wsi.CURSOR_FLEUR
;
5854 state
.mstate
<- Mpan
(x, y)
5857 state
.mstate
<- Mnone
5862 if Wsi.withshift mask
5864 annot conf
.annotinline
x y;
5865 G.postRedisplay "addannot"
5869 Wsi.setcursor
Wsi.CURSOR_CYCLE
;
5870 state
.mstate
<- Mzoomrect
(p, p)
5873 match state
.mstate
with
5874 | Mzoomrect
((x0, y0), _) ->
5875 if abs
(x-x0) > 10 && abs
(y - y0) > 10
5876 then zoomrect x0 y0 x y
5879 G.postRedisplay "kill accidental zoom rect";
5883 | Mscrolly
| Mscrollx
5889 | 1 when vscrollhit x ->
5892 let _, position, sh = state
.uioh#
scrollph in
5893 if y > truncate
position && y < truncate
(position +. sh)
5894 then state
.mstate
<- Mscrolly
5897 state
.mstate
<- Mnone
5899 | 1 when y > state
.winh
- hscrollh () ->
5902 let _, position, sw = state
.uioh#scrollpw
in
5903 if x > truncate
position && x < truncate
(position +. sw)
5904 then state
.mstate
<- Mscrollx
5907 state
.mstate
<- Mnone
5909 | 1 when state
.bzoom
-> if not down
then zoomblock x y
5912 let dest = if down
then getunder x y else Unone
in
5913 begin match dest with
5916 | Uremote
_ | Uremotedest
_
5917 | Uunexpected
_ | Ulaunch
_ | Unamed
_ ->
5920 | Unone
when down
->
5921 Wsi.setcursor
Wsi.CURSOR_FLEUR
;
5922 state
.mstate
<- Mpan
(x, y);
5924 | Uannotation
(opaque, slinkindex
) -> enterannotmode opaque slinkindex
5926 | Unone
| Utext
_ ->
5931 state
.mstate
<- Msel
((x, y), (x, y));
5932 G.postRedisplay "mouse select";
5936 match state
.mstate
with
5939 | Mzoom
_ | Mscrollx
| Mscrolly
->
5940 state
.mstate
<- Mnone
5942 | Mzoomrect
((x0, y0), _) ->
5946 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
5947 state
.mstate
<- Mnone
5949 | Msel
((x0, y0), (x1, y1)) ->
5950 let rec loop = function
5954 let a0 = l.pagedispy in
5955 let a1 = a0 + l.pagevh in
5956 let b0 = l.pagedispx in
5957 let b1 = b0 + l.pagevw in
5958 ((y0 >= a0 && y0 <= a1) || (y1 >= a0 && y1 <= a1))
5959 && ((x0 >= b0 && x0 <= b1) || (x1 >= b0 && x1 <= b1))
5963 match getopaque l.pageno with
5966 match Unix.pipe
() with
5967 | (exception exn
) ->
5968 impmsg "cannot create sel pipe: %s" @@
5972 Ne.clo fd
(fun msg
->
5973 dolog
"%s close failed: %s" what msg
)
5976 try spawn
cmd [r, 0; w, -1]
5978 dolog
"cannot execute %S: %s"
5985 G.postRedisplay "copysel";
5987 else clo "Msel pipe/w" w;
5988 clo "Msel pipe/r" r;
5990 dosel conf
.selcmd
();
5991 state
.roam
<- dosel conf
.paxcmd
;
6003 let birdseyemouse button down
x y mask
6004 (conf
, leftx
, _, hooverpageno
, anchor) =
6007 let rec loop = function
6010 if y > l.pagedispy && y < l.pagedispy + l.pagevh
6011 && x > l.pagedispx && x < l.pagedispx + l.pagevw
6013 leavebirdseye (conf
, leftx
, l.pageno, hooverpageno
, anchor) false;
6019 | _ -> viewmouse button down
x y mask
6025 method key key mask
=
6026 begin match state
.mode with
6027 | Textentry
textentry -> textentrykeyboard key mask
textentry
6028 | Birdseye
birdseye -> birdseyekeyboard key mask
birdseye
6029 | View
-> viewkeyboard key mask
6030 | LinkNav
linknav -> linknavkeyboard key mask
linknav
6034 method button button bstate
x y mask
=
6035 begin match state
.mode with
6037 | View
-> viewmouse button bstate
x y mask
6038 | Birdseye beye
-> birdseyemouse button bstate
x y mask beye
6043 method multiclick clicks
x y mask
=
6044 begin match state
.mode with
6046 | View
-> viewmulticlick clicks
x y mask
6053 begin match state
.mode with
6055 | View
| Birdseye
_ | LinkNav
_ ->
6056 match state
.mstate
with
6057 | Mzoom
_ | Mnone
-> ()
6062 state
.mstate
<- Mpan
(x, y);
6063 let x = if canpan () then panbound (state
.x + dx) else state
.x in
6065 gotoxy_and_clear_text x y
6068 state
.mstate
<- Msel
(a, (x, y));
6069 G.postRedisplay "motion select";
6072 let y = min state
.winh
(max
0 y) in
6076 let x = min state
.winw (max
0 x) in
6079 | Mzoomrect
(p0
, _) ->
6080 state
.mstate
<- Mzoomrect
(p0
, (x, y));
6081 G.postRedisplay "motion zoomrect";
6085 method pmotion
x y =
6086 begin match state
.mode with
6087 | Birdseye
(conf
, leftx
, pageno, hooverpageno
, anchor) ->
6088 let rec loop = function
6090 if hooverpageno
!= -1
6092 state
.mode <- Birdseye
(conf
, leftx
, pageno, -1, anchor);
6093 G.postRedisplay "pmotion birdseye no hoover";
6096 if y > l.pagedispy && y < l.pagedispy + l.pagevh
6097 && x > l.pagedispx && x < l.pagedispx + l.pagevw
6099 state
.mode <- Birdseye
(conf
, leftx
, pageno, l.pageno, anchor);
6100 G.postRedisplay "pmotion birdseye hoover";
6110 match state
.mstate
with
6111 | Mpan
_ | Msel
_ | Mzoom
_ | Mscrolly
| Mscrollx
| Mzoomrect
_ -> ()
6119 let past, _, _ = !r in
6121 let delta = now -. past in
6124 else r := (now, x, y)
6128 method infochanged
_ = ()
6131 let maxy = state
.maxy - (if conf
.maxhfit
then state
.winh
else 0) in
6134 then 0.0, float state
.winh
6135 else scrollph state
.y maxy
6140 let fwinw = float (state
.winw - vscrollw ()) in
6142 let sw = fwinw /. float state
.w in
6143 let sw = fwinw *. sw in
6144 max
sw (float conf
.scrollh
)
6147 let maxx = state
.w + state
.winw in
6148 let x = state
.winw - state
.x in
6149 let percent = float x /. float maxx in
6150 (fwinw -. sw) *. percent
6152 hscrollh (), position, sw
6156 match state
.mode with
6157 | LinkNav
_ -> "links"
6158 | Textentry
_ -> "textentry"
6159 | Birdseye
_ -> "birdseye"
6162 findkeyhash conf
modename
6164 method eformsgs
= true
6165 method alwaysscrolly
= false
6168 let addrect pageno r g b a x0 y0 x1 y1 =
6169 Hashtbl.add state
.prects
pageno [|r; g; b; a; x0; y0; x1; y1|];
6173 let cl = splitatspace cmds
in
6175 try Scanf.sscanf
s fmt
f
6177 adderrfmt "remote exec"
6178 "error processing '%S': %s\n" cmds
@@ exntos exn
6180 let rectx s pageno (r, g, b, a) x0 y0 x1 y1 =
6181 vlog "%s page %d color (%f %f %f %f) x0,y0,x1,y1 = %f %f %f %f"
6182 s pageno r g b a x0 y0 x1 y1;
6186 let _,w1,h1
,_ = getpagedim
pageno in
6187 let sw = float w1 /. float w
6188 and sh = float h1
/. float h in
6192 and y1s
= y1 *. sh in
6193 let rect = (x0s,y0s
,x1s
,y0s
,x1s
,y1s
,x0s,y1s
) in
6194 let color = (r, g, b, a) in
6195 if conf
.verbose
then debugrect rect;
6196 state
.rects <- (pageno, color, rect) :: state
.rects;
6201 | "reload", "" -> reload ()
6203 scan args
"%u %f %f"
6205 let cmd, _ = state
.geomcmds
in
6207 then gotopagexy !wtmode pageno x y
6210 gotopagexy !wtmode pageno x y;
6213 state
.reprf
<- f state
.reprf
6215 | "goto1", args
-> scan args
"%u %f" gotopage
6218 (fun filename
pageno -> gotounder (Uremote
(filename
, pageno)))
6221 (fun filename
dest -> gotounder (Uremotedest
(filename
, dest)))
6223 scan args
"%u %u %f %f %f %f"
6224 (fun pageno c x0 y0 x1 y1 ->
6225 let color = (0.0, 0.0, 1.0 /. float c, 0.5) in
6226 rectx "rect" pageno color x0 y0 x1 y1;
6229 scan args
"%u %f %f %f %f %f %f %f %f"
6230 (fun pageno r g b alpha x0 y0 x1 y1 ->
6231 addrect pageno r g b alpha x0 y0 x1 y1;
6232 G.postRedisplay "prect"
6235 scan args
"%u %f %f"
6238 match getopaque pageno with
6239 | Some
opaque -> opaque
6242 pgoto optopaque pageno x y;
6243 let rec fixx = function
6246 if l.pageno = pageno
6247 then gotoxy (state
.x - l.pagedispx) state
.y
6252 match conf
.columns
with
6253 | Csingle
_ | Csplit
_ -> 1
6254 | Cmulti
((n, _, _), _) -> n
6256 layout 0 state
.y (state
.winw * mult) state
.winh
6260 | "activatewin", "" -> Wsi.activatewin
()
6261 | "quit", "" -> raise Quit
6264 let l = Config.keys_of_string
keys in
6265 List.iter
(fun (k
, m) -> keyboard k
m) l
6267 adderrfmt "error processing keys" "`%S': %s\n" cmds
@@ exntos exn
6269 | "clearrects", "" ->
6270 Hashtbl.clear state
.prects
;
6271 G.postRedisplay "clearrects"
6273 adderrfmt "remote command"
6274 "error processing remote command: %S\n" cmds
;
6278 let scratch = Bytes.create
80 in
6279 let buf = Buffer.create
80 in
6281 match tempfailureretry
(Unix.read fd
scratch 0) 80 with
6282 | (exception Unix.Unix_error
(Unix.EAGAIN
, _, _)) -> None
6285 if Buffer.length
buf > 0
6287 let s = Buffer.contents
buf in
6295 match Bytes.index_from
scratch ppos '
\n'
with
6296 | pos -> if pos >= n then -1 else pos
6297 | (exception Not_found
) -> -1
6301 Buffer.add_subbytes
buf scratch ppos
(nlpos-ppos
);
6302 let s = Buffer.contents
buf in
6308 Buffer.add_subbytes
buf scratch ppos
(n-ppos
);
6314 let remoteopen path =
6315 try Some
(Unix.openfile
path [Unix.O_NONBLOCK
; Unix.O_RDONLY
] 0o0)
6317 adderrfmt "remoteopen" "error opening %S: %s" path @@ exntos exn
;
6322 let gcconfig = ref E.s in
6323 let trimcachepath = ref E.s in
6324 let rcmdpath = ref E.s in
6325 let pageno = ref None
in
6326 let rootwid = ref 0 in
6327 let openlast = ref false in
6328 let nofc = ref false in
6329 let doreap = ref false in
6330 selfexec := Sys.executable_name
;
6333 [("-p", Arg.String
(fun s -> state
.password <- s),
6334 "<password> Set password");
6338 Config.fontpath
:= s;
6339 selfexec := !selfexec ^
" -f " ^
Filename.quote
s;
6341 "<path> Set path to the user interface font");
6345 selfexec := !selfexec ^
" -c " ^
Filename.quote
s;
6346 Config.confpath
:= s),
6347 "<path> Set path to the configuration file");
6349 ("-last", Arg.Set
openlast, " Open last document");
6351 ("-page", Arg.Int
(fun pageno1
-> pageno := Some
(pageno1
-1)),
6352 "<page-number> Jump to page");
6354 ("-tcf", Arg.String
(fun s -> trimcachepath := s),
6355 "<path> Set path to the trim cache file");
6357 ("-dest", Arg.String
(fun s -> state
.nameddest
<- s),
6358 "<named-destination> Set named destination");
6360 ("-wtmode", Arg.Set
wtmode, " Operate in wt mode");
6361 ("-cxack", Arg.Set
cxack, " Cut corners");
6363 ("-remote", Arg.String
(fun s -> rcmdpath := s),
6364 "<path> Set path to the remote commands source");
6366 ("-origin", Arg.String
(fun s -> state
.origin
<- s),
6367 "<original-path> Set original path");
6369 ("-gc", Arg.Set_string
gcconfig,
6370 "<script-path> Collect garbage with the help of a script");
6372 ("-nofc", Arg.Set
nofc, " Do not use fontconfig");
6374 ("-v", Arg.Unit
(fun () ->
6376 "%s\nconfiguration path: %s\n"
6380 exit
0), " Print version and exit");
6382 ("-embed", Arg.Set_int
rootwid,
6383 "<window-id> Embed into window")
6386 (fun s -> state
.path <- s)
6387 ("Usage: " ^
Sys.argv
.(0) ^
" [options] some.pdf\nOptions:")
6390 then selfexec := !selfexec ^
" -wtmode";
6392 let histmode = emptystr state
.path && not
!openlast in
6394 if not
(Config.load !openlast)
6395 then dolog
"failed to load configuration";
6397 begin match !pageno with
6398 | Some
pageno -> state
.anchor <- (pageno, 0.0, 0.0)
6402 if nonemptystr
!gcconfig
6405 match Unix.socketpair
Unix.PF_UNIX
Unix.SOCK_STREAM
0 with
6406 | (exception exn
) -> error
"socketpair for gc failed: %s" @@ exntos exn
6409 match spawn
!gcconfig [(c, 0); (c, 1); (s, -1)] with
6410 | (exception exn
) -> error
"failed to execute gc script: %s" @@ exntos exn
6412 Ne.clo c @@ (fun s -> error
"failed to close gc fd %s" s);
6417 let wsfd, winw, winh
= Wsi.init
(object (self)
6418 val mutable m_clicks
= 0
6419 val mutable m_click_x
= 0
6420 val mutable m_click_y
= 0
6421 val mutable m_lastclicktime
= infinity
6423 method private cleanup =
6424 state
.roam
<- noroam
;
6425 Hashtbl.iter
(fun _ opaque -> clearmark
opaque) state
.pagemap
6426 method expose
= G.postRedisplay "expose"
6430 | Wsi.Unobscured
-> "unobscured"
6431 | Wsi.PartiallyObscured
-> "partiallyobscured"
6432 | Wsi.FullyObscured
-> "fullyobscured"
6434 vlog "visibility change %s" name
6435 method display = display ()
6436 method map mapped
= vlog "mapped %b" mapped
6437 method reshape w h =
6440 method mouse
b d x y m =
6441 if d && canselect ()
6443 (* http://blogs.msdn.com/b/oldnewthing/archive/2004/10/18/243925.aspx *)
6449 if abs
x - m_click_x
> 10
6450 || abs
y - m_click_y
> 10
6451 || abs_float
(t -. m_lastclicktime
) > 0.3
6453 m_clicks
<- m_clicks
+ 1;
6454 m_lastclicktime
<- t;
6458 G.postRedisplay "cleanup";
6459 state
.uioh <- state
.uioh#button
b d x y m;
6461 else state
.uioh <- state
.uioh#multiclick m_clicks
x y m
6466 m_lastclicktime
<- infinity
;
6467 state
.uioh <- state
.uioh#button
b d x y m
6471 state
.uioh <- state
.uioh#button
b d x y m
6474 state
.mpos
<- (x, y);
6475 state
.uioh <- state
.uioh#motion
x y
6476 method pmotion
x y =
6477 state
.mpos
<- (x, y);
6478 state
.uioh <- state
.uioh#pmotion
x y
6480 let mascm = m land (
6481 Wsi.altmask
+ Wsi.shiftmask
+ Wsi.ctrlmask
+ Wsi.metamask
6484 let x = state
.x and y = state
.y in
6486 if x != state
.x || y != state
.y then self#
cleanup
6488 match state
.keystate
with
6490 let km = k
, mascm in
6493 let modehash = state
.uioh#
modehash in
6494 try Hashtbl.find modehash km
6496 try Hashtbl.find (findkeyhash conf
"global") km
6497 with Not_found
-> KMinsrt
(k
, m)
6499 | KMinsrt
(k
, m) -> keyboard k
m
6500 | KMinsrl
l -> List.iter
(fun (k
, m) -> keyboard k
m) l
6501 | KMmulti
(l, r) -> state
.keystate
<- KSinto
(l, r)
6503 | KSinto
((k'
, m'
) :: [], insrt
) when k'
=k
&& m'
land mascm = m'
->
6504 List.iter
(fun (k
, m) -> keyboard k
m) insrt
;
6505 state
.keystate
<- KSnone
6506 | KSinto
((k'
, m'
) :: keys, insrt
) when k'
=k
&& m'
land mascm = m'
->
6507 state
.keystate
<- KSinto
(keys, insrt
)
6508 | KSinto
_ -> state
.keystate
<- KSnone
6511 state
.mpos
<- (x, y);
6512 state
.uioh <- state
.uioh#pmotion
x y
6513 method leave = state
.mpos
<- (-1, -1)
6514 method winstate wsl
= state
.winstate
<- wsl
6515 method quit
= raise Quit
6516 end) !rootwid conf
.cwinw conf
.cwinh platform
in
6518 setbgcol conf
.bgcolor
;
6522 List.exists
GlMisc.check_extension
6523 [ "GL_ARB_texture_rectangle"
6524 ; "GL_EXT_texture_recangle"
6525 ; "GL_NV_texture_rectangle" ]
6527 then (dolog
"OpenGL does not suppport rectangular textures"; exit
1);
6530 let r = GlMisc.get_string `renderer
in
6531 let p = "Mesa DRI Intel(" in
6532 let l = String.length
p in
6533 String.length
r > l && String.sub
r 0 l = p
6536 defconf
.sliceheight
<- 1024;
6537 defconf
.texcount
<- 32;
6538 defconf
.usepbo
<- true;
6542 match Unix.socketpair
Unix.PF_UNIX
Unix.SOCK_STREAM
0 with
6543 | (exception exn
) ->
6544 dolog
"socketpair failed: %s" @@ exntos exn
;
6552 setcheckers conf
.checkers
;
6554 opengl_has_pbo := GlMisc.check_extension
"GL_ARB_pixel_buffer_object";
6557 conf
.angle
, conf
.fitmodel
, (conf
.trimmargins
, conf
.trimfuzz
),
6558 conf
.texcount
, conf
.sliceheight
, conf
.mustoresize
, conf
.colorspace
,
6559 !Config.fontpath
, !trimcachepath,
6563 List.iter
GlArray.enable
[`texture_coord
; `vertex
];
6565 reshape ~firsttime
:true winw winh
;
6569 Wsi.settitle
"llpp (history)";
6573 state
.text <- "Opening " ^
(mbtoutf8 state
.path);
6574 opendoc state
.path state
.password;
6578 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
6579 Sys.set_signal
Sys.sighup
(Sys.Signal_handle
(fun _ -> reload ()));
6582 match Unix.waitpid
[Unix.WNOHANG
] ~
-1 with
6583 | (exception (Unix.Unix_error
(Unix.ECHILD
, _, _))) -> ()
6584 | (exception exn
) -> dolog
"Unix.waitpid: %s" @@ exntos exn
6586 | _pid
, _status
-> reap ()
6588 Sys.set_signal
Sys.sigchld
(Sys.Signal_handle
(fun _ -> doreap := true));
6592 if nonemptystr
!rcmdpath
6593 then remoteopen !rcmdpath
6598 let rec loop deadline
=
6604 let r = [state
.ss; state
.wsfd] in
6608 | Some fd
-> fd
:: r
6612 state
.redisplay
<- false;
6619 if deadline
= infinity
6621 else max
0.0 (deadline
-. now)
6626 try Unix.select
r [] [] timeout
6627 with Unix.Unix_error
(Unix.EINTR
, _, _) -> [], [], []
6633 if state
.ghyll
== noghyll
6635 match state
.autoscroll
with
6636 | Some step
when step
!= 0 ->
6637 let y = state
.y + step
in
6638 let fy = if conf
.maxhfit
then state
.winh
else 0 in
6641 then state
.maxy - fy
6642 else if y >= state
.maxy - fy then 0 else y
6644 if state
.mode = View
6645 then gotoxy_and_clear_text state
.x y
6646 else gotoxy state
.x y;
6649 else deadline
+. 0.01
6654 let rec checkfds = function
6656 | fd
:: rest
when fd
= state
.ss ->
6657 let cmd = rcmd state
.ss in
6661 | fd
:: rest
when fd
= state
.wsfd ->
6665 | fd
:: rest
when Some fd
= !optrfd ->
6666 begin match remote fd
with
6667 | None
-> optrfd := remoteopen !rcmdpath;
6668 | opt -> optrfd := opt
6673 dolog
"select returned unknown descriptor";
6679 if deadline
= infinity
6683 match state
.autoscroll
with
6684 | Some step
when step
!= 0 -> deadline1
6685 | _ -> if state
.ghyll
== noghyll
then infinity
else deadline1
6693 Config.save leavebirdseye;
6694 if hasunsavedchanges
()