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";;
54 let selfexec = ref E.s
;;
55 let opengl_has_pbo = ref false;;
57 let drawstring size x y s
=
59 Gl.enable `texture_2d
;
60 GlFunc.blend_func ~src
:`src_alpha ~dst
:`one_minus_src_alpha
;
61 ignore
(drawstr size x y s
);
63 Gl.disable `texture_2d
;
66 let drawstring1 size x y s
=
70 let drawstring2 size x y fmt
=
71 Printf.kprintf
(drawstring size
(x
+1) (y
+size
+1)) fmt
75 dolog
"l %d dim=%d {" l
.pageno l
.pagedimno
;
76 dolog
" WxH %dx%d" l
.pagew l
.pageh
;
77 dolog
" vWxH %dx%d" l
.pagevw l
.pagevh
;
78 dolog
" pagex,y %d,%d" l
.pagex l
.pagey
;
79 dolog
" dispx,y %d,%d" l
.pagedispx l
.pagedispy
;
80 dolog
" column %d" l
.pagecol
;
84 let debugrect (x0
, y0
, x1
, y1
, x2
, y2
, x3
, y3
) =
86 dolog
" x0,y0=(% f, % f)" x0 y0
;
87 dolog
" x1,y1=(% f, % f)" x1 y1
;
88 dolog
" x2,y2=(% f, % f)" x2 y2
;
89 dolog
" x3,y3=(% f, % f)" x3 y3
;
93 let isbirdseye = function
100 let istextentry = function
101 | Textentry _
-> true
107 let wtmode = ref false;;
108 let cxack = ref false;;
110 let pgscale h
= truncate
(float h
*. conf
.pgscale);;
113 if not state
.uioh#alwaysscrolly
&& (conf
.scrollb
land scrollbhv
= 0)
114 || (state
.x
= 0 && state
.w
<= state
.winw
- conf
.scrollbw
)
120 if not state
.uioh#alwaysscrolly
&& (conf
.scrollb
land scrollbvv
= 0)
128 else x
> state
.winw
- vscrollw ()
131 let wadjsb () = -vscrollw ();;
132 let xadjsb () = if conf
.leftscroll
then vscrollw () else 0;;
135 fstate
.fontsize
<- n
;
136 fstate
.wwidth
<- measurestr fstate
.fontsize
"w";
137 fstate
.maxrows
<- (state
.winh
- fstate
.fontsize
- 1) / (fstate
.fontsize
+ 1);
143 else Printf.kprintf ignore fmt
147 if emptystr conf
.pathlauncher
148 then dolog
"%s" state
.path
150 let command = Str.global_replace percentsre state
.path conf
.pathlauncher
in
151 match spawn
command [] with
154 dolog
"failed to execute `%s': %s" command @@ exntos exn
160 let postRedisplay who
=
161 vlog "redisplay for [%S]" who
;
162 state
.redisplay
<- true;
166 let getopaque pageno
=
167 try Some
(Hashtbl.find state
.pagemap
(pageno
, state
.gen
))
168 with Not_found
-> None
171 let pagetranslatepoint l x y
=
172 let dy = y
- l
.pagedispy
in
173 let y = dy + l
.pagey
in
174 let dx = x
- l
.pagedispx
in
175 let x = dx + l
.pagex
in
179 let onppundermouse g
x y d
=
182 begin match getopaque l
.pageno
with
184 let x0 = l
.pagedispx
in
185 let x1 = x0 + l
.pagevw
in
186 let y0 = l
.pagedispy
in
187 let y1 = y0 + l
.pagevh
in
188 if y >= y0 && y <= y1 && x >= x0 && x <= x1
190 let px, py
= pagetranslatepoint l
x y in
191 match g opaque l
px py
with
204 let g opaque l
px py
=
207 match rectofblock opaque
px py
with
208 | Some
[|x0;x1;y0;y1|] ->
209 let ox = xadjsb () |> float in
210 let rect = (x0+.ox, y0, x1+.ox, y0, x1+.ox, y1, x0+.ox, y1) in
211 let color = (0.0, 0.0, 1.0 /. (l
.pageno
mod 3 |> float), 0.5) in
212 state
.rects
<- [l
.pageno
, color, rect];
213 G.postRedisplay "getunder";
216 let under = whatsunder opaque
px py
in
217 if under = Unone
then None
else Some
under
219 onppundermouse g x y Unone
224 match unproject opaque
x y with
225 | Some
(x, y) -> Some
(Some
(opaque
, l
.pageno
, x, y))
228 onppundermouse g x y None
;
232 state
.text
<- Printf.sprintf
"%c%s" c s
;
233 G.postRedisplay "showtext";
237 Format.ksprintf
(fun s
-> showtext '
!' s
) fmt
;
240 let pipesel opaque cmd
=
243 match Unix.pipe
() with
244 | (exception exn
) -> dolog
"pipesel cannot create pipe: %S" @@ exntos exn
;
246 let doclose what fd
=
247 Ne.clo fd
(fun msg
-> dolog
"%s close failed: %s" what msg
)
250 try spawn cmd
[r
, 0; w
, -1]
252 dolog
"cannot execute %S: %s" cmd
@@ exntos exn
;
258 G.postRedisplay "pipesel";
260 else doclose "pipesel pipe/w" w
;
261 doclose "pipesel pipe/r" r
;
265 let g opaque l
px py
=
266 if markunder opaque
px py conf
.paxmark
269 match getopaque l
.pageno
with
271 | Some opaque
-> pipesel opaque conf
.paxcmd
276 G.postRedisplay "paxunder";
277 if conf
.paxmark
= Mark_page
280 match getopaque l
.pageno
with
282 | Some opaque
-> clearmark opaque
) state
.layout
;
283 state
.roam
<- onppundermouse g x y (fun () -> impmsg "whoopsie daisy");
287 match Unix.pipe
() with
288 | (exception exn
) -> impmsg "pipe failed: %s" @@ exntos exn
291 Ne.clo fd
(fun msg
-> impmsg "failed to close %s: %s" cap msg
)
294 try spawn conf
.selcmd
[r
, 0; w
, -1]
296 impmsg "failed to execute %s: %s" conf
.selcmd
@@ exntos exn
;
302 let l = String.length s
in
303 let bytes = Bytes.unsafe_of_string s
in
304 let n = tempfailureretry
(Unix.write w
bytes 0) l in
306 then impmsg "failed to write %d characters to sel pipe, wrote %d"
309 impmsg "failed to write to sel pipe: %s" @@ exntos exn
312 clo "selstring pipe/r" r
;
313 clo "selstring pipe/w" w
;
316 let undertext ?
(nopath
=false) = function
319 | Ulinkgoto
(pageno
, _
) ->
321 then "page " ^ string_of_int
(pageno
+1)
322 else Printf.sprintf
"%s: page %d" state
.path
(pageno
+1)
323 | Utext s
-> "font: " ^ s
324 | Uunexpected s
-> "unexpected: " ^ s
325 | Ulaunch s
-> "launch: " ^ s
326 | Unamed s
-> "named: " ^ s
327 | Uremote
(filename
, pageno
) ->
328 Printf.sprintf
"%s: page %d" filename
(pageno
+1)
329 | Uremotedest
(filename
, destname
) ->
330 Printf.sprintf
"%s: destination %S" filename destname
331 | Uannotation
(opaque
, slinkindex
) ->
332 "annotation: " ^ getannotcontents opaque slinkindex
335 let updateunder x y =
336 match getunder x y with
337 | Unone
-> Wsi.setcursor
Wsi.CURSOR_INHERIT
339 if conf
.underinfo
then showtext 'u'
("ri: " ^ uri
);
340 Wsi.setcursor
Wsi.CURSOR_INFO
341 | Ulinkgoto
(pageno
, _
) ->
343 then showtext 'p'
("age: " ^ string_of_int
(pageno
+1));
344 Wsi.setcursor
Wsi.CURSOR_INFO
346 if conf
.underinfo
then showtext '
f'
("ont: " ^ s
);
347 Wsi.setcursor
Wsi.CURSOR_TEXT
349 if conf
.underinfo
then showtext 'u'
("nexpected: " ^ s
);
350 Wsi.setcursor
Wsi.CURSOR_INHERIT
352 if conf
.underinfo
then showtext '
l'
("aunch: " ^ s
);
353 Wsi.setcursor
Wsi.CURSOR_INHERIT
355 if conf
.underinfo
then showtext '
n'
("amed: " ^ s
);
356 Wsi.setcursor
Wsi.CURSOR_INHERIT
357 | Uremote
(filename
, pageno
) ->
358 if conf
.underinfo
then showtext 'r'
359 (Printf.sprintf
"emote: %s (%d)" filename
(pageno
+1));
360 Wsi.setcursor
Wsi.CURSOR_INFO
361 | Uremotedest
(filename
, destname
) ->
362 if conf
.underinfo
then showtext 'r'
363 (Printf.sprintf
"emote destination: %s (%S)" filename destname
);
364 Wsi.setcursor
Wsi.CURSOR_INFO
366 if conf
.underinfo
then showtext 'a'
"nnotation";
367 Wsi.setcursor
Wsi.CURSOR_INFO
370 let showlinktype under =
371 if conf
.underinfo
&& under != Unone
372 then showtext ' '
@@ undertext under
375 let intentry_with_suffix text key
=
377 if key
>= 32 && key
< 127
379 let c = Char.chr key
in
384 | 'k'
| 'm'
| '
g'
| 'K'
| 'M'
| 'G'
->
385 addchar
text @@ asciilower
c
387 state
.text <- Printf.sprintf
"invalid key (%d, `%c')" key
c;
390 state
.text <- Printf.sprintf
"invalid key %d" key
;
398 let b = Buffer.create
16 in
399 Buffer.add_string
b "llll";
402 let b = Buffer.to_bytes
b in
403 wcmd state
.ss
b @@ Bytes.length
b
407 let nogeomcmds cmds
=
409 | s
, [] -> emptystr s
413 let layoutN ((columns
, coverA
, coverB
), b) x y sw sh
=
414 let sh = sh - (hscrollh ()) in
415 let wadj = wadjsb () in
416 let rec fold accu
n =
417 if n = Array.length
b
420 let pdimno, dx, vy
, (_
, w
, h
, xoff
) = b.(n) in
423 || n = state
.pagecount
- coverB
424 || (n - coverA
) mod columns
= columns
- 1)
430 let pagey = max
0 (y - vy
) in
431 let pagedispy = if pagey > 0 then 0 else vy
- y in
432 let pagedispx, pagex
=
434 if n = coverA
- 1 || n = state
.pagecount
- coverB
435 then x + (wadj + sw
- w
) / 2
443 let vw = wadj + sw
- pagedispx in
444 let pw = w
- pagex
in
447 let pagevh = min
(h
- pagey) (sh - pagedispy) in
448 if pagevw > 0 && pagevh > 0
459 ; pagedispx = pagedispx
460 ; pagedispy = pagedispy
472 if Array.length
b = 0
474 else List.rev
(fold [] (page_of_y
y))
477 let layoutS (columns
, b) x y sw
sh =
478 let sh = sh - hscrollh () in
479 let wadj = wadjsb () in
480 let rec fold accu n =
481 if n = Array.length
b
484 let pdimno, px, vy
, (_
, pagew
, pageh
, xoff
) = b.(n) in
492 let pagey = max
0 (y - vy
) in
493 let pagedispy = if pagey > 0 then 0 else vy
- y in
494 let pagedispx, pagex
=
508 let pagecolw = pagew
/columns
in
511 then pagedispx + ((wadj + sw
- pagecolw) / 2)
515 let vw = wadj + sw
- pagedispx in
516 let pw = pagew
- pagex
in
519 let pagevw = min
pagevw pagecolw in
520 let pagevh = min
(pageh
- pagey) (sh - pagedispy) in
521 if pagevw > 0 && pagevh > 0
532 ; pagedispx = pagedispx
533 ; pagedispy = pagedispy
534 ; pagecol
= n mod columns
548 let layout x y sw
sh =
549 if nogeomcmds state
.geomcmds
551 match conf
.columns
with
552 | Csingle
b -> layoutN ((1, 0, 0), b) x y sw
sh
553 | Cmulti
c -> layoutN c x y sw
sh
554 | Csplit s
-> layoutS s
x y sw
sh
559 let y = state
.y + incr
in
561 let y = min
y (state
.maxy
- (if conf
.maxhfit
then state
.winh
else 0)) in
566 let tilex = l.pagex
mod conf
.tilew
in
567 let tiley = l.pagey mod conf
.tileh
in
569 let col = l.pagex
/ conf
.tilew
in
570 let row = l.pagey / conf
.tileh
in
572 let xadj = xadjsb () in
573 let rec rowloop row y0 dispy h
=
577 let dh = conf
.tileh
- y0 in
579 let rec colloop col x0 dispx w
=
583 let dw = conf
.tilew
- x0 in
585 let dispx'
= xadj + dispx in
586 f col row dispx' dispy
x0 y0 dw dh;
587 colloop (col+1) 0 (dispx+dw) (w
-dw)
590 colloop col tilex l.pagedispx l.pagevw;
591 rowloop (row+1) 0 (dispy
+dh) (h
-dh)
594 if l.pagevw > 0 && l.pagevh > 0
595 then rowloop row tiley l.pagedispy l.pagevh;
598 let gettileopaque l col row =
600 l.pageno
, state
.gen
, conf
.colorspace
, conf
.angle
, l.pagew
, l.pageh
, col, row
602 try Some
(Hashtbl.find state
.tilemap
key)
603 with Not_found
-> None
606 let puttileopaque l col row gen colorspace angle opaque size elapsed
=
607 let key = l.pageno
, gen
, colorspace
, angle
, l.pagew
, l.pageh
, col, row in
608 Hashtbl.add state
.tilemap
key (opaque
, size
, elapsed
)
611 let filledrect2 x0 y0 x1 y1 x2 y2 x3 y3
=
612 Raw.sets_float state
.vraw ~pos
:0 [| x0; y0; x1; y1; x2
; y2
; x3
; y3
|];
613 GlArray.vertex `two state
.vraw
;
614 GlArray.draw_arrays `triangle_strip ~first
:0 ~count
:4;
617 let filledrect1 x0 y0 x1 y1 = filledrect2 x0 y0 x0 y1 x1 y0 x1 y1;;
619 let filledrect x0 y0 x1 y1 =
620 GlArray.disable `texture_coord
;
621 filledrect1 x0 y0 x1 y1;
622 GlArray.enable `texture_coord
;
625 let linerect x0 y0 x1 y1 =
626 GlArray.disable `texture_coord
;
627 Raw.sets_float state
.vraw ~pos
:0 [| x0; y0; x0; y1; x1; y1; x1; y0 |];
628 GlArray.vertex `two state
.vraw
;
629 GlArray.draw_arrays `line_loop ~first
:0 ~count
:4;
630 GlArray.enable `texture_coord
;
633 let drawtiles l color =
635 let wadj = wadjsb () in
637 let f col row x y tilex tiley w h
=
638 match gettileopaque l col row with
639 | Some
(opaque
, _
, t
) ->
640 let params = x, y, w
, h
, tilex, tiley in
642 then GlTex.env
(`mode `blend
);
643 drawtile
params opaque
;
645 then GlTex.env
(`mode `modulate
);
649 let s = Printf.sprintf
653 let w = measurestr fstate
.fontsize
s in
654 GlDraw.color (0.0, 0.0, 0.0);
655 filledrect (float (x-2))
658 (float (y + fstate
.fontsize
+ 2));
660 drawstring fstate
.fontsize
x (y + fstate
.fontsize
- 1) s;
670 let lw = wadj + state
.winw
- x in
673 let lh = state
.winh
- y in
677 then GlTex.env
(`mode `blend
);
678 begin match state
.checkerstexid
with
680 Gl.enable `texture_2d
;
681 GlTex.bind_texture ~target
:`texture_2d id
;
685 and y1 = float (y+h
) in
687 let tw = float w /. 16.0
688 and th
= float h
/. 16.0 in
689 let tx0 = float tilex /. 16.0
690 and ty0
= float tiley /. 16.0 in
692 and ty1
= ty0
+. th
in
693 Raw.sets_float state
.vraw ~pos
:0
694 [| x0; y0; x0; y1; x1; y0; x1; y1 |];
695 Raw.sets_float state
.traw ~pos
:0
696 [| tx0; ty0
; tx0; ty1
; tx1; ty0
; tx1; ty1
|];
697 GlArray.vertex `two state
.vraw
;
698 GlArray.tex_coord `two state
.traw
;
699 GlArray.draw_arrays `triangle_strip ~first
:0 ~count
:4;
700 Gl.disable `texture_2d
;
703 GlDraw.color (1.0, 1.0, 1.0);
704 filledrect (float x) (float y) (float (x+w)) (float (y+h
));
707 then GlTex.env
(`mode `modulate
);
708 if w > 128 && h
> fstate
.fontsize
+ 10
710 let c = if conf
.invert
then 1.0 else 0.0 in
711 GlDraw.color (c, c, c);
714 then (col*conf
.tilew
, row*conf
.tileh
)
717 drawstring2 fstate
.fontsize
x y "Loading %d [%d,%d]" l.pageno
c r
;
726 let pagevisible layout n = List.exists
(fun l -> l.pageno
= n) layout;;
728 let tilevisible1 l x y =
730 and ax1
= l.pagex
+ l.pagevw
732 and ay1
= l.pagey + l.pagevh in
736 let bx1 = min
(bx0 + conf
.tilew
) l.pagew
737 and by1
= min
(by0
+ conf
.tileh
) l.pageh
in
739 let rx0 = max
ax0 bx0
740 and ry0
= max ay0 by0
741 and rx1
= min ax1
bx1
742 and ry1
= min ay1 by1
in
744 let nonemptyintersection = rx1
> rx0 && ry1
> ry0
in
748 let tilevisible layout n x y =
749 let rec findpageinlayout m
= function
750 | l :: rest
when l.pageno
= n ->
751 tilevisible1 l x y || (
752 match conf
.columns
with
753 | Csplit
(c, _
) when c > m
-> findpageinlayout (m
+1) rest
758 | _
:: rest
-> findpageinlayout 0 rest
761 findpageinlayout 0 layout;
764 let tileready l x y =
765 tilevisible1 l x y &&
766 gettileopaque l (x/conf
.tilew
) (y/conf
.tileh
) != None
769 let tilepage n p
layout =
770 let rec loop = function
774 let f col row _ _ _ _ _ _
=
775 if state
.currently
= Idle
777 match gettileopaque l col row with
780 let x = col*conf
.tilew
781 and y = row*conf
.tileh
in
783 let w = l.pagew
- x in
787 let h = l.pageh
- y in
792 then getpbo
w h conf
.colorspace
795 wcmd "tile %s %d %d %d %d %s"
796 (~
> p
) x y w h (~
> pbo);
799 l, p
, conf
.colorspace
, conf
.angle
,
800 state
.gen
, col, row, conf
.tilew
, conf
.tileh
809 if nogeomcmds state
.geomcmds
813 let preloadlayout x y sw
sh =
814 let y = if y < sh then 0 else y - sh in
815 let x = min
0 (x + sw
) in
823 if state
.currently
!= Idle
828 begin match getopaque l.pageno
with
830 wcmd "page %d %d" l.pageno
l.pagedimno
;
831 state
.currently
<- Loading
(l, state
.gen
);
833 tilepage l.pageno opaque pages
;
838 if nogeomcmds state
.geomcmds
844 if conf
.preload && state
.currently
= Idle
845 then load (preloadlayout state
.x state
.y state
.winw state
.winh
);
848 let layoutready layout =
849 let rec fold all ls
=
852 let seen = ref false in
853 let allvisible = ref true in
854 let foo col row _ _ _ _ _ _
=
856 allvisible := !allvisible &&
857 begin match gettileopaque l col row with
863 fold (!seen && !allvisible) rest
866 let alltilesvisible = fold true layout in
871 let y = bound
y 0 state
.maxy
in
872 let y, layout, proceed
=
873 match conf
.maxwait
with
874 | Some time
when state
.ghyll
== noghyll
->
875 begin match state
.throttle
with
877 let layout = layout x y state
.winw state
.winh
in
878 let ready = layoutready layout in
882 state
.throttle
<- Some
(layout, y, now
());
884 else G.postRedisplay "gotoxy showall (None)";
886 | Some
(_
, _
, started
) ->
887 let dt = now
() -. started
in
890 state
.throttle
<- None
;
891 let layout = layout x y state
.winw state
.winh
in
893 G.postRedisplay "maxwait";
900 let layout = layout x y state
.winw state
.winh
in
901 if not
!wtmode || layoutready layout
902 then G.postRedisplay "gotoxy ready";
909 state
.layout <- layout;
910 begin match state
.mode
with
913 | Ltexact
(pageno
, linkno
) ->
914 let rec loop = function
916 state
.mode
<- LinkNav
(Ltgendir
0)
917 | l :: _
when l.pageno
= pageno
->
918 begin match getopaque pageno
with
919 | None
-> state
.mode
<- LinkNav
(Ltnotready
(pageno
, 0))
921 let x0, y0, x1, y1 = getlinkrect opaque linkno
in
922 if not
(x0 >= l.pagex
&& x1 <= l.pagex
+ l.pagevw
923 && y0 >= l.pagey && y1 <= l.pagey + l.pagevh)
924 then state
.mode
<- LinkNav
(Ltgendir
0)
926 | _
:: rest
-> loop rest
929 | Ltnotready _
| Ltgendir _
-> ()
935 begin match state
.mode
with
936 | Birdseye
(conf
, leftx
, pageno
, hooverpageno
, anchor
) ->
937 if not
(pagevisible layout pageno
)
939 match state
.layout with
942 state
.mode
<- Birdseye
(
943 conf
, leftx
, l.pageno
, hooverpageno
, anchor
948 | Ltnotready
(_
, dir
)
951 let rec loop = function
954 match getopaque l.pageno
with
955 | None
-> Ltnotready
(l.pageno
, dir
)
960 then LDfirstvisible
(l.pagex
, l.pagey, dir
)
962 if dir
> 0 then LDfirst
else LDlast
968 | Lnotfound
-> loop rest
970 showlinktype (getlink opaque
n);
971 Ltexact
(l.pageno
, n)
975 state
.mode
<- LinkNav
linknav
983 state
.ghyll
<- noghyll
;
986 let mx, my
= state
.mpos
in
991 let conttiling pageno opaque
=
992 tilepage pageno opaque
994 then preloadlayout state
.x state
.y state
.winw state
.winh
998 let gotoxy_and_clear_text x y =
999 if not conf
.verbose
then state
.text <- E.s;
1003 let getanchory (n, top
, dtop
) =
1004 let y, h = getpageyh
n in
1005 if conf
.presentation
1007 let ips = calcips
h in
1008 y + truncate
(top
*.float h -. dtop
*.float ips) + ips;
1010 y + truncate
(top
*.float h -. dtop
*.float conf
.interpagespace
)
1013 let gotoanchor anchor
=
1014 gotoxy state
.x (getanchory anchor
);
1018 cbput state
.hists
.nav
(getanchor
());
1022 let anchor = cbgetc state
.hists
.nav dir
in
1026 let gotoghyll1 single
y =
1027 let scroll f n a
b =
1028 (* http://devmaster.net/forums/topic/9796-ease-in-ease-out-algorithm/ *)
1030 let s x = 3.0*.x**2.0 -. 2.0*.x**3.0 in
1032 then s (float f /. float a
)
1035 then 1.0 -. s ((float (f-b) /. float (n-b)))
1041 let ins = float a
*. 0.5
1042 and outs
= float (n-b) *. 0.5 in
1044 ins +. outs
+. float ones
1046 let rec set nab
y sy
=
1047 let (_N
, _A
, _B
), y =
1050 let scl = if y > sy
then 2 else -2 in
1051 let _N, _
, _
= nab
in
1052 (_N,0,_N), y+conf
.scrollstep
*scl
1054 let sum = summa
_N _A _B
in
1055 let dy = float (y - sy
) in
1059 then state
.ghyll
<- noghyll
1062 let s = scroll n _N _A _B
in
1063 let y1 = y1 +. ((s *. dy) /. sum) in
1064 gotoxy_and_clear_text state
.x (truncate
y1);
1065 state
.ghyll
<- gf (n+1) y1;
1069 | Some
y'
when single
-> set nab
y' state
.y
1070 | Some
y'
-> set (_N/2, 1, 1) y' state
.y
1072 gf 0 (float state
.y)
1075 match conf
.ghyllscroll
with
1076 | Some nab
when not conf
.presentation
->
1077 if state
.ghyll
== noghyll
1078 then set nab
y state
.y
1079 else state
.ghyll
(Some
y)
1081 gotoxy_and_clear_text state
.x y
1084 let gotoghyll = gotoghyll1 false;;
1086 let gotopage n top
=
1087 let y, h = getpageyh
n in
1088 let y = y + (truncate
(top
*. float h)) in
1092 let gotopage1 n top
=
1093 let y = getpagey
n in
1098 let invalidate s f =
1099 state
.redisplay
<- false;
1104 match state
.geomcmds
with
1105 | ps
, [] when emptystr ps
->
1107 state
.geomcmds
<- s, [];
1110 state
.geomcmds
<- ps
, [s, f];
1112 | ps
, (s'
, _
) :: rest
when s'
= s ->
1113 state
.geomcmds
<- ps
, ((s, f) :: rest
);
1116 state
.geomcmds
<- ps
, ((s, f) :: cmds
);
1120 Hashtbl.iter
(fun _ opaque
->
1121 wcmd "freepage %s" (~
> opaque
);
1123 Hashtbl.clear state
.pagemap
;
1127 if not
(Queue.is_empty state
.tilelru
)
1129 Queue.iter
(fun (k
, p
, s) ->
1130 wcmd "freetile %s" (~
> p
);
1131 state
.memused
<- state
.memused
- s;
1132 Hashtbl.remove state
.tilemap k
;
1134 state
.uioh#infochanged Memused
;
1135 Queue.clear state
.tilelru
;
1141 let h = truncate
(float h*.conf
.zoom
) in
1142 let d = conf
.interpagespace
lsl (if conf
.presentation
then 1 else 0) in
1146 let opendoc path password
=
1148 state
.password
<- password
;
1149 state
.gen
<- state
.gen
+ 1;
1150 state
.docinfo
<- [];
1151 state
.outlines
<- [||];
1154 setaalevel conf
.aalevel
;
1156 if emptystr state
.origin
1160 Wsi.settitle
("llpp " ^
(mbtoutf8
(Filename.basename
titlepath)));
1161 wcmd "open %d %d %s\000%s\000" (btod
!wtmode) (btod
!cxack) path password
;
1162 invalidate "reqlayout"
1164 wcmd "reqlayout %d %d %d %s\000"
1165 conf
.angle
(FMTE.to_int conf
.fitmodel
)
1166 (stateh state
.winh
) state
.nameddest
1171 state
.anchor <- getanchor
();
1172 opendoc state
.path state
.password
;
1176 let c = c *. conf
.colorscale
in
1180 let scalecolor2 (r
, g, b) =
1181 (r
*. conf
.colorscale
, g *. conf
.colorscale
, b *. conf
.colorscale
);
1184 let docolumns columns
=
1185 let wadj = wadjsb () in
1188 let a = Array.make state
.pagecount
(-1, -1, -1, (-1, -1, -1, -1)) in
1189 let wadj = wadjsb () in
1190 let rec loop pageno
pdimno pdim
y ph pdims
=
1191 if pageno
= state
.pagecount
1194 let pdimno, ((_
, w, h, xoff
) as pdim
), pdims
=
1196 | ((pageno'
, _
, _
, _
) as pdim
) :: rest
when pageno'
= pageno
->
1197 pdimno+1, pdim
, rest
1201 let x = max
0 (((wadj + state
.winw
- w) / 2) - xoff
) in
1203 (if conf
.presentation
1204 then (if pageno
= 0 then calcips
h else calcips ph
+ calcips
h)
1205 else (if pageno
= 0 then 0 else conf
.interpagespace
)
1208 a.(pageno
) <- (pdimno, x, y, pdim
);
1209 loop (pageno
+1) pdimno pdim
(y + h) h pdims
1211 loop 0 ~
-1 (-1,-1,-1,-1) 0 0 state
.pdims
;
1212 conf
.columns
<- Csingle
a;
1214 | Cmulti
((columns
, coverA
, coverB
), _
) ->
1215 let a = Array.make state
.pagecount
(-1, -1, -1, (-1, -1, -1, -1)) in
1216 let rec loop pageno
pdimno pdim
x y rowh pdims
=
1217 let rec fixrow m
= if m
= pageno
then () else
1218 let (pdimno, x, y, ((_
, _
, h, _
) as pdim
)) = a.(m
) in
1221 let y = y + (rowh
- h) / 2 in
1222 a.(m
) <- (pdimno, x, y, pdim
);
1226 if pageno
= state
.pagecount
1227 then fixrow (((pageno
- 1) / columns
) * columns
)
1229 let pdimno, ((_
, w, h, xoff
) as pdim
), pdims
=
1231 | ((pageno'
, _
, _
, _
) as pdim
) :: rest
when pageno'
= pageno
->
1232 pdimno+1, pdim
, rest
1237 if pageno
= coverA
- 1 || pageno
= state
.pagecount
- coverB
1239 let x = (wadj + state
.winw
- w) / 2 in
1241 if conf
.presentation
then calcips
h else conf
.interpagespace
in
1242 x, y + ips + rowh
, h
1245 if (pageno
- coverA
) mod columns
= 0
1247 let x = max
0 (wadj + state
.winw
- state
.w) / 2 in
1249 if conf
.presentation
1251 let ips = calcips
h in
1252 y + (if pageno
= 0 then 0 else calcips rowh
+ ips)
1254 y + (if pageno
= 0 then 0 else conf
.interpagespace
)
1258 else x, y, max rowh
h
1262 if pageno
> 1 && (pageno
- coverA
) mod columns
= 0
1265 if pageno
= columns
&& conf
.presentation
1267 let ips = calcips rowh
in
1268 for i
= 0 to pred columns
1270 let (pdimno, x, y, pdim
) = a.(i
) in
1271 a.(i
) <- (pdimno, x, y+ips, pdim
)
1277 fixrow (pageno
- columns
);
1282 a.(pageno
) <- (pdimno, x, y, pdim
);
1283 let x = x + w + xoff
*2 + conf
.interpagespace
in
1284 loop (pageno
+1) pdimno pdim
x y rowh' pdims
1286 loop 0 ~
-1 (-1,-1,-1,-1) 0 0 0 state
.pdims
;
1287 conf
.columns
<- Cmulti
((columns
, coverA
, coverB
), a);
1290 let a = Array.make
(state
.pagecount
*c) (-1, -1, -1, (-1, -1, -1, -1)) in
1291 let rec loop pageno
pdimno pdim
y pdims
=
1292 if pageno
= state
.pagecount
1295 let pdimno, ((_
, w, h, _
) as pdim
), pdims
=
1297 | ((pageno'
, _
, _
, _
) as pdim
) :: rest
when pageno'
= pageno
->
1298 pdimno+1, pdim
, rest
1303 let rec loop1 n x y =
1304 if n = c then y else (
1305 a.(pageno
*c + n) <- (pdimno, x, y, pdim
);
1306 loop1 (n+1) (x+cw) (y + h + conf
.interpagespace
)
1309 let y = loop1 0 0 y in
1310 loop (pageno
+1) pdimno pdim
y pdims
1312 loop 0 ~
-1 (-1,-1,-1,-1) 0 state
.pdims
;
1313 conf
.columns
<- Csplit
(c, a);
1317 docolumns conf
.columns
;
1318 state
.maxy
<- calcheight
();
1319 if state
.reprf
== noreprf
1321 match state
.mode
with
1322 | Birdseye
(_
, _
, pageno
, _
, _
) ->
1323 let y, h = getpageyh pageno
in
1324 let top = (state
.winh
- h) / 2 in
1325 gotoxy state
.x (max
0 (y - top))
1329 let y = getanchory state
.anchor in
1330 let y = min
y (state
.maxy
- state
.winh
- hscrollh ()) in
1335 state
.reprf
<- noreprf
;
1339 let reshape ?
(firsttime
=false) w h =
1340 GlDraw.viewport ~
x:0 ~
y:0 ~
w:w ~
h:h;
1341 if not firsttime
&& nogeomcmds state
.geomcmds
1342 then state
.anchor <- getanchor
();
1345 let w = wadjsb () + (truncate
(float w *. conf
.zoom
)) in
1348 setfontsize fstate
.fontsize
;
1349 GlMat.mode `modelview
;
1350 GlMat.load_identity
();
1352 GlMat.mode `projection
;
1353 GlMat.load_identity
();
1354 GlMat.rotate ~
x:1.0 ~angle
:180.0 ();
1355 GlMat.translate ~
x:~
-.1.0 ~
y:~
-.1.0 ();
1356 GlMat.scale3
(2.0 /. float state
.winw
, 2.0 /. float state
.winh
, 1.0);
1361 else float state
.x /. float state
.w
1363 invalidate "geometry"
1367 then state
.x <- truncate
(relx *. float w);
1369 match conf
.columns
with
1371 | Cmulti
((c, _
, _
), _
) -> (w - (c-1)*conf
.interpagespace
) / c
1372 | Csplit
(c, _
) -> w * c
1374 wcmd "geometry %d %d %d"
1375 w (stateh h) (FMTE.to_int conf
.fitmodel
)
1380 let len = String.length state
.text in
1381 let x0 = xadjsb () in
1384 match state
.mode
with
1385 | Textentry _
| View
| LinkNav _
->
1386 let h, _
, _
= state
.uioh#scrollpw
in
1391 filledrect x (float (state
.winh
- (fstate
.fontsize
+ 4) - hscrollh))
1392 (x+.w) (float (state
.winh
- hscrollh))
1395 let w = float (wadjsb () + state
.winw
- 1) in
1396 if state
.progress
>= 0.0 && state
.progress
< 1.0
1398 GlDraw.color (0.3, 0.3, 0.3);
1399 let w1 = w *. state
.progress
in
1401 GlDraw.color (0.0, 0.0, 0.0);
1402 rect (float x0+.w1) (float x0+.w-.w1)
1405 GlDraw.color (0.0, 0.0, 0.0);
1409 GlDraw.color (1.0, 1.0, 1.0);
1410 drawstring fstate
.fontsize
1411 (if conf
.leftscroll
then x0 + 2 else x0 + if len > 0 then 8 else 2)
1412 (state
.winh
- hscrollh - 5) s;
1415 match state
.mode
with
1416 | Textentry
((prefix
, text, _
, _
, _
, _
), _
) ->
1420 Printf.sprintf
"%s%s_ [%s]" prefix
text state
.text
1422 Printf.sprintf
"%s%s_" prefix
text
1428 | LinkNav _
-> state
.text
1433 if not
(istextentry state
.mode
) && state
.uioh#eformsgs
1435 let s1 = "(press 'e' to review error messasges)" in
1436 if nonemptystr
s then s ^
" " ^
s1 else s1
1446 let len = Queue.length state
.tilelru
in
1448 match state
.throttle
with
1451 then preloadlayout state
.x state
.y state
.winw state
.winh
1453 | Some
(layout, _
, _
) ->
1457 if state
.memused
<= conf
.memlimit
1462 let (k
, p
, s) as lruitem
= Queue.pop state
.tilelru
in
1463 let n, gen
, colorspace
, angle
, pagew
, pageh
, col, row = k
in
1464 let (_
, pw, ph
, _
) = getpagedim
n in
1467 && colorspace
= conf
.colorspace
1468 && angle
= conf
.angle
1472 let x = col*conf
.tilew
1473 and y = row*conf
.tileh
in
1474 tilevisible (Lazy.force_val
layout) n x y
1476 then Queue.push lruitem state
.tilelru
1479 wcmd "freetile %s" (~
> p
);
1480 state
.memused
<- state
.memused
- s;
1481 state
.uioh#infochanged Memused
;
1482 Hashtbl.remove state
.tilemap k
;
1490 let onpagerect pageno
f =
1492 match conf
.columns
with
1493 | Cmulti
(_
, b) -> b
1495 | Csplit
(_
, b) -> b
1497 if pageno
>= 0 && pageno
< Array.length
b
1499 let (_
, _
, _
, (_
, w, h, _
)) = b.(pageno
) in
1503 let gotopagexy1 wtmode pageno
x y =
1504 let _,w1,h1
,leftx
= getpagedim pageno
in
1505 let top = y /. (float h1
) in
1506 let left = x /. (float w1) in
1507 let py, w, h = getpageywh pageno
in
1508 let wh = state
.winh
- hscrollh () in
1509 let x = left *. (float w) in
1510 let x = leftx
+ state
.x + truncate
x in
1511 let wadj = wadjsb () in
1513 if x < 0 || x >= wadj + state
.winw
1517 let pdy = truncate
(top *. float h) in
1518 let y'
= py + pdy in
1519 let dy = y'
- state
.y in
1521 if x != state
.x || not
(dy > 0 && dy < wh)
1523 if conf
.presentation
1525 if abs
(py - y'
) > wh
1532 if state
.x != sx || state
.y != sy
1537 let ww = wadj + state
.winw
in
1539 and qy
= pdy / wh in
1541 and y = py + qy
* wh in
1542 let x = if -x + ww > w1 then -(w1-ww) else x
1543 and y'
= if y + wh > state
.maxy
then state
.maxy
- wh else y in
1545 if conf
.presentation
1547 if abs
(py - y'
) > wh
1556 gotoxy_and_clear_text x y;
1558 else gotoxy_and_clear_text state
.x state
.y;
1561 let gotopagexy wtmode pageno
x y =
1562 match state
.mode
with
1563 | Birdseye
_ -> gotopage pageno
0.0
1566 | LinkNav
_ -> gotopagexy1 wtmode pageno
x y
1569 let getpassword () =
1570 let passcmd = getenvwithdef
"LLPP_ASKPASS" conf
.passcmd in
1575 impmsg "error getting password: %s" s;
1576 dolog
"%s" s) passcmd;
1579 let pgoto opaque pageno
x y =
1580 let pdimno = getpdimno pageno
in
1581 let x, y = project opaque pageno
pdimno x y in
1582 gotopagexy false pageno
x y;
1586 (* dolog "%S" cmds; *)
1587 let spl = splitatspace cmds
in
1589 try Scanf.sscanf
s fmt
f
1591 dolog
"error processing '%S': %s" cmds
@@ exntos exn
;
1594 let addoutline outline
=
1595 match state
.currently
with
1596 | Outlining outlines
->
1597 state
.currently
<- Outlining
(outline
:: outlines
)
1598 | Idle
-> state
.currently
<- Outlining
[outline
]
1601 dolog
"invalid outlining state";
1602 logcurrently state
.currently
1606 state
.uioh#infochanged Pdim
;
1609 | "clearrects", "" ->
1610 state
.rects
<- state
.rects1
;
1611 G.postRedisplay "clearrects";
1613 | "continue", args
->
1614 let n = scan args
"%u" (fun n -> n) in
1615 state
.pagecount
<- n;
1616 begin match state
.currently
with
1618 state
.currently
<- Idle
;
1619 state
.outlines
<- Array.of_list
(List.rev
l)
1625 let cur, cmds
= state
.geomcmds
in
1627 then failwith
"umpossible";
1629 begin match List.rev cmds
with
1631 state
.geomcmds
<- E.s, [];
1632 state
.throttle
<- None
;
1636 state
.geomcmds
<- s, List.rev rest
;
1638 if conf
.maxwait
= None
&& not
!wtmode
1639 then G.postRedisplay "continue";
1646 then showtext ' ' args
1649 Buffer.add_string state
.errmsgs args
;
1650 state
.newerrmsgs
<- true;
1651 G.postRedisplay "error message"
1653 | "progress", args
->
1654 let progress, text =
1657 f, String.sub args pos
(String.length args
- pos
))
1660 state
.progress <- progress;
1661 G.postRedisplay "progress"
1663 | "firstmatch", args
->
1664 let pageno, c, x0, y0, x1, y1, x2
, y2
, x3
, y3
=
1665 scan args
"%u %d %f %f %f %f %f %f %f %f"
1666 (fun p
c x0 y0 x1 y1 x2 y2 x3 y3
->
1667 (p
, c, x0, y0, x1, y1, x2
, y2
, x3
, y3
))
1669 let xoff = float (xadjsb ()) in
1673 and x3
= x3
+. xoff in
1674 let y = (getpagey
pageno) + truncate
y0 in
1677 then truncate
(xoff -. x0) + state
.winw
/2
1682 let color = (0.0, 0.0, 1.0 /. float c, 0.5) in
1683 state
.rects1
<- [pageno, color, (x0, y0, x1, y1, x2
, y2
, x3
, y3
)]
1686 let pageno, c, x0, y0, x1, y1, x2
, y2
, x3
, y3
=
1687 scan args
"%u %d %f %f %f %f %f %f %f %f"
1688 (fun p
c x0 y0 x1 y1 x2 y2 x3 y3
->
1689 (p
, c, x0, y0, x1, y1, x2
, y2
, x3
, y3
))
1691 let xoff = float (xadjsb ()) in
1695 and x3
= x3
+. xoff in
1696 let color = (0.0, 0.0, 1.0 /. float c, 0.5) in
1698 (pageno, color, (x0, y0, x1, y1, x2
, y2
, x3
, y3
)) :: state
.rects1
1701 let pageopaques, t
= scan args
"%s %f" (fun p t
-> p
, t
) in
1702 let pageopaque = ~
< pageopaques in
1703 begin match state
.currently
with
1704 | Loading
(l, gen
) ->
1705 vlog "page %d took %f sec" l.pageno t
;
1706 Hashtbl.replace state
.pagemap
(l.pageno, gen
) pageopaque;
1707 begin match state
.throttle
with
1709 let preloadedpages =
1711 then preloadlayout state
.x state
.y state
.winw state
.winh
1716 List.fold_left
(fun s l -> IntSet.add
l.pageno s)
1717 IntSet.empty
preloadedpages
1720 Hashtbl.fold (fun ((pageno, _) as key) opaque
accu ->
1721 if not
(IntSet.mem
pageno set)
1723 wcmd "freepage %s" (~
> opaque
);
1729 List.iter
(Hashtbl.remove state
.pagemap
) evictedpages;
1732 state
.currently
<- Idle
;
1735 tilepage l.pageno pageopaque state
.layout;
1737 load preloadedpages;
1738 let visible = pagevisible state
.layout l.pageno in
1741 match state
.mode
with
1742 | LinkNav
(Ltnotready
(pageno, dir
)) ->
1743 if pageno = l.pageno
1748 then LDfirstvisible
(l.pagex
, l.pagey, dir
)
1750 if dir
> 0 then LDfirst
else LDlast
1753 findlink
pageopaque ld
1758 showlinktype (getlink
pageopaque n);
1759 state
.mode
<- LinkNav
(Ltexact
(l.pageno, n))
1761 | LinkNav
(Ltgendir
_)
1762 | LinkNav
(Ltexact
_)
1768 if visible && layoutready state
.layout
1770 G.postRedisplay "page";
1774 | Some
(layout, _, _) ->
1775 state
.currently
<- Idle
;
1776 tilepage l.pageno pageopaque layout;
1783 dolog
"Inconsistent loading state";
1784 logcurrently state
.currently
;
1789 let (x, y, opaques
, size
, t
) =
1790 scan args
"%u %u %s %u %f"
1791 (fun x y p size t
-> (x, y, p
, size
, t
))
1793 let opaque = ~
< opaques
in
1794 begin match state
.currently
with
1795 | Tiling
(l, pageopaque, cs
, angle
, gen
, col, row, tilew
, tileh
) ->
1796 vlog "tile %d [%d,%d] took %f sec" l.pageno col row t
;
1799 if tilew
!= conf
.tilew
|| tileh
!= conf
.tileh
1801 wcmd "freetile %s" (~
> opaque);
1802 state
.currently
<- Idle
;
1806 puttileopaque l col row gen cs angle
opaque size t
;
1807 state
.memused
<- state
.memused
+ size
;
1808 state
.uioh#infochanged Memused
;
1810 Queue.push
((l.pageno, gen
, cs
, angle
, l.pagew
, l.pageh
, col, row),
1811 opaque, size
) state
.tilelru
;
1814 match state
.throttle
with
1815 | None
-> state
.layout
1816 | Some
(layout, _, _) -> layout
1819 state
.currently
<- Idle
;
1821 && conf
.colorspace
= cs
1822 && conf
.angle
= angle
1823 && tilevisible layout l.pageno x y
1824 then conttiling l.pageno pageopaque;
1826 begin match state
.throttle
with
1828 preload state
.layout;
1830 && conf
.colorspace
= cs
1831 && conf
.angle
= angle
1832 && tilevisible state
.layout l.pageno x y
1833 && (not
!wtmode || layoutready state
.layout)
1834 then G.postRedisplay "tile nothrottle";
1836 | Some
(layout, y, _) ->
1837 let ready = layoutready layout in
1841 state
.layout <- layout;
1842 state
.throttle
<- None
;
1843 G.postRedisplay "throttle";
1852 dolog
"Inconsistent tiling state";
1853 logcurrently state
.currently
;
1858 let (n, w, h, _) as pdim
=
1859 scan args
"%u %u %u %u" (fun n w h x -> n, w, h, x)
1862 match conf
.fitmodel
with
1864 | FitPage
| FitProportional
->
1865 match conf
.columns
with
1866 | Csplit
_ -> (n, w, h, 0)
1867 | Csingle
_ | Cmulti
_ -> pdim
1869 state
.uioh#infochanged Pdim
;
1870 state
.pdims
<- pdim :: state
.pdims
1873 let (l, n, t
, h, pos
) =
1874 scan args
"%u %u %d %u %n"
1875 (fun l n t
h pos
-> l, n, t
, h, pos
)
1877 let s = String.sub args pos
(String.length args
- pos
) in
1878 addoutline (s, l, Oanchor
(n, float t
/. float h, 0.0))
1881 let (l, len, pos
) = scan args
"%u %u %n" (fun l len pos
-> l, len, pos
) in
1882 let s = String.sub args pos
len in
1883 let pos2 = pos
+ len + 1 in
1884 let uri = String.sub args
pos2 (String.length args
- pos2) in
1885 addoutline (s, l, Ouri
uri)
1888 let (l, pos
) = scan args
"%u %n" (fun l pos
-> l, pos
) in
1889 let s = String.sub args pos
(String.length args
- pos
) in
1890 addoutline (s, l, Onone
)
1894 scan args
"%u %d %d" (fun n l t
-> n, l, t
)
1896 state
.reprf
<- (fun () -> gotopagexy !wtmode n (float l) (float t
))
1899 let pos = nindex args '
\t'
in
1900 if pos >= 0 && String.sub args
0 pos = "Title"
1902 let s = String.sub args
(pos+1) @@ String.length args
- pos - 1 in
1906 state
.docinfo
<- (1, args
) :: state
.docinfo
1909 state
.uioh#infochanged Docinfo
;
1910 state
.docinfo
<- List.rev state
.docinfo
1914 then Wsi.settitle
"Wrong password";
1915 let password = getpassword () in
1916 if emptystr
password
1917 then error
"document is password protected"
1918 else opendoc state
.path
password
1921 error
"unknown cmd `%S'" cmds
1926 let action = function
1927 | HCprev
-> cbget cb ~
-1
1928 | HCnext
-> cbget cb
1
1929 | HCfirst
-> cbget cb ~
-(cb
.rc)
1930 | HClast
-> cbget cb
(cb
.len - 1 - cb
.rc)
1931 and cancel
() = cb
.rc <- rc
1935 let search pattern forward
=
1936 match conf
.columns
with
1937 | Csplit
_ -> impmsg "searching does not work properly in split columns mode"
1940 if nonemptystr pattern
1943 match state
.layout with
1946 l.pageno, (l.pagey + if forward
then 0 else 0*l.pagevh)
1948 wcmd "search %d %d %d %d,%s\000"
1949 (btod conf
.icase
) pn py (btod forward
) pattern
;
1952 let intentry text key =
1954 if key >= 32 && key < 127
1956 let c = Char.chr
key in
1958 | '
0'
.. '
9'
-> addchar
text c
1960 state
.text <- Printf.sprintf
"invalid char (%d, `%c')" key c;
1963 state
.text <- Printf.sprintf
"invalid key (%d)" key;
1974 let l = String.length
s in
1975 let rec loop pos n = if pos = l then n else
1976 let m = Char.code
s.[pos] - (if pos = 0 && l > 1 then 96 else 97) in
1977 loop (pos+1) (n*26 + m)
1980 let rec loop n = function
1983 match getopaque l.pageno with
1984 | None
-> loop n rest
1986 let m = getlinkcount
opaque in
1989 let under = getlink
opaque n in
1992 else loop (n-m) rest
1994 loop n state
.layout;
1998 let linknentry text key =
1999 if key >= 32 && key < 127
2001 let text = addchar
text (Char.chr
key) in
2002 linknact (fun under -> state
.text <- undertext ~nopath
:true under) text;
2005 state
.text <- Printf.sprintf
"invalid key %d" key;
2010 let textentry text key =
2011 if Wsi.isspecialkey
key
2013 else TEcont
(text ^ toutf8
key)
2016 let reqlayout angle fitmodel
=
2017 match state
.throttle
with
2019 if nogeomcmds state
.geomcmds
2020 then state
.anchor <- getanchor
();
2021 conf
.angle
<- angle
mod 360;
2024 match state
.mode
with
2025 | LinkNav
_ -> state
.mode
<- View
2030 conf
.fitmodel
<- fitmodel
;
2031 invalidate "reqlayout"
2033 wcmd "reqlayout %d %d %d"
2034 conf
.angle
(FMTE.to_int conf
.fitmodel
) (stateh state
.winh
)
2039 let settrim trimmargins trimfuzz
=
2040 if nogeomcmds state
.geomcmds
2041 then state
.anchor <- getanchor
();
2042 conf
.trimmargins
<- trimmargins
;
2043 conf
.trimfuzz
<- trimfuzz
;
2044 let x0, y0, x1, y1 = trimfuzz
in
2045 invalidate "settrim"
2047 wcmd "settrim %d %d %d %d %d" (btod conf
.trimmargins
) x0 y0 x1 y1);
2052 match state
.throttle
with
2054 let zoom = max
0.0001 zoom in
2055 if zoom <> conf
.zoom
2057 state
.prevzoom
<- (conf
.zoom, state
.x);
2059 reshape state
.winw state
.winh
;
2060 state
.text <- Printf.sprintf
"zoom is now %-5.2f" (zoom *. 100.0);
2063 | Some
(layout, y, started
) ->
2065 match conf
.maxwait
with
2069 let dt = now
() -. started
in
2077 let pivotzoom ?
(x=state
.winw
/2) ?
(y=state
.winh
/2) zoom =
2078 if nogeomcmds state
.geomcmds
2080 let w = float state
.w /. zoom in
2081 let hw = w /. 2.0 in
2082 let ratio = float state
.winh
/. float state
.winw
in
2083 let hh = hw *. ratio in
2084 let x0 = float x -. hw in
2085 let y0 = float y -. hh in
2086 gotoxy (state
.x - truncate
x0) (state
.y + truncate
y0);
2090 let setcolumns mode columns coverA coverB
=
2091 state
.prevcolumns
<- Some
(conf
.columns
, conf
.zoom);
2095 then impmsg "split mode doesn't work in bird's eye"
2097 conf
.columns
<- Csplit
(-columns
, E.a);
2105 conf
.columns
<- Csingle
E.a;
2110 conf
.columns
<- Cmulti
((columns
, coverA
, coverB
), E.a);
2114 reshape state
.winw state
.winh
;
2117 let resetmstate () =
2118 state
.mstate
<- Mnone
;
2119 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
2122 let enterbirdseye () =
2123 let zoom = float conf
.thumbw
/. float state
.winw
in
2124 let birdseyepageno =
2125 let cy = state
.winh
/ 2 in
2129 let rec fold best
= function
2132 let d = cy - (l.pagedispy + l.pagevh/2)
2133 and dbest
= cy - (best
.pagedispy + best
.pagevh/2) in
2134 if abs
d < abs dbest
2141 state
.mode
<- Birdseye
(
2142 { conf
with zoom = conf
.zoom }, state
.x, birdseyepageno, -1, getanchor
()
2146 conf
.presentation
<- false;
2147 conf
.interpagespace
<- 10;
2148 conf
.hlinks
<- false;
2149 conf
.fitmodel
<- FitPage
;
2151 conf
.maxwait
<- None
;
2153 match conf
.beyecolumns
with
2156 Cmulti
((c, 0, 0), E.a)
2157 | None
-> Csingle
E.a
2161 state
.text <- Printf.sprintf
"birds eye mode on (zoom %3.1f%%)"
2166 reshape state
.winw state
.winh
;
2169 let leavebirdseye (c, leftx
, pageno, _, anchor) goback
=
2171 conf
.zoom <- c.zoom;
2172 conf
.presentation
<- c.presentation
;
2173 conf
.interpagespace
<- c.interpagespace
;
2174 conf
.maxwait
<- c.maxwait
;
2175 conf
.hlinks
<- c.hlinks
;
2176 conf
.fitmodel
<- c.fitmodel
;
2177 conf
.beyecolumns
<- (
2178 match conf
.columns
with
2179 | Cmulti
((c, _, _), _) -> Some
c
2181 | Csplit
_ -> failwith
"leaving bird's eye split mode"
2184 match c.columns
with
2185 | Cmulti
(c, _) -> Cmulti
(c, E.a)
2186 | Csingle
_ -> Csingle
E.a
2187 | Csplit
(c, _) -> Csplit
(c, E.a)
2191 state
.text <- Printf.sprintf
"birds eye mode off (zoom %3.1f%%)"
2194 reshape state
.winw state
.winh
;
2195 state
.anchor <- if goback
then anchor else (pageno, 0.0, 1.0);
2199 let togglebirdseye () =
2200 match state
.mode
with
2201 | Birdseye vals
-> leavebirdseye vals
true
2202 | View
-> enterbirdseye ()
2207 let upbirdseye incr
(conf
, leftx
, pageno, hooverpageno
, anchor) =
2208 let pageno = max
0 (pageno - incr
) in
2209 let rec loop = function
2210 | [] -> gotopage1 pageno 0
2211 | l :: _ when l.pageno = pageno ->
2212 if l.pagedispy >= 0 && l.pagey = 0
2213 then G.postRedisplay "upbirdseye"
2214 else gotopage1 pageno 0
2215 | _ :: rest
-> loop rest
2219 state
.mode
<- Birdseye
(conf
, leftx
, pageno, hooverpageno
, anchor)
2222 let downbirdseye incr
(conf
, leftx
, pageno, hooverpageno
, anchor) =
2223 let pageno = min
(state
.pagecount
- 1) (pageno + incr
) in
2224 state
.mode
<- Birdseye
(conf
, leftx
, pageno, hooverpageno
, anchor);
2225 let rec loop = function
2227 let y, h = getpageyh
pageno in
2228 let dy = (y - state
.y) - (state
.winh
- h - conf
.interpagespace
) in
2229 gotoxy state
.x (clamp dy)
2230 | l :: _ when l.pageno = pageno ->
2231 if l.pagevh != l.pageh
2232 then gotoxy state
.x (clamp (l.pageh
- l.pagevh + conf
.interpagespace
))
2233 else G.postRedisplay "downbirdseye"
2234 | _ :: rest
-> loop rest
2240 let optentry mode
_ key =
2241 let btos b = if b then "on" else "off" in
2242 if key >= 32 && key < 127
2244 let c = Char.chr
key in
2248 try conf
.scrollstep
<- int_of_string
s with exn
->
2249 state
.text <- Printf.sprintf
"bad integer `%s': %s" s @@ exntos exn
2251 TEswitch
("scroll step: ", E.s, None
, intentry, ondone, true)
2256 conf
.autoscrollstep
<- boundastep state
.winh
(int_of_string
s);
2257 if state
.autoscroll
<> None
2258 then state
.autoscroll
<- Some conf
.autoscrollstep
2260 state
.text <- Printf.sprintf
"bad integer `%s': %s" s @@ exntos exn
2262 TEswitch
("auto scroll step: ", E.s, None
, intentry, ondone, true)
2267 let n, a, b = multicolumns_of_string
s in
2268 setcolumns mode
n a b;
2270 state
.text <- Printf.sprintf
"bad columns `%s': %s" s @@ exntos exn
2272 TEswitch
("columns: ", E.s, None
, textentry, ondone, true)
2277 let zoom = float (int_of_string
s) /. 100.0 in
2280 state
.text <- Printf.sprintf
"bad integer `%s': %s" s @@ exntos exn
2282 TEswitch
("zoom: ", E.s, None
, intentry, ondone, true)
2287 conf
.thumbw
<- bound
(int_of_string
s) 2 4096;
2289 Printf.sprintf
"thumbnail width is set to %d" conf
.thumbw
;
2290 begin match mode
with
2292 leavebirdseye beye
false;
2299 state
.text <- Printf.sprintf
"bad integer `%s': %s" s @@ exntos exn
2301 TEswitch
("thumbnail width: ", E.s, None
, intentry, ondone, true)
2305 match int_of_string
s with
2306 | angle
-> reqlayout angle conf
.fitmodel
2309 Printf.sprintf
"bad integer `%s': %s" s @@ exntos exn
2311 TEswitch
("rotation: ", E.s, None
, intentry, ondone, true)
2314 conf
.icase
<- not conf
.icase
;
2315 TEdone
("case insensitive search " ^
(btos conf
.icase
))
2318 conf
.preload <- not conf
.preload;
2319 gotoxy state
.x state
.y;
2320 TEdone
("preload " ^
(btos conf
.preload))
2323 conf
.verbose
<- not conf
.verbose
;
2324 TEdone
("verbose " ^
(btos conf
.verbose
))
2327 conf
.debug
<- not conf
.debug
;
2328 TEdone
("debug " ^
(btos conf
.debug
))
2331 conf
.maxhfit
<- not conf
.maxhfit
;
2332 state
.maxy
<- calcheight
();
2333 TEdone
("maxhfit " ^
(btos conf
.maxhfit
))
2336 conf
.crophack
<- not conf
.crophack
;
2337 TEdone
("crophack " ^
btos conf
.crophack
)
2341 match conf
.maxwait
with
2343 conf
.maxwait
<- Some infinity
;
2344 "always wait for page to complete"
2346 conf
.maxwait
<- None
;
2347 "show placeholder if page is not ready"
2352 conf
.underinfo
<- not conf
.underinfo
;
2353 TEdone
("underinfo " ^
btos conf
.underinfo
)
2356 conf
.savebmarks
<- not conf
.savebmarks
;
2357 TEdone
("persistent bookmarks " ^
btos conf
.savebmarks
)
2363 match state
.layout with
2368 conf
.interpagespace
<- int_of_string
s;
2369 docolumns conf
.columns
;
2370 state
.maxy
<- calcheight
();
2371 let y = getpagey
pageno in
2372 gotoxy state
.x (y + py)
2374 state
.text <- Printf.sprintf
"bad integer `%s': %s" s @@ exntos exn
2376 TEswitch
("vertical margin: ", E.s, None
, intentry, ondone, true)
2380 match conf
.fitmodel
with
2381 | FitProportional
-> FitWidth
2382 | FitWidth
| FitPage
-> FitProportional
2384 reqlayout conf
.angle
fm;
2385 TEdone
("proportional display " ^
btos (fm == FitProportional
))
2388 settrim (not conf
.trimmargins
) conf
.trimfuzz
;
2389 TEdone
("trim margins " ^
btos conf
.trimmargins
)
2392 conf
.invert
<- not conf
.invert
;
2393 TEdone
("invert colors " ^
btos conf
.invert
)
2397 cbput state
.hists
.sel
s;
2400 TEswitch
("selection command: ", E.s, Some
(onhist state
.hists
.sel
),
2401 textentry, ondone, true)
2405 then conf
.pax
<- Some
(ref (0.0, 0, 0))
2406 else conf
.pax
<- None
;
2407 TEdone
("PAX " ^
btos (conf
.pax
!= None
))
2410 state
.text <- Printf.sprintf
"bad option %d `%c'" key c;
2416 class type lvsource
= object
2417 method getitemcount
: int
2418 method getitem
: int -> (string * int)
2419 method hasaction
: int -> bool
2427 method getactive
: int
2428 method getfirst
: int
2430 method getminfo
: (int * int) array
2433 class virtual lvsourcebase
= object
2434 val mutable m_active
= 0
2435 val mutable m_first
= 0
2436 val mutable m_pan
= 0
2437 method getactive
= m_active
2438 method getfirst
= m_first
2439 method getpan
= m_pan
2440 method getminfo
: (int * int) array
= E.a
2443 let textentrykeyboard
2444 key _mask
((c, text, opthist
, onkey
, ondone, cancelonempty
), onleave
) =
2446 let key = Wsi.keypadtodigitkey
key in
2448 state
.mode
<- Textentry
(te
, onleave
);
2450 G.postRedisplay "textentrykeyboard enttext";
2452 let histaction cmd
=
2455 | Some
(action, _) ->
2456 state
.mode
<- Textentry
(
2457 (c, action cmd
, opthist
, onkey
, ondone, cancelonempty
), onleave
2459 G.postRedisplay "textentry histaction"
2463 if emptystr
text && cancelonempty
2466 G.postRedisplay "textentrykeyboard after cancel";
2469 let s = withoutlastutf8
text in
2470 enttext (c, s, opthist
, onkey
, ondone, cancelonempty
)
2472 | @enter
| @kpenter
->
2475 G.postRedisplay "textentrykeyboard after confirm"
2477 | @up
| @kpup
-> histaction HCprev
2478 | @down
| @kpdown
-> histaction HCnext
2479 | @home
| @kphome
-> histaction HCfirst
2480 | @jend
| @kpend
-> histaction HClast
2485 begin match opthist
with
2487 | Some
(_, onhistcancel
) -> onhistcancel
()
2491 G.postRedisplay "textentrykeyboard after cancel2"
2494 enttext (c, E.s, opthist
, onkey
, ondone, cancelonempty
)
2497 | @delete
| @kpdelete
-> ()
2499 | _ when key != 0 && not
(Wsi.isspecialkey
key) ->
2500 begin match onkey
text key with
2504 G.postRedisplay "textentrykeyboard after confirm2";
2507 enttext (c, text, opthist
, onkey
, ondone, cancelonempty
);
2511 G.postRedisplay "textentrykeyboard after cancel3"
2514 state
.mode
<- Textentry
(te
, onleave
);
2515 G.postRedisplay "textentrykeyboard switch";
2519 vlog "unhandled key %s" (Wsi.keyname
key)
2522 let firstof first active
=
2523 if first
> active
|| abs
(first
- active
) > fstate
.maxrows
- 1
2524 then max
0 (active
- (fstate
.maxrows
/2))
2528 let calcfirst first active
=
2531 let rows = active
- first
in
2532 if rows > fstate
.maxrows
then active
- fstate
.maxrows
else first
2536 let scrollph y maxy
=
2537 let sh = float (maxy
+ state
.winh
) /. float state
.winh
in
2538 let sh = float state
.winh
/. sh in
2539 let sh = max
sh (float conf
.scrollh
) in
2541 let percent = float y /. float maxy
in
2542 let position = (float state
.winh
-. sh) *. percent in
2545 if position +. sh > float state
.winh
2546 then float state
.winh
-. sh
2552 let adderrmsg src msg
=
2553 Buffer.add_string state
.errmsgs msg
;
2554 state
.newerrmsgs
<- true;
2558 let adderrfmt src fmt
=
2559 Format.ksprintf
(fun s -> adderrmsg src
s) fmt
;
2562 let coe s = (s :> uioh
);;
2564 class listview ~zebra ~helpmode ~
(source
:lvsource
) ~trusted ~modehash
=
2566 val m_pan
= source#getpan
2567 val m_first
= source#getfirst
2568 val m_active
= source#getactive
2570 val m_prev_uioh
= state
.uioh
2572 method private elemunder
y =
2576 let n = y / (fstate
.fontsize
+1) in
2577 if m_first
+ n < source#getitemcount
2579 if source#hasaction
(m_first
+ n)
2580 then Some
(m_first
+ n)
2587 GlFunc.blend_func ~src
:`src_alpha ~dst
:`one_minus_src_alpha
;
2588 GlDraw.color (0., 0., 0.) ~alpha
:0.85;
2589 filledrect 0. 0. (float state
.winw
) (float state
.winh
);
2590 GlDraw.color (1., 1., 1.);
2591 Gl.enable `texture_2d
;
2592 let fs = fstate
.fontsize
in
2594 let hw = (wadjsb () + xadjsb () + state
.winw
)/3 in
2595 let ww = fstate
.wwidth
in
2596 let tabw = 17.0*.ww in
2597 let itemcount = source#getitemcount
in
2598 let minfo = source#getminfo
in
2602 then float (state
.winw
- 1)
2603 else float (state
.winw
- conf
.scrollbw
- 1)
2605 let xadj = xadjsb () in
2607 if (row - m_first
) > fstate
.maxrows
2610 if row >= 0 && row < itemcount
2612 let (s, level
) = source#getitem
row in
2613 let y = (row - m_first
) * nfs in
2615 (if conf
.leftscroll
then float xadj else 5.0)
2616 +. (float (level
+ m_pan
)) *. ww in
2619 (let c = if row land 1 = 0 then 1.0 else 0.92 in (c,c,c));
2623 Gl.disable `texture_2d
;
2624 let alpha = if source#hasaction
row then 0.9 else 0.3 in
2625 GlDraw.color (1., 1., 1.) ~
alpha;
2626 linerect (x0 +. 1.) (float (y + 1)) (x1) (float (y + fs + 3));
2627 Gl.enable `texture_2d
;
2630 if zebra
&& row land 1 = 1
2634 GlDraw.color (c,c,c);
2635 let drawtabularstring s =
2637 let x'
= truncate
(x0 +. x) in
2638 let pos = nindex
s '
\000'
in
2640 then drawstring1 fs x'
(y+nfs) s
2642 let s1 = String.sub
s 0 pos
2643 and s2
= String.sub
s (pos+1) (String.length
s - pos - 1) in
2648 let s'
= withoutlastutf8
s in
2649 let s = s' ^
"@Uellipsis" in
2650 let w = measurestr
fs s in
2651 if float x'
+. w +. ww < float (hw + x'
)
2656 if float x'
+. ww +. measurestr
fs s1 > float (hw + x'
)
2660 ignore
(drawstring1 fs x'
(y+nfs) s1);
2661 drawstring1 fs (hw + x'
) (y+nfs) s2
2665 let x = if helpmode
&& row > 0 then x +. ww else x in
2666 let tabpos = nindex
s '
\t'
in
2669 let len = String.length
s - tabpos - 1 in
2670 let s1 = String.sub
s 0 tabpos
2671 and s2
= String.sub
s (tabpos + 1) len in
2672 let nx = drawstr x s1 in
2674 let x = x +. (max
tabw sw) in
2677 let len = String.length
s - 2 in
2678 if len > 0 && s.[0] = '
\xc2'
&& s.[1] = '
\xb7'
2680 let s = String.sub
s 2 len in
2681 let x = if not helpmode
then x +. ww else x in
2682 GlDraw.color (1.2, 1.2, 1.2);
2683 let vinc = drawstring1 (fs+fs/4)
2684 (truncate
(x -. ww)) (y+nfs) s in
2685 GlDraw.color (1., 1., 1.);
2686 vinc +. (float fs *. 0.8)
2692 ignore
(drawtabularstring s);
2698 GlDraw.color (1.0, 1.0, 1.0) ~
alpha:0.5;
2699 let xadj = float (xadjsb () + 5) in
2701 if (row - m_first
) > fstate
.maxrows
2704 if row >= 0 && row < itemcount
2706 let (s, level
) = source#getitem
row in
2707 let pos0 = nindex
s '
\000'
in
2708 let y = (row - m_first
) * nfs in
2709 let x = float (level
+ m_pan
) *. ww in
2710 let (first
, last
) = minfo.(row) in
2712 if pos0 > 0 && first
> pos0
2713 then String.sub
s (pos0+1) (first
-pos0-1)
2714 else String.sub
s 0 first
2716 let suffix = String.sub
s first
(last
- first
) in
2717 let w1 = measurestr fstate
.fontsize
prefix in
2718 let w2 = measurestr fstate
.fontsize
suffix in
2719 let x = x +. if conf
.leftscroll
then xadj else 5.0 in
2720 let x = if pos0 > 0 && first
> pos0 then x +. float hw else x in
2722 and y0 = float (y+2) in
2724 and y1 = float (y+fs+3) in
2725 filledrect x0 y0 x1 y1;
2730 Gl.disable `texture_2d
;
2731 if Array.length
minfo > 0 then loop m_first
;
2734 method updownlevel incr
=
2735 let len = source#getitemcount
in
2737 if m_active
>= 0 && m_active
< len
2738 then snd
(source#getitem m_active
)
2742 if i
= len then i
-1 else if i
= -1 then 0 else
2743 let _, l = source#getitem i
in
2744 if l != curlevel then i
else flow (i
+incr
)
2746 let active = flow m_active
in
2747 let first = calcfirst m_first
active in
2748 G.postRedisplay "outline updownlevel";
2749 {< m_active
= active; m_first
= first >}
2751 method private key1
key mask
=
2752 let set1 active first qsearch
=
2753 coe {< m_active
= active; m_first
= first; m_qsearch
= qsearch
>}
2755 let search active pattern incr
=
2756 let active = if active = -1 then m_first
else active in
2759 if n >= 0 && n < source#getitemcount
2761 let s, _ = source#getitem
n in
2762 match Str.search_forward re
s 0 with
2763 | (exception Not_found
) -> loop (n + incr
)
2770 let qpat = Str.quote pattern
in
2771 match Str.regexp_case_fold
qpat with
2774 adderrfmt "listview key1" "regexp_case_fold for `%S' failed: %S\n"
2775 qpat @@ Printexc.to_string exn
;
2778 let itemcount = source#getitemcount
in
2779 let find start incr
=
2781 if i
= -1 || i
= itemcount
2784 if source#hasaction i
2786 else find (i
+ incr
)
2791 let set active first =
2792 let first = bound
first 0 (itemcount - fstate
.maxrows
) in
2794 coe {< m_active
= active; m_first
= first; m_qsearch
= E.s >}
2797 let isvisible first n = n >= first && n - first <= fstate
.maxrows
in
2799 let incr1 = if incr
> 0 then 1 else -1 in
2800 if isvisible m_first m_active
2803 let next = m_active
+ incr
in
2805 if next < 0 || next >= itemcount
2807 else find next incr1
2809 if abs
(m_active
- next) > fstate
.maxrows
2815 let first = m_first
+ incr
in
2816 let first = bound
first 0 (itemcount - fstate
.maxrows
) in
2818 let next = m_active
+ incr
in
2819 let next = bound
next 0 (itemcount - 1) in
2826 if isvisible first next
2833 let first = min
next m_first
in
2835 if abs
(next - first) > fstate
.maxrows
2841 let first = m_first
+ incr
in
2842 let first = bound
first 0 (itemcount - 1) in
2844 let next = m_active
+ incr
in
2845 let next = bound
next 0 (itemcount - 1) in
2846 let next = find next incr1 in
2848 if next = -1 || abs
(m_active
- first) > fstate
.maxrows
2850 let active = if m_active
= -1 then next else m_active
in
2855 if isvisible first active
2861 G.postRedisplay "listview navigate";
2865 | (@r
|@s) when Wsi.withctrl mask
->
2866 let incr = if key = @r
then -1 else 1 in
2868 match search (m_active
+ incr) m_qsearch
incr with
2870 state
.text <- m_qsearch ^
" [not found]";
2873 state
.text <- m_qsearch
;
2874 active, firstof m_first
active
2876 G.postRedisplay "listview ctrl-r/s";
2877 set1 active first m_qsearch
;
2879 | @insert
when Wsi.withctrl mask
->
2880 if m_active
>= 0 && m_active
< source#getitemcount
2882 let s, _ = source#getitem m_active
in
2888 if emptystr m_qsearch
2891 let qsearch = withoutlastutf8 m_qsearch
in
2895 G.postRedisplay "listview empty qsearch";
2896 set1 m_active m_first
E.s;
2900 match search m_active
qsearch ~
-1 with
2902 state
.text <- qsearch ^
" [not found]";
2905 state
.text <- qsearch;
2906 active, firstof m_first
active
2908 G.postRedisplay "listview backspace qsearch";
2909 set1 active first qsearch
2912 | key when (key != 0 && not
(Wsi.isspecialkey
key)) ->
2913 let pattern = m_qsearch ^ toutf8
key in
2915 match search m_active
pattern 1 with
2917 state
.text <- pattern ^
" [not found]";
2920 state
.text <- pattern;
2921 active, firstof m_first
active
2923 G.postRedisplay "listview qsearch add";
2924 set1 active first pattern;
2928 if emptystr m_qsearch
2930 G.postRedisplay "list view escape";
2931 let mx, my
= state
.mpos
in
2935 source#exit ~uioh
:(coe self
)
2936 ~cancel
:true ~
active:m_active ~
first:m_first ~pan
:m_pan
2938 | None
-> m_prev_uioh
2943 G.postRedisplay "list view kill qsearch";
2944 coe {< m_qsearch
= E.s >}
2947 | @enter
| @kpenter
->
2949 let self = {< m_qsearch
= E.s >} in
2951 G.postRedisplay "listview enter";
2952 if m_active
>= 0 && m_active
< source#getitemcount
2954 source#exit ~uioh
:(coe self) ~cancel
:false
2955 ~
active:m_active ~
first:m_first ~pan
:m_pan
;
2958 source#exit ~uioh
:(coe self) ~cancel
:true
2959 ~
active:m_active ~
first:m_first ~pan
:m_pan
;
2962 begin match opt with
2963 | None
-> m_prev_uioh
2967 | @delete
| @kpdelete
->
2970 | @up
| @kpup
-> navigate ~
-1
2971 | @down
| @kpdown
-> navigate 1
2972 | @prior
| @kpprior
-> navigate ~
-(fstate
.maxrows
)
2973 | @next | @kpnext
-> navigate fstate
.maxrows
2975 | @right
| @kpright
->
2977 G.postRedisplay "listview right";
2978 coe {< m_pan
= m_pan
- 1 >}
2980 | @left | @kpleft
->
2982 G.postRedisplay "listview left";
2983 coe {< m_pan
= m_pan
+ 1 >}
2985 | @home
| @kphome
->
2986 let active = find 0 1 in
2987 G.postRedisplay "listview home";
2991 let first = max
0 (itemcount - fstate
.maxrows
) in
2992 let active = find (itemcount - 1) ~
-1 in
2993 G.postRedisplay "listview end";
2996 | key when (key = 0 || Wsi.isspecialkey
key) ->
3000 dolog
"listview unknown key %#x" key; coe self
3002 method key key mask
=
3003 match state
.mode
with
3004 | Textentry te
-> textentrykeyboard key mask te
; coe self
3007 | LinkNav
_ -> self#key1
key mask
3009 method button button down
x y _ =
3012 | 1 when vscrollhit x ->
3013 G.postRedisplay "listview scroll";
3016 let _, position, sh = self#
scrollph in
3017 if y > truncate
position && y < truncate
(position +. sh)
3019 state
.mstate
<- Mscrolly
;
3023 let s = float (max
0 (y - conf
.scrollh
)) /. float state
.winh
in
3024 let first = truncate
(s *. float source#getitemcount
) in
3025 let first = min source#getitemcount
first in
3026 Some
(coe {< m_first
= first; m_active
= first >})
3028 state
.mstate
<- Mnone
;
3032 begin match self#elemunder
y with
3034 G.postRedisplay "listview click";
3035 source#exit ~uioh
:(coe {< m_active
= n >})
3036 ~cancel
:false ~
active:n ~
first:m_first ~pan
:m_pan
3040 | n when (n == 4 || n == 5) && not down
->
3041 let len = source#getitemcount
in
3043 if n = 5 && m_first
+ fstate
.maxrows
>= len
3047 let first = m_first
+ (if n == 4 then -1 else 1) in
3048 bound
first 0 (len - 1)
3050 G.postRedisplay "listview wheel";
3051 Some
(coe {< m_first
= first >})
3052 | n when (n = 6 || n = 7) && not down
->
3053 let inc = if n = 7 then -1 else 1 in
3054 G.postRedisplay "listview hwheel";
3055 Some
(coe {< m_pan
= m_pan
+ inc >})
3060 | None
-> m_prev_uioh
3063 method multiclick
_ x y = self#button
1 true x y
3066 match state
.mstate
with
3068 let s = float (max
0 (y - conf
.scrollh
)) /. float state
.winh
in
3069 let first = truncate
(s *. float source#getitemcount
) in
3070 let first = min source#getitemcount
first in
3071 G.postRedisplay "listview motion";
3072 coe {< m_first
= first; m_active
= first >}
3080 method pmotion
x y =
3081 if x < state
.winw
- conf
.scrollbw
3084 match self#elemunder
y with
3085 | None
-> Wsi.setcursor
Wsi.CURSOR_INHERIT
; m_active
3086 | Some
n -> Wsi.setcursor
Wsi.CURSOR_INFO
; n
3090 then (G.postRedisplay "listview pmotion"; {< m_active
= n >})
3095 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
3099 method infochanged
_ = ()
3101 method scrollpw
= (0, 0.0, 0.0)
3103 let nfs = fstate
.fontsize
+ 1 in
3104 let y = m_first
* nfs in
3105 let itemcount = source#getitemcount
in
3106 let maxi = max
0 (itemcount - fstate
.maxrows
) in
3107 let maxy = maxi * nfs in
3108 let p, h = scrollph y maxy in
3111 method modehash
= modehash
3112 method eformsgs
= false
3113 method alwaysscrolly
= true
3116 class outlinelistview ~zebra ~source
=
3117 let settext autonarrow
s =
3120 let ss = source#statestr
in
3124 else "{" ^
ss ^
"} [" ^
s ^
"]"
3125 else state
.text <- s
3131 ~source
:(source
:> lvsource
)
3133 ~modehash
:(findkeyhash conf
"outline")
3136 val m_autonarrow
= false
3138 method! key key mask
=
3140 if emptystr state
.text
3142 else fstate
.maxrows - 2
3144 let calcfirst first active =
3147 let rows = active - first in
3148 if rows > maxrows then active - maxrows else first
3152 let active = m_active
+ incr in
3153 let active = bound
active 0 (source#getitemcount
- 1) in
3154 let first = calcfirst m_first
active in
3155 G.postRedisplay "outline navigate";
3156 coe {< m_active
= active; m_first
= first >}
3158 let navscroll first =
3160 let dist = m_active
- first in
3166 else first + maxrows
3169 G.postRedisplay "outline navscroll";
3170 coe {< m_first
= first; m_active
= active >}
3172 let ctrl = Wsi.withctrl mask
in
3177 then (source#denarrow
; E.s)
3179 let pattern = source#renarrow
in
3180 if nonemptystr m_qsearch
3181 then (source#narrow m_qsearch
; m_qsearch
)
3185 settext (not m_autonarrow
) text;
3186 G.postRedisplay "toggle auto narrowing";
3187 coe {< m_first
= 0; m_active
= 0; m_autonarrow
= not m_autonarrow
>}
3189 | @slash
when emptystr m_qsearch
&& not m_autonarrow
->
3191 G.postRedisplay "toggle auto narrowing";
3192 coe {< m_first
= 0; m_active
= 0; m_autonarrow
= true >}
3195 source#narrow m_qsearch
;
3197 then source#add_narrow_pattern m_qsearch
;
3198 G.postRedisplay "outline ctrl-n";
3199 coe {< m_first
= 0; m_active
= 0 >}
3202 let active = source#calcactive
(getanchor
()) in
3203 let first = firstof m_first
active in
3204 G.postRedisplay "outline ctrl-s";
3205 coe {< m_first
= first; m_active
= active >}
3208 G.postRedisplay "outline ctrl-u";
3209 if m_autonarrow
&& nonemptystr m_qsearch
3211 ignore
(source#renarrow
);
3212 settext m_autonarrow
E.s;
3213 coe {< m_first
= 0; m_active
= 0; m_qsearch
= E.s >}
3216 source#del_narrow_pattern
;
3217 let pattern = source#renarrow
in
3219 if emptystr
pattern then E.s else "Narrowed to " ^
pattern
3221 settext m_autonarrow
text;
3222 coe {< m_first
= 0; m_active
= 0; m_qsearch
= E.s >}
3226 let first = max
0 (m_active
- (fstate
.maxrows / 2)) in
3227 G.postRedisplay "outline ctrl-l";
3228 coe {< m_first
= first >}
3230 | @tab
when m_autonarrow
->
3231 if nonemptystr m_qsearch
3233 G.postRedisplay "outline list view tab";
3234 source#add_narrow_pattern m_qsearch
;
3236 coe {< m_qsearch
= E.s >}
3240 | @escape
when m_autonarrow
->
3241 if nonemptystr m_qsearch
3242 then source#add_narrow_pattern m_qsearch
;
3245 | @enter
| @kpenter
when m_autonarrow
->
3246 if nonemptystr m_qsearch
3247 then source#add_narrow_pattern m_qsearch
;
3250 | key when m_autonarrow
&& (not
(Wsi.isspecialkey
key)) ->
3251 let pattern = m_qsearch ^ toutf8
key in
3252 G.postRedisplay "outlinelistview autonarrow add";
3253 source#narrow
pattern;
3254 settext true pattern;
3255 coe {< m_first
= 0; m_active
= 0; m_qsearch
= pattern >}
3257 | key when m_autonarrow
&& key = @backspace
->
3258 if emptystr m_qsearch
3261 let pattern = withoutlastutf8 m_qsearch
in
3262 G.postRedisplay "outlinelistview autonarrow backspace";
3263 ignore
(source#renarrow
);
3264 source#narrow
pattern;
3265 settext true pattern;
3266 coe {< m_first
= 0; m_active
= 0; m_qsearch
= pattern >}
3268 | @up
| @kpup
when ctrl ->
3269 navscroll (max
0 (m_first
- 1))
3271 | @down
| @kpdown
when ctrl ->
3272 navscroll (min
(source#getitemcount
- 1) (m_first
+ 1))
3274 | @up
| @kpup
-> navigate ~
-1
3275 | @down
| @kpdown
-> navigate 1
3276 | @prior
| @kpprior
-> navigate ~
-(fstate
.maxrows)
3277 | @next | @kpnext
-> navigate fstate
.maxrows
3279 | @right
| @kpright
->
3283 G.postRedisplay "outline ctrl right";
3284 {< m_pan
= m_pan
+ 1 >}
3286 else self#updownlevel
1
3290 | @left | @kpleft
->
3294 G.postRedisplay "outline ctrl left";
3295 {< m_pan
= m_pan
- 1 >}
3297 else self#updownlevel ~
-1
3301 | @home
| @kphome
->
3302 G.postRedisplay "outline home";
3303 coe {< m_first
= 0; m_active
= 0 >}
3306 let active = source#getitemcount
- 1 in
3307 let first = max
0 (active - fstate
.maxrows) in
3308 G.postRedisplay "outline end";
3309 coe {< m_active
= active; m_first
= first >}
3311 | _ -> super#
key key mask
3314 let genhistoutlines () =
3316 |> List.sort
(fun (_, c1
, _, _, _, _) (_, c2
, _, _, _, _) ->
3317 compare c2
.lastvisit c1
.lastvisit
)
3319 (fun ((path
, c, _, _, _, origin
) as hist
) ->
3320 let path = if nonemptystr origin
then origin
else path in
3321 let base = mbtoutf8
@@ Filename.basename
path in
3322 (base ^
"\000" ^
c.title
, 1, Ohistory hist
)
3327 let gotohist (path, c, bookmarks
, x, anchor, origin
) =
3328 Config.save
leavebirdseye;
3329 state
.anchor <- anchor;
3330 state
.bookmarks
<- bookmarks
;
3331 state
.origin
<- origin
;
3334 let x0, y0, x1, y1 = conf
.trimfuzz
in
3335 wcmd "trimset %d %d %d %d %d" (btod conf
.trimmargins
) x0 y0 x1 y1;
3336 reshape ~firsttime
:true state
.winw state
.winh
;
3337 opendoc path origin
;
3341 let makecheckers () =
3342 (* Based on lablGL-1.04/LablGlut/examples/lablGL/checker.ml which had
3344 converted by Issac Trotts. July 25, 2002 *)
3345 let image = GlPix.create `ubyte ~format
:`luminance ~width
:2 ~height
:2 in
3346 Raw.sets_string
(GlPix.to_raw
image) ~
pos:0 "\255\200\200\255";
3347 let id = GlTex.gen_texture
() in
3348 GlTex.bind_texture ~target
:`texture_2d
id;
3349 GlPix.store
(`unpack_alignment
1);
3350 GlTex.image2d
image;
3351 List.iter
(GlTex.parameter ~target
:`texture_2d
)
3352 [ `mag_filter `nearest
; `min_filter `nearest
];
3356 let setcheckers enabled
=
3357 match state
.checkerstexid
with
3359 if enabled
then state
.checkerstexid
<- Some
(makecheckers ())
3361 | Some checkerstexid
->
3364 GlTex.delete_texture checkerstexid
;
3365 state
.checkerstexid
<- None
;
3369 let describe_location () =
3370 let fn = page_of_y state
.y in
3371 let ln = page_of_y
(state
.y + state
.winh
- hscrollh () - 1) in
3372 let maxy = state
.maxy - (if conf
.maxhfit
then state
.winh
else 0) in
3376 else (100. *. (float state
.y /. float maxy))
3380 Printf.sprintf
"page %d of %d [%.2f%%]"
3381 (fn+1) state
.pagecount
percent
3384 "pages %d-%d of %d [%.2f%%]"
3385 (fn+1) (ln+1) state
.pagecount
percent
3388 let setpresentationmode v
=
3389 let n = page_of_y state
.y in
3390 state
.anchor <- (n, 0.0, 1.0);
3391 conf
.presentation
<- v
;
3392 if conf
.fitmodel
= FitPage
3393 then reqlayout conf
.angle conf
.fitmodel
;
3397 let setbgcol (r
, g, b) =
3399 let r = r *. 255.0 |> truncate
3400 and g = g *. 255.0 |> truncate
3401 and b = b *. 255.0 |> truncate
in
3402 r lsl 16 |> (lor) (g lsl 8) |> (lor) b
3404 Wsi.setwinbgcol
col;
3408 let btos b = if b then "@Uradical" else E.s in
3409 let showextended = ref false in
3410 let leave mode
_ = state
.mode
<- mode
in
3413 val mutable m_l
= []
3414 val mutable m_a
= E.a
3415 val mutable m_prev_uioh
= nouioh
3416 val mutable m_prev_mode
= View
3418 inherit lvsourcebase
3420 method reset prev_mode prev_uioh
=
3421 m_a
<- Array.of_list
(List.rev m_l
);
3423 m_prev_mode
<- prev_mode
;
3424 m_prev_uioh
<- prev_uioh
;
3426 method int name get
set =
3428 (name
, `
int get
, 1, Action
(
3431 try set (int_of_string
s)
3433 state
.text <- Printf.sprintf
"bad integer `%s': %s"
3437 let te = name ^
": ", E.s, None
, intentry, ondone, true in
3438 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3442 method int_with_suffix name get
set =
3444 (name
, `intws get
, 1, Action
(
3447 try set (int_of_string_with_suffix
s)
3449 state
.text <- Printf.sprintf
"bad integer `%s': %s"
3454 name ^
": ", E.s, None
, intentry_with_suffix, ondone, true
3456 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3460 method bool ?
(offset
=1) ?
(btos=btos) name get
set =
3462 (name
, `
bool (btos, get
), offset
, Action
(
3469 method color name get
set =
3471 (name
, `
color get
, 1, Action
(
3473 let invalid = (nan
, nan
, nan
) in
3476 try color_of_string
s
3478 state
.text <- Printf.sprintf
"bad color `%s': %s"
3485 let te = name ^
": ", E.s, None
, textentry, ondone, true in
3486 state
.text <- color_to_string
(get
());
3487 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3491 method string name get
set =
3493 (name
, `
string get
, 1, Action
(
3495 let ondone s = set s in
3496 let te = name ^
": ", E.s, None
, textentry, ondone, true in
3497 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3501 method colorspace name get
set =
3503 (name
, `
string get
, 1, Action
(
3507 inherit lvsourcebase
3510 m_active
<- CSTE.to_int conf
.colorspace
;
3513 method getitemcount
=
3514 Array.length
CSTE.names
3517 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3518 ignore
(uioh
, first, pan
);
3519 if not cancel
then set active;
3521 method hasaction
_ = true
3525 let modehash = findkeyhash conf
"info" in
3526 coe (new listview ~zebra
:false ~helpmode
:false
3527 ~
source ~trusted
:true ~
modehash)
3530 method paxmark name get
set =
3532 (name
, `
string get
, 1, Action
(
3536 inherit lvsourcebase
3539 m_active
<- MTE.to_int conf
.paxmark
;
3542 method getitemcount
= Array.length
MTE.names
3543 method getitem
n = (MTE.names
.(n), 0)
3544 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3545 ignore
(uioh
, first, pan
);
3546 if not cancel
then set active;
3548 method hasaction
_ = true
3552 let modehash = findkeyhash conf
"info" in
3553 coe (new listview ~zebra
:false ~helpmode
:false
3554 ~
source ~trusted
:true ~
modehash)
3557 method fitmodel name get
set =
3559 (name
, `
string get
, 1, Action
(
3563 inherit lvsourcebase
3566 m_active
<- FMTE.to_int conf
.fitmodel
;
3569 method getitemcount
= Array.length
FMTE.names
3570 method getitem
n = (FMTE.names
.(n), 0)
3571 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3572 ignore
(uioh
, first, pan
);
3573 if not cancel
then set active;
3575 method hasaction
_ = true
3579 let modehash = findkeyhash conf
"info" in
3580 coe (new listview ~zebra
:false ~helpmode
:false
3581 ~
source ~trusted
:true ~
modehash)
3584 method caption
s offset
=
3585 m_l
<- (s, `empty
, offset
, Noaction
) :: m_l
3587 method caption2
s f offset
=
3588 m_l
<- (s, `
string f, offset
, Noaction
) :: m_l
3590 method getitemcount
= Array.length m_a
3593 let tostr = function
3594 | `
int f -> string_of_int
(f ())
3595 | `intws
f -> string_with_suffix_of_int
(f ())
3597 | `
color f -> color_to_string
(f ())
3598 | `
bool (btos, f) -> btos (f ())
3601 let name, t
, offset
, _ = m_a
.(n) in
3602 ((let s = tostr t
in
3604 then Printf.sprintf
"%s\t%s" name s
3608 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3613 match m_a
.(active) with
3614 | _, _, _, Action
f -> f uioh
3615 | _, _, _, Noaction
-> uioh
3626 method hasaction
n =
3628 | _, _, _, Action
_ -> true
3629 | _, _, _, Noaction
-> false
3631 initializer m_active
<- 1
3634 let rec fillsrc prevmode prevuioh
=
3635 let sep () = src#caption
E.s 0 in
3636 let colorp name get
set =
3638 (fun () -> color_to_string
(get
()))
3641 let c = color_of_string
v in
3644 state
.text <- Printf.sprintf
"bad color `%s': %s" v @@ exntos exn
3647 let oldmode = state
.mode
in
3648 let birdseye = isbirdseye state
.mode
in
3650 src#caption
(if birdseye then "Setup (Bird's eye)" else "Setup") 0;
3652 src#
bool "presentation mode"
3653 (fun () -> conf
.presentation
)
3654 (fun v -> setpresentationmode v);
3656 src#
bool "ignore case in searches"
3657 (fun () -> conf
.icase
)
3658 (fun v -> conf
.icase
<- v);
3661 (fun () -> conf
.preload)
3662 (fun v -> conf
.preload <- v);
3664 src#
bool "highlight links"
3665 (fun () -> conf
.hlinks
)
3666 (fun v -> conf
.hlinks
<- v);
3668 src#
bool "under info"
3669 (fun () -> conf
.underinfo
)
3670 (fun v -> conf
.underinfo
<- v);
3672 src#
bool "persistent bookmarks"
3673 (fun () -> conf
.savebmarks
)
3674 (fun v -> conf
.savebmarks
<- v);
3676 src#fitmodel
"fit model"
3677 (fun () -> FMTE.to_string conf
.fitmodel
)
3678 (fun v -> reqlayout conf
.angle
(FMTE.of_int
v));
3680 src#
bool "trim margins"
3681 (fun () -> conf
.trimmargins
)
3682 (fun v -> settrim v conf
.trimfuzz
; fillsrc prevmode prevuioh
);
3684 src#
bool "persistent location"
3685 (fun () -> conf
.jumpback
)
3686 (fun v -> conf
.jumpback
<- v);
3689 src#
int "inter-page space"
3690 (fun () -> conf
.interpagespace
)
3692 conf
.interpagespace
<- n;
3693 docolumns conf
.columns
;
3695 match state
.layout with
3700 state
.maxy <- calcheight
();
3701 let y = getpagey
pageno in
3702 gotoxy state
.x (y + py)
3706 (fun () -> conf
.pagebias
)
3707 (fun v -> conf
.pagebias
<- v);
3709 src#
int "scroll step"
3710 (fun () -> conf
.scrollstep
)
3711 (fun n -> conf
.scrollstep
<- n);
3713 src#
int "horizontal scroll step"
3714 (fun () -> conf
.hscrollstep
)
3715 (fun v -> conf
.hscrollstep
<- v);
3717 src#
int "auto scroll step"
3719 match state
.autoscroll
with
3721 | _ -> conf
.autoscrollstep
)
3723 let n = boundastep state
.winh
n in
3724 if state
.autoscroll
<> None
3725 then state
.autoscroll
<- Some
n;
3726 conf
.autoscrollstep
<- n);
3729 (fun () -> truncate
(conf
.zoom *. 100.))
3730 (fun v -> setzoom ((float v) /. 100.));
3733 (fun () -> conf
.angle
)
3734 (fun v -> reqlayout v conf
.fitmodel
);
3736 src#
int "scroll bar width"
3737 (fun () -> conf
.scrollbw
)
3740 reshape state
.winw state
.winh
;
3743 src#
int "scroll handle height"
3744 (fun () -> conf
.scrollh
)
3745 (fun v -> conf
.scrollh
<- v;);
3747 src#
int "thumbnail width"
3748 (fun () -> conf
.thumbw
)
3750 conf
.thumbw
<- min
4096 v;
3753 leavebirdseye beye
false;
3760 let mode = state
.mode in
3761 src#
string "columns"
3763 match conf
.columns
with
3765 | Cmulti
(multi
, _) -> multicolumns_to_string multi
3766 | Csplit
(count
, _) -> "-" ^ string_of_int count
3769 let n, a, b = multicolumns_of_string
v in
3770 setcolumns mode n a b);
3773 src#caption
"Pixmap cache" 0;
3774 src#int_with_suffix
"size (advisory)"
3775 (fun () -> conf
.memlimit
)
3776 (fun v -> conf
.memlimit
<- v);
3779 (fun () -> Printf.sprintf
"%s bytes, %d tiles"
3780 (string_with_suffix_of_int state
.memused
)
3781 (Hashtbl.length state
.tilemap
)) 1;
3784 src#caption
"Layout" 0;
3785 src#caption2
"Dimension"
3787 Printf.sprintf
"%dx%d (virtual %dx%d)"
3788 state
.winw state
.winh
3793 src#caption2
"Position" (fun () ->
3794 Printf.sprintf
"%dx%d" state
.x state
.y
3797 src#caption2
"Position" (fun () -> describe_location ()) 1
3801 src#
bool ~offset
:0 ~
btos:(fun v -> if v then "(on)" else "(off)")
3802 "Save these parameters as global defaults at exit"
3803 (fun () -> conf
.bedefault
)
3804 (fun v -> conf
.bedefault
<- v)
3808 let btos b = if b then "@Ulguillemet" else "@Urguillemet" in
3809 src#
bool ~offset
:0 ~
btos "Extended parameters"
3810 (fun () -> !showextended)
3811 (fun v -> showextended := v; fillsrc prevmode prevuioh
);
3815 (fun () -> conf
.checkers
)
3816 (fun v -> conf
.checkers
<- v; setcheckers v);
3817 src#
bool "update cursor"
3818 (fun () -> conf
.updatecurs
)
3819 (fun v -> conf
.updatecurs
<- v);
3820 src#
bool "scroll-bar on the left"
3821 (fun () -> conf
.leftscroll
)
3822 (fun v -> conf
.leftscroll
<- v);
3824 (fun () -> conf
.verbose
)
3825 (fun v -> conf
.verbose
<- v);
3826 src#
bool "invert colors"
3827 (fun () -> conf
.invert
)
3828 (fun v -> conf
.invert
<- v);
3830 (fun () -> conf
.maxhfit
)
3831 (fun v -> conf
.maxhfit
<- v);
3833 (fun () -> conf
.pax
!= None
)
3836 then conf
.pax
<- Some
(ref (now
(), 0, 0))
3837 else conf
.pax
<- None
);
3838 src#
string "uri launcher"
3839 (fun () -> conf
.urilauncher
)
3840 (fun v -> conf
.urilauncher
<- v);
3841 src#
string "path launcher"
3842 (fun () -> conf
.pathlauncher
)
3843 (fun v -> conf
.pathlauncher
<- v);
3844 src#
string "tile size"
3845 (fun () -> Printf.sprintf
"%dx%d" conf
.tilew conf
.tileh
)
3848 let w, h = Scanf.sscanf
v "%dx%d" (fun w h -> w, h) in
3849 conf
.tilew
<- max
64 w;
3850 conf
.tileh
<- max
64 h;
3853 state
.text <- Printf.sprintf
"bad tile size `%s': %s"
3856 src#
int "texture count"
3857 (fun () -> conf
.texcount
)
3860 then conf
.texcount
<- v
3861 else impmsg "failed to set texture count please retry later"
3863 src#
int "slice height"
3864 (fun () -> conf
.sliceheight
)
3866 conf
.sliceheight
<- v;
3867 wcmd "sliceh %d" conf
.sliceheight
;
3869 src#
int "anti-aliasing level"
3870 (fun () -> conf
.aalevel
)
3872 conf
.aalevel
<- bound
v 0 8;
3873 state
.anchor <- getanchor
();
3874 opendoc state
.path state
.password;
3876 src#
string "page scroll scaling factor"
3877 (fun () -> string_of_float conf
.pgscale)
3880 let s = float_of_string
v in
3883 state
.text <- Printf.sprintf
3884 "bad page scroll scaling factor `%s': %s" v @@ exntos exn
3887 src#
int "ui font size"
3888 (fun () -> fstate
.fontsize
)
3889 (fun v -> setfontsize (bound
v 5 100));
3890 src#
int "hint font size"
3891 (fun () -> conf
.hfsize
)
3892 (fun v -> conf
.hfsize
<- bound
v 5 100);
3893 colorp "background color"
3894 (fun () -> conf
.bgcolor
)
3895 (fun v -> conf
.bgcolor
<- v; setbgcol v);
3896 src#
bool "crop hack"
3897 (fun () -> conf
.crophack
)
3898 (fun v -> conf
.crophack
<- v);
3899 src#
string "trim fuzz"
3900 (fun () -> irect_to_string conf
.trimfuzz
)
3903 conf
.trimfuzz
<- irect_of_string
v;
3905 then settrim true conf
.trimfuzz
;
3907 state
.text <- Printf.sprintf
"bad irect `%s': %s" v @@ exntos exn
3909 src#
string "throttle"
3911 match conf
.maxwait
with
3912 | None
-> "show place holder if page is not ready"
3915 then "wait for page to fully render"
3917 "wait " ^ string_of_float
time
3918 ^
" seconds before showing placeholder"
3922 let f = float_of_string
v in
3924 then conf
.maxwait
<- None
3925 else conf
.maxwait
<- Some
f
3927 state
.text <- Printf.sprintf
"bad time `%s': %s" v @@ exntos exn
3929 src#
string "ghyll scroll"
3931 match conf
.ghyllscroll
with
3933 | Some nab
-> ghyllscroll_to_string nab
3936 try conf
.ghyllscroll
<- ghyllscroll_of_string
v
3939 state
.text <- Printf.sprintf
"bad ghyll `%s': %s" v msg
3941 state
.text <- Printf.sprintf
"bad ghyll `%s': %s" v @@ exntos exn
3943 src#
string "selection command"
3944 (fun () -> conf
.selcmd
)
3945 (fun v -> conf
.selcmd
<- v);
3946 src#
string "synctex command"
3947 (fun () -> conf
.stcmd
)
3948 (fun v -> conf
.stcmd
<- v);
3949 src#
string "pax command"
3950 (fun () -> conf
.paxcmd
)
3951 (fun v -> conf
.paxcmd
<- v);
3952 src#
string "ask password command"
3953 (fun () -> conf
.passcmd)
3954 (fun v -> conf
.passcmd <- v);
3955 src#
string "save path command"
3956 (fun () -> conf
.savecmd
)
3957 (fun v -> conf
.savecmd
<- v);
3958 src#colorspace
"color space"
3959 (fun () -> CSTE.to_string conf
.colorspace
)
3961 conf
.colorspace
<- CSTE.of_int
v;
3965 src#paxmark
"pax mark method"
3966 (fun () -> MTE.to_string conf
.paxmark
)
3967 (fun v -> conf
.paxmark
<- MTE.of_int
v);
3968 if bousable
() && !opengl_has_pbo
3971 (fun () -> conf
.usepbo
)
3972 (fun v -> conf
.usepbo
<- v);
3973 src#
bool "mouse wheel scrolls pages"
3974 (fun () -> conf
.wheelbypage
)
3975 (fun v -> conf
.wheelbypage
<- v);
3976 src#
bool "open remote links in a new instance"
3977 (fun () -> conf
.riani
)
3978 (fun v -> conf
.riani
<- v);
3979 src#
bool "edit annotations inline"
3980 (fun () -> conf
.annotinline
)
3981 (fun v -> conf
.annotinline
<- v);
3982 src#
bool "coarse positioning in presentation mode"
3983 (fun () -> conf
.coarseprespos
)
3984 (fun v -> conf
.coarseprespos
<- v);
3988 src#caption
"Document" 0;
3989 List.iter
(fun (_, s) -> src#caption
s 1) state
.docinfo
;
3990 src#caption2
"Pages"
3991 (fun () -> string_of_int state
.pagecount
) 1;
3992 src#caption2
"Dimensions"
3993 (fun () -> string_of_int
(List.length state
.pdims
)) 1;
3997 src#caption
"Trimmed margins" 0;
3998 src#caption2
"Dimensions"
3999 (fun () -> string_of_int
(List.length state
.pdims
)) 1;
4003 src#caption
"OpenGL" 0;
4004 src#caption
(Printf.sprintf
"Vendor\t%s" (GlMisc.get_string `vendor
)) 1;
4005 src#caption
(Printf.sprintf
"Renderer\t%s" (GlMisc.get_string `renderer
)) 1;
4008 src#caption
"Location" 0;
4009 if nonemptystr state
.origin
4010 then src#caption
("Orign\t" ^ mbtoutf8 state
.origin
) 1;
4011 src#caption
("Path\t" ^ mbtoutf8 state
.path) 1;
4013 src#reset prevmode prevuioh
;
4018 let prevmode = state
.mode
4019 and prevuioh
= state
.uioh in
4020 fillsrc prevmode prevuioh
;
4021 let source = (src :> lvsource
) in
4022 let modehash = findkeyhash conf
"info" in
4023 state
.uioh <- coe (object (self)
4024 inherit listview ~zebra
:false ~helpmode
:false
4025 ~
source ~trusted
:true ~
modehash as super
4026 val mutable m_prevmemused
= 0
4027 method! infochanged
= function
4029 if m_prevmemused
!= state
.memused
4031 m_prevmemused
<- state
.memused
;
4032 G.postRedisplay "memusedchanged";
4034 | Pdim
-> G.postRedisplay "pdimchanged"
4035 | Docinfo
-> fillsrc prevmode prevuioh
4037 method! key key mask
=
4038 if not
(Wsi.withctrl mask
)
4041 | @left | @kpleft
-> coe (self#updownlevel ~
-1)
4042 | @right
| @kpright
-> coe (self#updownlevel
1)
4043 | _ -> super#
key key mask
4044 else super#
key key mask
4046 G.postRedisplay "info";
4052 inherit lvsourcebase
4053 method getitemcount
= Array.length state
.help
4055 let s, l, _ = state
.help
.(n) in
4058 method exit ~
uioh ~cancel ~
active ~
first ~pan
=
4062 match state
.help
.(active) with
4063 | _, _, Action
f -> Some
(f uioh)
4064 | _, _, Noaction
-> Some
uioh
4073 method hasaction
n =
4074 match state
.help
.(n) with
4075 | _, _, Action
_ -> true
4076 | _, _, Noaction
-> false
4082 let modehash = findkeyhash conf
"help" in
4084 state
.uioh <- coe (new listview
4085 ~zebra
:false ~helpmode
:true
4086 ~
source ~trusted
:true ~
modehash);
4087 G.postRedisplay "help";
4093 inherit lvsourcebase
4094 val mutable m_items
= E.a
4096 method getitemcount
= 1 + Array.length m_items
4101 else m_items
.(n-1), 0
4103 method exit ~
uioh ~cancel ~
active ~
first ~pan
=
4108 then Buffer.clear state
.errmsgs
;
4115 method hasaction
n =
4119 state
.newerrmsgs
<- false;
4120 let l = Str.split newlinere
(Buffer.contents state
.errmsgs
) in
4121 m_items
<- Array.of_list
l
4130 let source = (msgsource :> lvsource
) in
4131 let modehash = findkeyhash conf
"listview" in
4132 state
.uioh <- coe (object
4133 inherit listview ~zebra
:false ~helpmode
:false
4134 ~
source ~trusted
:false ~
modehash as super
4137 then msgsource#reset
;
4140 G.postRedisplay "msgs";
4144 let editor = getenvwithdef
"EDITOR" E.s in
4148 let tmppath = Filename.temp_file
"llpp" "note" in
4151 let oc = open_out
tmppath in
4155 let execstr = editor ^
" " ^
tmppath in
4157 match spawn
execstr [] with
4158 | (exception exn
) ->
4159 impmsg "spawn(%S) failed: %s" execstr @@ exntos exn
;
4162 match Unix.waitpid
[] pid with
4163 | (exception exn
) ->
4164 impmsg "waitpid(%d) failed: %s" pid @@ exntos exn
;
4168 | Unix.WEXITED
0 -> filecontents
tmppath
4170 impmsg "editor process(%s) exited abnormally: %d" execstr n;
4172 | Unix.WSIGNALED
n ->
4173 impmsg "editor process(%s) was killed by signal %d" execstr n;
4175 | Unix.WSTOPPED
n ->
4176 impmsg "editor(%s) process was stopped by signal %d" execstr n;
4179 match Unix.unlink
tmppath with
4180 | (exception exn
) ->
4181 impmsg "failed to ulink %S: %s" tmppath @@ exntos exn
;
4186 let enterannotmode opaque slinkindex
=
4189 inherit lvsourcebase
4190 val mutable m_text
= E.s
4191 val mutable m_items
= E.a
4193 method getitemcount
= Array.length m_items
4196 let label, _func
= m_items
.(n) in
4199 method exit ~
uioh ~cancel ~
active ~
first ~pan
=
4200 ignore
(uioh, first, pan
);
4203 let _label, func
= m_items
.(active) in
4208 method hasaction
n = nonemptystr
@@ fst m_items
.(n)
4211 let rec split accu b i
=
4213 if p = String.length
s
4214 then (String.sub
s b (p-b), unit) :: accu
4216 if (i
> 70 && s.[p] = ' '
) || s.[p] = '
\r'
|| s.[p] = '
\n'
4218 let ss = if i
= 0 then E.s else String.sub
s b i
in
4219 split ((ss, unit)::accu) (p+1) 0
4224 wcmd "freepage %s" (~
> opaque);
4226 Hashtbl.fold (fun key opaque'
accu ->
4227 if opaque'
= opaque'
4228 then key :: accu else accu) state
.pagemap
[]
4230 List.iter
(Hashtbl.remove state
.pagemap
) keys;
4232 gotoxy state
.x state
.y
4235 delannot
opaque slinkindex
;
4238 let edit inline
() =
4243 modannot
opaque slinkindex
s;
4249 let mode = state
.mode in
4252 ("annotation: ", m_text
, None
, textentry, update, true),
4253 fun _ -> state
.mode <- mode);
4257 let s = getusertext m_text
in
4262 ( "[Copy]", fun () -> selstring m_text
)
4263 :: ("[Delete]", dele)
4264 :: ("[Edit]", edit conf
.annotinline
)
4266 :: split [] 0 0 |> List.rev
|> Array.of_list
4273 let s = getannotcontents
opaque slinkindex
in
4276 let source = (msgsource :> lvsource
) in
4277 let modehash = findkeyhash conf
"listview" in
4278 state
.uioh <- coe (object
4279 inherit listview ~zebra
:false ~helpmode
:false
4280 ~
source ~trusted
:false ~
modehash
4282 G.postRedisplay "enterannotmode";
4285 let gotounder under =
4286 let getpath filename
=
4288 if nonemptystr filename
4290 if Filename.is_relative filename
4292 let dir = Filename.dirname state
.path in
4294 if Filename.is_implicit
dir
4295 then Filename.concat
(Sys.getcwd
()) dir
4298 Filename.concat
dir filename
4302 if Sys.file_exists
path
4307 | Ulinkgoto
(pageno, top) ->
4312 if conf
.presentation
&& conf
.coarseprespos
4316 gotopage1 pageno top;
4319 | Ulinkuri
s -> gotouri
s
4321 | Uremote
(filename
, pageno) ->
4322 let path = getpath filename
in
4327 let command = Printf.sprintf
"%s -page %d %S" !selfexec pageno path in
4328 match spawn
command [] with
4330 | (exception exn
) ->
4331 dolog
"failed to execute `%s': %s" command @@ exntos exn
4333 let anchor = getanchor
() in
4334 let ranchor = state
.path, state
.password, anchor, state
.origin
in
4335 state
.origin
<- E.s;
4336 state
.anchor <- (pageno, 0.0, 0.0);
4337 state
.ranchors
<- ranchor :: state
.ranchors
;
4340 else impmsg "cannot find %s" filename
4342 | Uremotedest
(filename
, destname
) ->
4343 let path = getpath filename
in
4348 let command = !selfexec ^
" " ^
path ^
" -dest " ^ destname
in
4349 match spawn
command [] with
4350 | (exception exn
) ->
4351 dolog
"failed to execute `%s': %s" command @@ exntos exn
4354 let anchor = getanchor
() in
4355 let ranchor = state
.path, state
.password, anchor, state
.origin
in
4356 state
.origin
<- E.s;
4357 state
.nameddest
<- destname
;
4358 state
.ranchors
<- ranchor :: state
.ranchors
;
4361 else impmsg "cannot find %s" filename
4363 | Uunexpected
_ | Ulaunch
_ | Unamed
_ | Utext
_ | Unone
-> ()
4364 | Uannotation
(opaque, slinkindex
) -> enterannotmode opaque slinkindex
4367 let gotooutline (_, _, kind
) =
4371 let (pageno, y, _) = anchor in
4373 (if conf
.presentation
then (pageno, y, 1.0) else anchor)
4377 | Ouri
uri -> gotounder (Ulinkuri
uri)
4378 | Olaunch cmd
-> gotounder (Ulaunch cmd
)
4379 | Oremote remote
-> gotounder (Uremote remote
)
4380 | Ohistory hist
-> gotohist hist
4381 | Oremotedest remotedest
-> gotounder (Uremotedest remotedest
)
4384 class outlinesoucebase fetchoutlines
= object (self)
4385 inherit lvsourcebase
4386 val mutable m_items
= E.a
4387 val mutable m_minfo
= E.a
4388 val mutable m_orig_items
= E.a
4389 val mutable m_orig_minfo
= E.a
4390 val mutable m_narrow_patterns
= []
4391 val mutable m_gen
= -1
4393 method getitemcount
= Array.length m_items
4396 let s, n, _ = m_items
.(n) in
4399 method exit ~
(uioh:uioh) ~cancel ~
active ~
(first:int) ~pan
:
4401 ignore
(uioh, first);
4403 if m_narrow_patterns
= []
4404 then m_orig_items
, m_orig_minfo
4405 else m_items
, m_minfo
4412 gotooutline m_items
.(active);
4420 method hasaction
(_:int) = true
4423 if Array.length m_items
!= Array.length m_orig_items
4426 match m_narrow_patterns
with
4428 | many
-> String.concat
"@Uellipsis" (List.rev many
)
4430 "Narrowed to " ^
s ^
" (ctrl-u to restore)"
4434 match m_narrow_patterns
with
4437 | head
:: _ -> "@Uellipsis" ^ head
4439 method narrow
pattern =
4440 match Str.regexp_case_fold
pattern with
4441 | (exception _) -> ()
4443 let rec loop accu minfo n =
4446 m_items
<- Array.of_list
accu;
4447 m_minfo
<- Array.of_list
minfo;
4450 let (s, _, _) as o = m_items
.(n) in
4452 match Str.search_forward re
s 0 with
4453 | (exception Not_found
) -> accu, minfo
4454 | first -> o :: accu, (first, Str.match_end
()) :: minfo
4456 loop accu minfo (n-1)
4458 loop [] [] (Array.length m_items
- 1)
4460 method! getminfo
= m_minfo
4463 m_orig_items
<- fetchoutlines
();
4464 m_minfo
<- m_orig_minfo
;
4465 m_items
<- m_orig_items
4467 method add_narrow_pattern
pattern =
4468 m_narrow_patterns
<- pattern :: m_narrow_patterns
4470 method del_narrow_pattern
=
4471 match m_narrow_patterns
with
4472 | _ :: rest
-> m_narrow_patterns
<- rest
4477 match m_narrow_patterns
with
4478 | pattern :: [] -> self#narrow
pattern; pattern
4480 List.fold_left
(fun accu pattern ->
4481 self#narrow
pattern;
4482 pattern ^
"@Uellipsis" ^
accu) E.s list
4484 method calcactive
(_:anchor) = 0
4486 method reset
anchor items =
4487 if state
.gen
!= m_gen
4489 m_orig_items
<- items;
4491 m_narrow_patterns
<- [];
4493 m_orig_minfo
<- E.a;
4497 if items != m_orig_items
4499 m_orig_items
<- items;
4500 if m_narrow_patterns
== []
4501 then m_items
<- items;
4504 let active = self#calcactive
anchor in
4506 m_first
<- firstof m_first
active
4510 let outlinesource fetchoutlines
=
4512 inherit outlinesoucebase fetchoutlines
4513 method! calcactive
anchor =
4514 let rely = getanchory anchor in
4515 let rec loop n best bestd
=
4516 if n = Array.length m_items
4519 let _, _, kind
= m_items
.(n) in
4522 let orely = getanchory anchor in
4523 let d = abs
(orely - rely) in
4526 else loop (n+1) best bestd
4527 | Onone
| Oremote
_ | Olaunch
_
4528 | Oremotedest
_ | Ouri
_ | Ohistory
_ ->
4529 loop (n+1) best bestd
4535 let enteroutlinemode, enterbookmarkmode
, enterhistmode
=
4536 let mkselector sourcetype
=
4537 let fetchoutlines () =
4538 match sourcetype
with
4539 | `bookmarks
-> Array.of_list state
.bookmarks
4540 | `outlines
-> state
.outlines
4541 | `history
-> genhistoutlines ()
4544 if sourcetype
= `history
4545 then new outlinesoucebase
fetchoutlines
4546 else outlinesource fetchoutlines
4549 let outlines = fetchoutlines () in
4550 if Array.length
outlines = 0
4552 showtext ' ' errmsg
;
4556 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
4557 let anchor = getanchor
() in
4558 source#reset
anchor outlines;
4559 state
.text <- source#greetmsg
;
4561 coe (new outlinelistview ~zebra
:(sourcetype
=`history
) ~
source);
4562 G.postRedisplay "enter selector";
4565 let mkenter sourcetype errmsg
=
4566 let enter = mkselector sourcetype
in
4567 fun () -> enter errmsg
4569 (**)mkenter `
outlines "document has no outline"
4570 , mkenter `bookmarks
"document has no bookmarks (yet)"
4571 , mkenter `history
"history is empty"
4574 let quickbookmark ?title
() =
4575 match state
.layout with
4581 let tm = Unix.localtime
(now
()) in
4583 "Quick (page %d) (bookmarked at %02d/%02d/%d %02d:%02d)"
4587 (tm.Unix.tm_year
+ 1900)
4590 | Some
title -> title
4592 state
.bookmarks
<- (title, 0, Oanchor
(getanchor1
l)) :: state
.bookmarks
4595 let setautoscrollspeed step goingdown
=
4596 let incr = max
1 ((abs step
) / 2) in
4597 let incr = if goingdown
then incr else -incr in
4598 let astep = boundastep state
.winh
(step
+ incr) in
4599 state
.autoscroll
<- Some
astep;
4603 match conf
.columns
with
4605 | Csingle
_ | Cmulti
_ -> state
.x != 0 || conf
.zoom > 1.0
4608 let panbound x = bound
x (-state
.w) (wadjsb () + state
.winw
);;
4610 let existsinrow pageno (columns
, coverA
, coverB
) p =
4611 let last = ((pageno - coverA
) mod columns
) + columns
in
4612 let rec any = function
4615 if l.pageno = coverA
- 1 || l.pageno = state
.pagecount
- coverB
4619 then (if l.pageno = last then false else any rest
)
4627 match state
.layout with
4629 let pageno = page_of_y state
.y in
4630 gotoghyll (getpagey
(pageno+1))
4632 match conf
.columns
with
4634 if conf
.presentation
&& rest
== [] && l.pageh
> l.pagey + l.pagevh
4636 let y = clamp (pgscale state
.winh
) in
4639 let pageno = min
(l.pageno+1) (state
.pagecount
-1) in
4640 gotoghyll (getpagey
pageno)
4641 | Cmulti
((c, _, _) as cl
, _) ->
4642 if conf
.presentation
4643 && (existsinrow l.pageno cl
4644 (fun l -> l.pageh
> l.pagey + l.pagevh))
4646 let y = clamp (pgscale state
.winh
) in
4649 let pageno = min
(l.pageno+c) (state
.pagecount
-1) in
4650 gotoghyll (getpagey
pageno)
4652 if l.pageno < state
.pagecount
- 1 || l.pagecol
< n - 1
4654 let pagey, pageh
= getpageyh
l.pageno in
4655 let pagey = pagey + pageh
* l.pagecol
in
4656 let ips = if l.pagecol
= 0 then 0 else conf
.interpagespace
in
4657 gotoghyll (pagey + pageh
+ ips)
4661 match state
.layout with
4663 let pageno = page_of_y state
.y in
4664 gotoghyll (getpagey
(pageno-1))
4666 match conf
.columns
with
4668 if conf
.presentation
&& l.pagey != 0
4670 gotoghyll (clamp (pgscale ~
-(state
.winh
)))
4672 let pageno = max
0 (l.pageno-1) in
4673 gotoghyll (getpagey
pageno)
4674 | Cmulti
((c, _, coverB
) as cl
, _) ->
4675 if conf
.presentation
&&
4676 (existsinrow l.pageno cl
(fun l -> l.pagey != 0))
4678 gotoghyll (clamp (pgscale ~
-(state
.winh
)))
4681 if l.pageno = state
.pagecount
- coverB
4685 let pageno = max
0 (l.pageno-decr) in
4686 gotoghyll (getpagey
pageno)
4694 let pageno = max
0 (l.pageno-1) in
4695 let pagey, pageh
= getpageyh
pageno in
4698 let pagey, pageh
= getpageyh
l.pageno in
4699 pagey + pageh
* (l.pagecol
-1) - conf
.interpagespace
4705 if emptystr conf
.savecmd
4706 then error
"don't know where to save modified document"
4708 let savecmd = Str.global_replace percentsre state
.path conf
.savecmd in
4711 (fun s -> error
"failed to obtain path to the saved copy: %s" s)
4716 let tmp = path ^
".tmp" in
4718 Unix.rename
tmp path;
4721 let viewkeyboard key mask
=
4723 let mode = state
.mode in
4724 state
.mode <- Textentry
(te, fun _ -> state
.mode <- mode);
4727 G.postRedisplay "view:enttext"
4729 let ctrl = Wsi.withctrl mask
in
4730 let key = Wsi.keypadtodigitkey
key in
4735 if hasunsavedchanges
()
4739 if conf
.angle
mod 360 = 0 && not
(isbirdseye state
.mode)
4741 state
.mode <- LinkNav
(Ltgendir
0);
4742 gotoxy state
.x state
.y;
4744 else impmsg "keyboard link navigation does not work under rotation"
4747 begin match state
.mstate
with
4750 G.postRedisplay "kill rect";
4753 | Mscrolly
| Mscrollx
4756 begin match state
.mode with
4759 G.postRedisplay "esc leave linknav"
4763 match state
.ranchors
with
4765 | (path, password, anchor, origin
) :: rest
->
4766 state
.ranchors
<- rest
;
4767 state
.anchor <- anchor;
4768 state
.origin
<- origin
;
4769 state
.nameddest
<- E.s;
4770 opendoc path password
4775 gotoghyll (getnav ~
-1)
4786 Hashtbl.iter
(fun _ opaque ->
4788 Hashtbl.clear state
.prects
) state
.pagemap
;
4789 G.postRedisplay "dehighlight";
4791 | @slash
| @question
->
4792 let ondone isforw
s =
4793 cbput state
.hists
.pat
s;
4794 state
.searchpattern
<- s;
4797 let s = String.make
1 (Char.chr
key) in
4798 enttext (s, E.s, Some
(onhist state
.hists
.pat
),
4799 textentry, ondone (key = @slash
), true)
4801 | @plus
| @kpplus
| @equals
when ctrl ->
4802 let incr = if conf
.zoom +. 0.01 > 0.1 then 0.1 else 0.01 in
4803 pivotzoom (conf
.zoom +. incr)
4805 | @plus
| @kpplus
->
4808 try int_of_string
s with exn
->
4809 state
.text <- Printf.sprintf
"bad integer `%s': %s" s @@ exntos exn
;
4815 state
.text <- "page bias is now " ^ string_of_int
n;
4818 enttext ("page bias: ", E.s, None
, intentry, ondone, true)
4820 | @minus
| @kpminus
when ctrl ->
4821 let decr = if conf
.zoom -. 0.1 < 0.1 then 0.01 else 0.1 in
4822 pivotzoom (max
0.01 (conf
.zoom -. decr))
4824 | @minus
| @kpminus
->
4825 let ondone msg
= state
.text <- msg
in
4827 "option [acfhilpstvxACFPRSZTISM]: ", E.s, None
,
4828 optentry state
.mode, ondone, true
4833 then gotoxy 0 state
.y
4836 | (@1 | @2) when ctrl && conf
.fitmodel
!= FitPage
-> (* ctrl-1/2 *)
4838 match conf
.columns
with
4839 | Csingle
_ | Cmulti
_ -> 1
4840 | Csplit
(n, _) -> n
4842 let h = state
.winh
-
4843 conf
.interpagespace
lsl (if conf
.presentation
then 1 else 0)
4845 let zoom = zoomforh state
.winw
h (vscrollw ()) cols in
4846 if zoom > 0.0 && (key = @2 || zoom < 1.0)
4851 match conf
.fitmodel
with
4852 | FitWidth
-> FitProportional
4853 | FitProportional
-> FitPage
4854 | FitPage
-> FitWidth
4856 state
.text <- "fit model: " ^
FMTE.to_string
fm;
4857 reqlayout conf
.angle
fm
4859 | @4 when ctrl -> (* ctrl-4 *)
4860 let zoom = getmaxw
() /. float state
.winw
in
4861 if zoom > 0.0 then setzoom zoom
4869 | (48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57)
4870 when not
ctrl -> (* 0..9 *)
4873 try int_of_string
s with exn
->
4874 state
.text <- Printf.sprintf
"bad integer `%s': %s" s @@ exntos exn
;
4880 cbput state
.hists
.pag
(string_of_int
n);
4881 gotopage1 (n + conf
.pagebias
- 1) 0;
4884 let pageentry text key =
4885 match Char.unsafe_chr
key with
4886 | '
g'
-> TEdone
text
4887 | _ -> intentry text key
4889 let text = String.make
1 (Char.chr
key) in
4890 enttext (":", text, Some
(onhist state
.hists
.pag
),
4891 pageentry, ondone, true)
4894 conf
.scrollb
<- if conf
.scrollb
= 0 then (scrollbvv
lor scrollbhv
) else 0;
4895 reshape state
.winw state
.winh
;
4898 state
.bzoom
<- not state
.bzoom
;
4900 showtext ' '
("block zoom " ^
if state
.bzoom
then "on" else "off")
4903 conf
.hlinks
<- not conf
.hlinks
;
4904 state
.text <- "highlightlinks " ^
if conf
.hlinks
then "on" else "off";
4905 G.postRedisplay "toggle highlightlinks";
4908 if conf
.angle
mod 360 = 0
4910 state
.glinks
<- true;
4911 let mode = state
.mode in
4914 (":", E.s, None
, linknentry, linknact gotounder, false),
4916 state
.glinks
<- false;
4920 G.postRedisplay "view:linkent(F)"
4922 else impmsg "hint mode does not work under rotation"
4925 state
.glinks
<- true;
4926 let mode = state
.mode in
4927 state
.mode <- Textentry
(
4929 ":", E.s, None
, linknentry, linknact (fun under ->
4930 selstring (undertext under);
4934 state
.glinks
<- false;
4938 G.postRedisplay "view:linkent"
4941 begin match state
.autoscroll
with
4943 conf
.autoscrollstep
<- step
;
4944 state
.autoscroll
<- None
4946 if conf
.autoscrollstep
= 0
4947 then state
.autoscroll
<- Some
1
4948 else state
.autoscroll
<- Some conf
.autoscrollstep
4952 launchpath () (* XXX where do error messages go? *)
4955 setpresentationmode (not conf
.presentation
);
4956 showtext ' '
("presentation mode " ^
4957 if conf
.presentation
then "on" else "off");
4960 if List.mem
Wsi.Fullscreen state
.winstate
4961 then Wsi.reshape conf
.cwinw conf
.cwinh
4962 else Wsi.fullscreen
()
4965 search state
.searchpattern
false
4968 search state
.searchpattern
true
4971 begin match state
.layout with
4974 gotoghyll (getpagey
l.pageno)
4980 | @delete
| @kpdelete
-> (* delete *)
4984 showtext ' '
(describe_location ());
4987 begin match state
.layout with
4990 Wsi.reshape (l.pagew
+ vscrollw ()) l.pageh
;
4995 enterbookmarkmode
()
5003 | @e when Buffer.length state
.errmsgs
> 0 ->
5008 match state
.layout with
5013 (s, 0, Oanchor
(getanchor1
l)) :: state
.bookmarks
5016 enttext ("bookmark: ", E.s, None
, textentry, ondone, true)
5020 showtext ' '
"Quick bookmark added";
5023 begin match state
.layout with
5025 let rect = getpdimrect
l.pagedimno
in
5029 (truncate
(1.8 *. (rect.(1) -. rect.(0))),
5030 truncate
(1.2 *. (rect.(3) -. rect.(0))))
5032 (truncate
(rect.(1) -. rect.(0)),
5033 truncate
(rect.(3) -. rect.(0)))
5035 let w = truncate
((float w)*.conf
.zoom)
5036 and h = truncate
((float h)*.conf
.zoom) in
5039 state
.anchor <- getanchor
();
5040 Wsi.reshape (w + vscrollw ()) (h + conf
.interpagespace
)
5042 G.postRedisplay "z";
5047 | @x -> state
.roam
()
5050 reqlayout (conf
.angle
+
5051 (if key = @Gt
then 30 else -30)) conf
.fitmodel
5055 bound
(conf
.colorscale
+. (if key = 93 then 0.1 else -0.1)) 0.0 1.0
5057 G.postRedisplay "brightness";
5059 | @c when state
.mode = View
->
5064 let m = (wadjsb () + state
.winw
- state
.w) / 2 in
5065 gotoxy_and_clear_text m state
.y
5069 match state
.prevcolumns
with
5070 | None
-> (1, 0, 0), 1.0
5071 | Some
(columns
, z
) ->
5074 | Csplit
(c, _) -> -c, 0, 0
5075 | Cmulti
((c, a, b), _) -> c, a, b
5076 | Csingle
_ -> 1, 0, 0
5080 setcolumns View
c a b;
5083 | @down
| @up
when ctrl && Wsi.withshift mask
->
5084 let zoom, x = state
.prevzoom
in
5088 | @k
| @up
| @kpup
->
5089 begin match state
.autoscroll
with
5091 begin match state
.mode with
5092 | Birdseye beye
-> upbirdseye 1 beye
5097 then gotoxy_and_clear_text state
.x (clamp ~
-(state
.winh
/2))
5099 if not
(Wsi.withshift mask
) && conf
.presentation
5101 else gotoghyll1 true (clamp (-conf
.scrollstep
))
5105 setautoscrollspeed n false
5108 | @j
| @down
| @kpdown
->
5109 begin match state
.autoscroll
with
5111 begin match state
.mode with
5112 | Birdseye beye
-> downbirdseye 1 beye
5117 then gotoxy_and_clear_text state
.x (clamp (state
.winh
/2))
5119 if not
(Wsi.withshift mask
) && conf
.presentation
5121 else gotoghyll1 true (clamp (conf
.scrollstep
))
5125 setautoscrollspeed n true
5128 | @left | @right
| @kpleft
| @kpright
when not
(Wsi.withalt mask
) ->
5134 else conf
.hscrollstep
5136 let dx = if key = @left || key = @kpleft
then dx else -dx in
5137 gotoxy_and_clear_text (panbound (state
.x + dx)) state
.y
5140 G.postRedisplay "left/right"
5143 | @prior
| @kpprior
->
5147 match state
.layout with
5149 | l :: _ -> state
.y - l.pagey
5151 clamp (pgscale (-state
.winh
))
5155 | @next | @kpnext
->
5159 match List.rev state
.layout with
5161 | l :: _ -> getpagey
l.pageno
5163 clamp (pgscale state
.winh
)
5167 | @g | @home
| @kphome
->
5170 | @G
| @jend
| @kpend
->
5172 gotoghyll (clamp state
.maxy)
5174 | @right
| @kpright
when Wsi.withalt mask
->
5175 gotoghyll (getnav 1)
5176 | @left | @kpleft
when Wsi.withalt mask
->
5177 gotoghyll (getnav ~
-1)
5182 | @v when conf
.debug
->
5185 match getopaque l.pageno with
5188 let x0, y0, x1, y1 = pagebbox
opaque in
5189 let rect = (float x0, float y0,
5192 float x0, float y1) in
5194 let color = (0.0, 0.0, 1.0 /. (l.pageno mod 3 |> float), 0.5) in
5195 state
.rects
<- (l.pageno, color, rect) :: state
.rects
;
5197 G.postRedisplay "v";
5200 let mode = state
.mode in
5201 let cmd = ref E.s in
5202 let onleave = function
5203 | Cancel
-> state
.mode <- mode
5206 match getopaque l.pageno with
5207 | Some
opaque -> pipesel opaque !cmd
5208 | None
-> ()) state
.layout;
5212 cbput state
.hists
.sel
s;
5216 "| ", !cmd, Some
(onhist state
.hists
.sel
), textentry, ondone, true
5218 G.postRedisplay "|";
5219 state
.mode <- Textentry
(te, onleave);
5222 vlog "huh? %s" (Wsi.keyname
key)
5225 let linknavkeyboard key mask
linknav =
5226 let getpage pageno =
5227 let rec loop = function
5229 | l :: _ when l.pageno = pageno -> Some
l
5230 | _ :: rest
-> loop rest
5231 in loop state
.layout
5233 let doexact (pageno, n) =
5234 match getopaque pageno, getpage pageno with
5235 | Some
opaque, Some
l ->
5236 if key = @enter || key = @kpenter
5238 let under = getlink
opaque n in
5239 G.postRedisplay "link gotounder";
5246 Some
(findlink
opaque LDfirst
), -1
5249 Some
(findlink
opaque LDlast
), 1
5252 Some
(findlink
opaque (LDleft
n)), -1
5255 Some
(findlink
opaque (LDright
n)), 1
5258 Some
(findlink
opaque (LDup
n)), -1
5261 Some
(findlink
opaque (LDdown
n)), 1
5266 begin match findpwl
l.pageno dir with
5270 state
.mode <- LinkNav
(Ltgendir
dir);
5271 let y, h = getpageyh
pageno in
5274 then y + h - state
.winh
5279 begin match getopaque pageno, getpage pageno with
5280 | Some
opaque, Some
_ ->
5282 let ld = if dir > 0 then LDfirst
else LDlast
in
5285 begin match link with
5287 showlinktype (getlink
opaque m);
5288 state
.mode <- LinkNav
(Ltexact
(pageno, m));
5289 G.postRedisplay "linknav jpage";
5290 | Lnotfound
-> notfound dir
5296 begin match opt with
5297 | Some Lnotfound
-> pwl l dir;
5298 | Some
(Lfound
m) ->
5302 let _, y0, _, y1 = getlinkrect
opaque m in
5304 then gotopage1 l.pageno y0
5306 let d = fstate
.fontsize
+ 1 in
5307 if y1 - l.pagey > l.pagevh - d
5308 then gotopage1 l.pageno (y1 - state
.winh
- hscrollh () + d)
5309 else G.postRedisplay "linknav";
5311 showlinktype (getlink
opaque m);
5312 state
.mode <- LinkNav
(Ltexact
(l.pageno, m));
5315 | None
-> viewkeyboard key mask
5317 | _ -> viewkeyboard key mask
5322 G.postRedisplay "leave linknav"
5326 | Ltgendir
_ | Ltnotready
_ -> viewkeyboard key mask
5327 | Ltexact exact
-> doexact exact
5330 let keyboard key mask
=
5331 if (key = @g && Wsi.withctrl mask
) && not
(istextentry state
.mode)
5332 then wcmd "interrupt"
5333 else state
.uioh <- state
.uioh#
key key mask
5336 let birdseyekeyboard key mask
5337 ((oconf
, leftx
, pageno, hooverpageno
, anchor) as beye
) =
5339 match conf
.columns
with
5341 | Cmulti
((c, _, _), _) -> c
5342 | Csplit
_ -> failwith
"bird's eye split mode"
5344 let pgh layout = List.fold_left
5345 (fun m l -> max
l.pageh
m) state
.winh
layout in
5347 | @l when Wsi.withctrl mask
->
5348 let y, h = getpageyh
pageno in
5349 let top = (state
.winh
- h) / 2 in
5350 gotoxy state
.x (max
0 (y - top))
5351 | @enter | @kpenter
-> leavebirdseye beye
false
5352 | @escape
-> leavebirdseye beye
true
5353 | @up
-> upbirdseye incr beye
5354 | @down
-> downbirdseye incr beye
5355 | @left -> upbirdseye 1 beye
5356 | @right
-> downbirdseye 1 beye
5359 begin match state
.layout with
5363 state
.mode <- Birdseye
(
5364 oconf
, leftx
, l.pageno, hooverpageno
, anchor
5366 gotopage1 l.pageno 0;
5369 let layout = layout state
.x (state
.y-state
.winh
)
5371 (pgh state
.layout) in
5373 | [] -> gotoxy state
.x (clamp (-state
.winh
))
5375 state
.mode <- Birdseye
(
5376 oconf
, leftx
, l.pageno, hooverpageno
, anchor
5378 gotopage1 l.pageno 0
5381 | [] -> gotoxy state
.x (clamp (-state
.winh
))
5385 begin match List.rev state
.layout with
5387 let layout = layout state
.x
5388 (state
.y + (pgh state
.layout))
5389 state
.winw state
.winh
in
5390 begin match layout with
5392 let incr = l.pageh
- l.pagevh in
5397 oconf
, leftx
, state
.pagecount
- 1, hooverpageno
, anchor
5399 G.postRedisplay "birdseye pagedown";
5401 else gotoxy state
.x (clamp (incr + conf
.interpagespace
*2));
5405 Birdseye
(oconf
, leftx
, l.pageno, hooverpageno
, anchor);
5406 gotopage1 l.pageno 0;
5409 | [] -> gotoxy state
.x (clamp state
.winh
)
5413 state
.mode <- Birdseye
(oconf
, leftx
, 0, hooverpageno
, anchor);
5417 let pageno = state
.pagecount
- 1 in
5418 state
.mode <- Birdseye
(oconf
, leftx
, pageno, hooverpageno
, anchor);
5419 if not
(pagevisible state
.layout pageno)
5422 match List.rev state
.pdims
with
5424 | (_, _, h, _) :: _ -> h
5428 (max
0 (getpagey
pageno - (state
.winh
- h - conf
.interpagespace
)))
5429 else G.postRedisplay "birdseye end";
5431 | _ -> viewkeyboard key mask
5436 match state
.mode with
5437 | Textentry
_ -> scalecolor 0.4
5439 | View
-> scalecolor 1.0
5440 | Birdseye
(_, _, pageno, hooverpageno
, _) ->
5441 if l.pageno = hooverpageno
5444 if l.pageno = pageno
5446 let c = scalecolor 1.0 in
5448 GlDraw.line_width
3.0;
5449 let dispx = xadjsb () + l.pagedispx in
5451 (float (dispx-1)) (float (l.pagedispy-1))
5452 (float (dispx+l.pagevw+1))
5453 (float (l.pagedispy+l.pagevh+1))
5455 GlDraw.line_width
1.0;
5464 let postdrawpage l linkindexbase
=
5465 match getopaque l.pageno with
5467 if tileready l l.pagex
l.pagey
5469 let x = l.pagedispx - l.pagex
+ xadjsb ()
5470 and y = l.pagedispy - l.pagey in
5472 match conf
.columns
with
5473 | Csingle
_ | Cmulti
_ ->
5474 (if conf
.hlinks
then 1 else 0)
5476 && not
(isbirdseye state
.mode) then 2 else 0)
5480 match state
.mode with
5481 | Textentry
((_, s, _, _, _, _), _) when state
.glinks
-> s
5487 Hashtbl.find_all state
.prects
l.pageno |>
5488 List.iter
(fun vals
-> drawprect
opaque x y vals
);
5489 let n = postprocess
opaque hlmask x y (linkindexbase
, s, conf
.hfsize
) in
5491 then (state
.redisplay
<- true; 0)
5497 let scrollindicator () =
5498 let sbw, ph
, sh = state
.uioh#
scrollph in
5499 let sbh, pw, sw = state
.uioh#scrollpw
in
5504 else ((state
.winw
- sbw), state
.winw
, 0)
5507 GlDraw.color (0.64, 0.64, 0.64);
5508 filledrect (float x0) 0. (float x1) (float state
.winh
);
5510 (float hx0
) (float (state
.winh
- sbh))
5511 (float (hx0
+ wadjsb () + state
.winw
)) (float state
.winh
)
5513 GlDraw.color (0.0, 0.0, 0.0);
5515 filledrect (float x0) ph
(float x1) (ph
+. sh);
5516 let pw = pw +. float hx0
in
5517 filledrect pw (float (state
.winh
- sbh)) (pw +. sw) (float state
.winh
);
5521 match state
.mstate
with
5522 | Mnone
| Mscrolly
| Mscrollx
| Mpan
_ | Mzoom
_ | Mzoomrect
_ ->
5525 | Msel
((x0, y0), (x1, y1)) ->
5526 let identify opaque l px py = Some
(opaque, l.pageno, px, py) in
5527 let o0,n0
,px0
,py0
= onppundermouse identify x0 y0 (~
< E.s, -1, 0, 0) in
5528 let _o1,n1
,px1
,py1
= onppundermouse identify x1 y1 (~
< E.s, -1, 0, 0) in
5529 if n0
!= -1 && n0
= n1
then seltext
o0 (px0
, py0
, px1
, py1
);
5532 let showrects = function [] -> () | rects
->
5534 GlDraw.color (0.0, 0.0, 1.0) ~
alpha:0.5;
5535 GlFunc.blend_func ~
src:`src_alpha ~dst
:`one_minus_src_alpha
;
5537 (fun (pageno, c, (x0, y0, x1, y1, x2
, y2
, x3
, y3
)) ->
5539 if l.pageno = pageno
5541 let dx = float (l.pagedispx - l.pagex
) in
5542 let dy = float (l.pagedispy - l.pagey) in
5543 let r, g, b, alpha = c in
5544 GlDraw.color (r, g, b) ~
alpha;
5545 filledrect2 (x0+.dx) (y0+.dy)
5557 begin match conf
.columns
, state
.layout with
5558 | Csingle
_, _ :: _ ->
5559 GlDraw.color (scalecolor2 conf
.bgcolor
);
5561 List.fold_left
(fun y l ->
5564 let x1 = l.pagedispx + xadjsb () in
5565 let y1 = (l.pagedispy + l.pagevh) in
5566 filledrect (float x0) (float y0) (float x1) (float y1);
5567 let x0 = x1 + l.pagevw in
5568 let x1 = state
.winw
in
5569 filledrect1 (float x0) (float y0) (float x1) (float y1);
5573 and x1 = state
.winw
in
5575 and y1 = l.pagedispy in
5576 filledrect1 (float x0) (float y0) (float x1) (float y1);
5578 l.pagedispy + l.pagevh) 0 state
.layout
5581 and x1 = state
.winw
in
5583 and y1 = state
.winh
in
5584 filledrect1 (float x0) (float y0) (float x1) (float y1)
5585 | (Cmulti
_ | Csplit
_), _ | Csingle
_, [] ->
5586 GlClear.color (scalecolor2 conf
.bgcolor
);
5587 GlClear.clear
[`
color];
5589 List.iter
drawpage state
.layout;
5591 match state
.mode with
5592 | LinkNav
(Ltexact
(pageno, linkno
)) ->
5593 begin match getopaque pageno with
5595 let dx = xadjsb () in
5596 let x0, y0, x1, y1 = getlinkrect
opaque linkno
in
5597 let x0 = x0 + dx and x1 = x1 + dx in
5598 let color = (0.0, 0.0, 0.5, 0.5) in
5605 | None
-> state
.rects
5607 | LinkNav
(Ltgendir
_) | LinkNav
(Ltnotready
_)
5610 | View
-> state
.rects
5613 let rec postloop linkindexbase
= function
5615 let linkindexbase = linkindexbase + postdrawpage l linkindexbase in
5616 postloop linkindexbase rest
5620 postloop 0 state
.layout;
5622 begin match state
.mstate
with
5623 | Mzoomrect
((x0, y0), (x1, y1)) ->
5625 GlDraw.color (0.3, 0.3, 0.3) ~
alpha:0.5;
5626 GlFunc.blend_func ~
src:`src_alpha ~dst
:`one_minus_src_alpha
;
5627 filledrect (float x0) (float y0) (float x1) (float y1);
5631 | Mscrolly
| Mscrollx
5640 let zoomrect x y x1 y1 =
5643 and y0 = min
y y1 in
5644 let zoom = (float state
.w) /. float (x1 - x0) in
5647 let adjw = wadjsb () + state
.winw
in
5649 then (adjw - state
.w) / 2
5652 match conf
.fitmodel
with
5653 | FitWidth
| FitProportional
-> simple ()
5655 match conf
.columns
with
5657 onppundermouse (fun _ l _ _ -> Some
l.pagedispx) x0 y0 x0
5658 | Cmulti
_ | Csingle
_ -> simple ()
5660 gotoxy ((state
.x + margin) - x0) (state
.y + y0);
5661 state
.anchor <- getanchor
();
5666 let annot inline
x y =
5667 match unproject x y with
5668 | Some
(opaque, n, ux
, uy
) ->
5670 addannot
opaque ux uy
text;
5671 wcmd "freepage %s" (~
> opaque);
5672 Hashtbl.remove state
.pagemap
(n, state
.gen
);
5674 gotoxy state
.x state
.y
5678 let ondone s = add s in
5679 let mode = state
.mode in
5680 state
.mode <- Textentry
(
5681 ("annotation: ", E.s, None
, textentry, ondone, true),
5682 fun _ -> state
.mode <- mode);
5685 G.postRedisplay "annot"
5687 add @@ getusertext E.s
5692 let g opaque l px py =
5693 match rectofblock
opaque px py with
5695 let x0 = a.(0) -. 20. in
5696 let x1 = a.(1) +. 20. in
5697 let y0 = a.(2) -. 20. in
5698 let zoom = (float state
.w) /. (x1 -. x0) in
5699 let pagey = getpagey
l.pageno in
5700 let margin = (state
.w - l.pagew
)/2 in
5701 let nx = -truncate
x0 - margin in
5702 gotoxy_and_clear_text nx (pagey + truncate
y0);
5703 state
.anchor <- getanchor
();
5708 match conf
.columns
with
5710 impmsg "block zooming does not work properly in split columns mode"
5711 | Cmulti
_ | Csingle
_ -> onppundermouse g x y ()
5715 let winw = wadjsb () + state
.winw - 1 in
5716 let s = float x /. float winw in
5717 let destx = truncate
(float (state
.w + winw) *. s) in
5718 gotoxy_and_clear_text (winw - destx) state
.y;
5719 state
.mstate
<- Mscrollx
;
5723 let s = float y /. float state
.winh
in
5724 let desty = truncate
(float (state
.maxy - state
.winh
) *. s) in
5725 gotoxy_and_clear_text state
.x desty;
5726 state
.mstate
<- Mscrolly
;
5729 let viewmulticlick clicks
x y mask
=
5730 let g opaque l px py =
5738 if markunder
opaque px py mark
5742 match getopaque l.pageno with
5744 | Some
opaque -> pipesel opaque cmd
5746 state
.roam
<- (fun () -> dopipe conf
.paxcmd
);
5747 if not
(Wsi.withctrl mask
) then dopipe conf
.selcmd
;
5752 G.postRedisplay "viewmulticlick";
5753 onppundermouse g x y (fun () -> impmsg "nothing to select") ();
5757 match conf
.columns
with
5759 | Csingle
_ | Cmulti
_ -> conf
.angle
mod 360 = 0
5762 let viewmouse button down
x y mask
=
5764 | n when (n == 4 || n == 5) && not down
->
5765 if Wsi.withctrl mask
5767 match state
.mstate
with
5768 | Mzoom
(oldn
, i
) ->
5776 if conf
.zoom +. 0.01 > 0.1 then 0.1 else 0.01
5778 if conf
.zoom -. 0.1 < 0.1 then -0.01 else -0.1
5780 let zoom = conf
.zoom -. incr in
5781 pivotzoom ~
x ~
y zoom;
5782 state
.mstate
<- Mzoom
(n, 0);
5784 state
.mstate
<- Mzoom
(n, i
+1);
5786 else state
.mstate
<- Mzoom
(n, 0)
5790 | Mscrolly
| Mscrollx
5792 | Mnone
-> state
.mstate
<- Mzoom
(n, 0)
5795 match state
.autoscroll
with
5796 | Some step
-> setautoscrollspeed step
(n=4)
5798 if conf
.wheelbypage
|| conf
.presentation
5807 then -conf
.scrollstep
5808 else conf
.scrollstep
5810 let incr = incr * 2 in
5811 let y = clamp incr in
5812 gotoxy_and_clear_text state
.x y
5815 | n when (n = 6 || n = 7) && not down
&& canpan () ->
5817 panbound (state
.x + (if n = 7 then -2 else 2) * conf
.hscrollstep
) in
5818 gotoxy_and_clear_text x state
.y
5820 | 1 when Wsi.withshift mask
->
5821 state
.mstate
<- Mnone
;
5824 match unproject x y with
5826 | Some
(_, pageno, ux
, uy
) ->
5827 let cmd = Printf.sprintf
5829 conf
.stcmd state
.path pageno ux uy
5831 match spawn
cmd [] with
5832 | (exception exn
) ->
5833 impmsg "execution of synctex command(%S) failed: %S"
5834 conf
.stcmd
@@ exntos exn
5838 | 1 when Wsi.withctrl mask
->
5841 Wsi.setcursor
Wsi.CURSOR_FLEUR
;
5842 state
.mstate
<- Mpan
(x, y)
5845 state
.mstate
<- Mnone
5850 if Wsi.withshift mask
5852 annot conf
.annotinline
x y;
5853 G.postRedisplay "addannot"
5857 Wsi.setcursor
Wsi.CURSOR_CYCLE
;
5858 state
.mstate
<- Mzoomrect
(p, p)
5861 match state
.mstate
with
5862 | Mzoomrect
((x0, y0), _) ->
5863 if abs
(x-x0) > 10 && abs
(y - y0) > 10
5864 then zoomrect x0 y0 x y
5867 G.postRedisplay "kill accidental zoom rect";
5871 | Mscrolly
| Mscrollx
5877 | 1 when vscrollhit x ->
5880 let _, position, sh = state
.uioh#
scrollph in
5881 if y > truncate
position && y < truncate
(position +. sh)
5882 then state
.mstate
<- Mscrolly
5885 state
.mstate
<- Mnone
5887 | 1 when y > state
.winh
- hscrollh () ->
5890 let _, position, sw = state
.uioh#scrollpw
in
5891 if x > truncate
position && x < truncate
(position +. sw)
5892 then state
.mstate
<- Mscrollx
5895 state
.mstate
<- Mnone
5897 | 1 when state
.bzoom
-> if not down
then zoomblock x y
5900 let dest = if down
then getunder x y else Unone
in
5901 begin match dest with
5904 | Uremote
_ | Uremotedest
_
5905 | Uunexpected
_ | Ulaunch
_ | Unamed
_ ->
5908 | Unone
when down
->
5909 Wsi.setcursor
Wsi.CURSOR_FLEUR
;
5910 state
.mstate
<- Mpan
(x, y);
5912 | Uannotation
(opaque, slinkindex
) -> enterannotmode opaque slinkindex
5914 | Unone
| Utext
_ ->
5919 state
.mstate
<- Msel
((x, y), (x, y));
5920 G.postRedisplay "mouse select";
5924 match state
.mstate
with
5927 | Mzoom
_ | Mscrollx
| Mscrolly
->
5928 state
.mstate
<- Mnone
5930 | Mzoomrect
((x0, y0), _) ->
5934 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
5935 state
.mstate
<- Mnone
5937 | Msel
((x0, y0), (x1, y1)) ->
5938 let rec loop = function
5942 let a0 = l.pagedispy in
5943 let a1 = a0 + l.pagevh in
5944 let b0 = l.pagedispx in
5945 let b1 = b0 + l.pagevw in
5946 ((y0 >= a0 && y0 <= a1) || (y1 >= a0 && y1 <= a1))
5947 && ((x0 >= b0 && x0 <= b1) || (x1 >= b0 && x1 <= b1))
5951 match getopaque l.pageno with
5954 match Unix.pipe
() with
5955 | (exception exn
) ->
5956 impmsg "cannot create sel pipe: %s" @@
5960 Ne.clo fd
(fun msg
->
5961 dolog
"%s close failed: %s" what msg
)
5964 try spawn
cmd [r, 0; w, -1]
5966 dolog
"cannot execute %S: %s"
5973 G.postRedisplay "copysel";
5975 else clo "Msel pipe/w" w;
5976 clo "Msel pipe/r" r;
5978 dosel conf
.selcmd
();
5979 state
.roam
<- dosel conf
.paxcmd
;
5991 let birdseyemouse button down
x y mask
5992 (conf
, leftx
, _, hooverpageno
, anchor) =
5995 let rec loop = function
5998 if y > l.pagedispy && y < l.pagedispy + l.pagevh
5999 && x > l.pagedispx && x < l.pagedispx + l.pagevw
6001 leavebirdseye (conf
, leftx
, l.pageno, hooverpageno
, anchor) false;
6007 | _ -> viewmouse button down
x y mask
6013 method key key mask
=
6014 begin match state
.mode with
6015 | Textentry
textentry -> textentrykeyboard key mask
textentry
6016 | Birdseye
birdseye -> birdseyekeyboard key mask
birdseye
6017 | View
-> viewkeyboard key mask
6018 | LinkNav
linknav -> linknavkeyboard key mask
linknav
6022 method button button bstate
x y mask
=
6023 begin match state
.mode with
6025 | View
-> viewmouse button bstate
x y mask
6026 | Birdseye beye
-> birdseyemouse button bstate
x y mask beye
6031 method multiclick clicks
x y mask
=
6032 begin match state
.mode with
6034 | View
-> viewmulticlick clicks
x y mask
6041 begin match state
.mode with
6043 | View
| Birdseye
_ | LinkNav
_ ->
6044 match state
.mstate
with
6045 | Mzoom
_ | Mnone
-> ()
6050 state
.mstate
<- Mpan
(x, y);
6051 let x = if canpan () then panbound (state
.x + dx) else state
.x in
6053 gotoxy_and_clear_text x y
6056 state
.mstate
<- Msel
(a, (x, y));
6057 G.postRedisplay "motion select";
6060 let y = min state
.winh
(max
0 y) in
6064 let x = min state
.winw (max
0 x) in
6067 | Mzoomrect
(p0
, _) ->
6068 state
.mstate
<- Mzoomrect
(p0
, (x, y));
6069 G.postRedisplay "motion zoomrect";
6073 method pmotion
x y =
6074 begin match state
.mode with
6075 | Birdseye
(conf
, leftx
, pageno, hooverpageno
, anchor) ->
6076 let rec loop = function
6078 if hooverpageno
!= -1
6080 state
.mode <- Birdseye
(conf
, leftx
, pageno, -1, anchor);
6081 G.postRedisplay "pmotion birdseye no hoover";
6084 if y > l.pagedispy && y < l.pagedispy + l.pagevh
6085 && x > l.pagedispx && x < l.pagedispx + l.pagevw
6087 state
.mode <- Birdseye
(conf
, leftx
, pageno, l.pageno, anchor);
6088 G.postRedisplay "pmotion birdseye hoover";
6098 match state
.mstate
with
6099 | Mpan
_ | Msel
_ | Mzoom
_ | Mscrolly
| Mscrollx
| Mzoomrect
_ -> ()
6107 let past, _, _ = !r in
6109 let delta = now -. past in
6112 else r := (now, x, y)
6116 method infochanged
_ = ()
6119 let maxy = state
.maxy - (if conf
.maxhfit
then state
.winh
else 0) in
6122 then 0.0, float state
.winh
6123 else scrollph state
.y maxy
6128 let winw = wadjsb () + state
.winw in
6129 let fwinw = float winw in
6131 let sw = fwinw /. float state
.w in
6132 let sw = fwinw *. sw in
6133 max
sw (float conf
.scrollh
)
6136 let maxx = state
.w + winw in
6137 let x = winw - state
.x in
6138 let percent = float x /. float maxx in
6139 (fwinw -. sw) *. percent
6141 hscrollh (), position, sw
6145 match state
.mode with
6146 | LinkNav
_ -> "links"
6147 | Textentry
_ -> "textentry"
6148 | Birdseye
_ -> "birdseye"
6151 findkeyhash conf
modename
6153 method eformsgs
= true
6154 method alwaysscrolly
= false
6157 let addrect pageno r g b a x0 y0 x1 y1 =
6158 Hashtbl.add state
.prects
pageno [|r; g; b; a; x0; y0; x1; y1|];
6162 let cl = splitatspace cmds
in
6164 try Scanf.sscanf
s fmt
f
6166 adderrfmt "remote exec"
6167 "error processing '%S': %s\n" cmds
@@ exntos exn
6169 let rectx s pageno (r, g, b, a) x0 y0 x1 y1 =
6170 vlog "%s page %d color (%f %f %f %f) x0,y0,x1,y1 = %f %f %f %f"
6171 s pageno r g b a x0 y0 x1 y1;
6175 let _,w1,h1
,_ = getpagedim
pageno in
6176 let sw = float w1 /. float w
6177 and sh = float h1
/. float h in
6181 and y1s
= y1 *. sh in
6182 let rect = (x0s,y0s
,x1s
,y0s
,x1s
,y1s
,x0s,y1s
) in
6183 let color = (r, g, b, a) in
6184 if conf
.verbose
then debugrect rect;
6185 state
.rects <- (pageno, color, rect) :: state
.rects;
6190 | "reload", "" -> reload ()
6192 scan args
"%u %f %f"
6194 let cmd, _ = state
.geomcmds
in
6196 then gotopagexy !wtmode pageno x y
6199 gotopagexy !wtmode pageno x y;
6202 state
.reprf
<- f state
.reprf
6204 | "goto1", args
-> scan args
"%u %f" gotopage
6207 (fun filename
pageno -> gotounder (Uremote
(filename
, pageno)))
6210 (fun filename
dest -> gotounder (Uremotedest
(filename
, dest)))
6212 scan args
"%u %u %f %f %f %f"
6213 (fun pageno c x0 y0 x1 y1 ->
6214 let color = (0.0, 0.0, 1.0 /. float c, 0.5) in
6215 rectx "rect" pageno color x0 y0 x1 y1;
6218 scan args
"%u %f %f %f %f %f %f %f %f"
6219 (fun pageno r g b alpha x0 y0 x1 y1 ->
6220 addrect pageno r g b alpha x0 y0 x1 y1;
6221 G.postRedisplay "prect"
6224 scan args
"%u %f %f"
6227 match getopaque pageno with
6228 | Some
opaque -> opaque
6231 pgoto optopaque pageno x y;
6232 let rec fixx = function
6235 if l.pageno = pageno
6236 then gotoxy (state
.x - l.pagedispx) state
.y
6241 match conf
.columns
with
6242 | Csingle
_ | Csplit
_ -> 1
6243 | Cmulti
((n, _, _), _) -> n
6245 layout 0 state
.y (state
.winw * mult) state
.winh
6249 | "activatewin", "" -> Wsi.activatewin
()
6250 | "quit", "" -> raise Quit
6253 let l = Config.keys_of_string
keys in
6254 List.iter
(fun (k
, m) -> keyboard k
m) l
6256 adderrfmt "error processing keys" "`%S': %s\n" cmds
@@ exntos exn
6258 | "clearrects", "" ->
6259 Hashtbl.clear state
.prects
;
6260 G.postRedisplay "clearrects"
6262 adderrfmt "remote command"
6263 "error processing remote command: %S\n" cmds
;
6267 let scratch = Bytes.create
80 in
6268 let buf = Buffer.create
80 in
6270 match tempfailureretry
(Unix.read fd
scratch 0) 80 with
6271 | (exception Unix.Unix_error
(Unix.EAGAIN
, _, _)) -> None
6274 if Buffer.length
buf > 0
6276 let s = Buffer.contents
buf in
6284 match Bytes.index_from
scratch ppos '
\n'
with
6285 | pos -> if pos >= n then -1 else pos
6286 | (exception Not_found
) -> -1
6290 Buffer.add_subbytes
buf scratch ppos
(nlpos-ppos
);
6291 let s = Buffer.contents
buf in
6297 Buffer.add_subbytes
buf scratch ppos
(n-ppos
);
6303 let remoteopen path =
6304 try Some
(Unix.openfile
path [Unix.O_NONBLOCK
; Unix.O_RDONLY
] 0o0)
6306 adderrfmt "remoteopen" "error opening %S: %s" path @@ exntos exn
;
6311 let gcconfig = ref E.s in
6312 let trimcachepath = ref E.s in
6313 let rcmdpath = ref E.s in
6314 let pageno = ref None
in
6315 let rootwid = ref 0 in
6316 let openlast = ref false in
6317 let nofc = ref false in
6318 let doreap = ref false in
6319 selfexec := Sys.executable_name
;
6322 [("-p", Arg.String
(fun s -> state
.password <- s),
6323 "<password> Set password");
6327 Config.fontpath
:= s;
6328 selfexec := !selfexec ^
" -f " ^
Filename.quote
s;
6330 "<path> Set path to the user interface font");
6334 selfexec := !selfexec ^
" -c " ^
Filename.quote
s;
6335 Config.confpath
:= s),
6336 "<path> Set path to the configuration file");
6338 ("-last", Arg.Set
openlast, " Open last document");
6340 ("-page", Arg.Int
(fun pageno1
-> pageno := Some
(pageno1
-1)),
6341 "<page-number> Jump to page");
6343 ("-tcf", Arg.String
(fun s -> trimcachepath := s),
6344 "<path> Set path to the trim cache file");
6346 ("-dest", Arg.String
(fun s -> state
.nameddest
<- s),
6347 "<named-destination> Set named destination");
6349 ("-wtmode", Arg.Set
wtmode, " Operate in wt mode");
6350 ("-cxack", Arg.Set
cxack, " Cut corners");
6352 ("-remote", Arg.String
(fun s -> rcmdpath := s),
6353 "<path> Set path to the remote commands source");
6355 ("-origin", Arg.String
(fun s -> state
.origin
<- s),
6356 "<original-path> Set original path");
6358 ("-gc", Arg.Set_string
gcconfig,
6359 "<script-path> Collect garbage with the help of a script");
6361 ("-nofc", Arg.Set
nofc, " Do not use fontconfig");
6363 ("-v", Arg.Unit
(fun () ->
6365 "%s\nconfiguration path: %s\n"
6369 exit
0), " Print version and exit");
6371 ("-embed", Arg.Set_int
rootwid,
6372 "<window-id> Embed into window")
6375 (fun s -> state
.path <- s)
6376 ("Usage: " ^
Sys.argv
.(0) ^
" [options] some.pdf\nOptions:")
6379 then selfexec := !selfexec ^
" -wtmode";
6381 let histmode = emptystr state
.path && not
!openlast in
6383 if not
(Config.load !openlast)
6384 then dolog
"failed to load configuration";
6386 begin match !pageno with
6387 | Some
pageno -> state
.anchor <- (pageno, 0.0, 0.0)
6391 if nonemptystr
!gcconfig
6394 match Unix.socketpair
Unix.PF_UNIX
Unix.SOCK_STREAM
0 with
6395 | (exception exn
) -> error
"socketpair for gc failed: %s" @@ exntos exn
6398 match spawn
!gcconfig [(c, 0); (c, 1); (s, -1)] with
6399 | (exception exn
) -> error
"failed to execute gc script: %s" @@ exntos exn
6401 Ne.clo c @@ (fun s -> error
"failed to close gc fd %s" s);
6406 let wsfd, winw, winh
= Wsi.init
(object (self)
6407 val mutable m_clicks
= 0
6408 val mutable m_click_x
= 0
6409 val mutable m_click_y
= 0
6410 val mutable m_lastclicktime
= infinity
6412 method private cleanup =
6413 state
.roam
<- noroam
;
6414 Hashtbl.iter
(fun _ opaque -> clearmark
opaque) state
.pagemap
6415 method expose
= G.postRedisplay "expose"
6419 | Wsi.Unobscured
-> "unobscured"
6420 | Wsi.PartiallyObscured
-> "partiallyobscured"
6421 | Wsi.FullyObscured
-> "fullyobscured"
6423 vlog "visibility change %s" name
6424 method display = display ()
6425 method map mapped
= vlog "mapped %b" mapped
6426 method reshape w h =
6429 method mouse
b d x y m =
6430 if d && canselect ()
6432 (* http://blogs.msdn.com/b/oldnewthing/archive/2004/10/18/243925.aspx *)
6438 if abs
x - m_click_x
> 10
6439 || abs
y - m_click_y
> 10
6440 || abs_float
(t -. m_lastclicktime
) > 0.3
6442 m_clicks
<- m_clicks
+ 1;
6443 m_lastclicktime
<- t;
6447 G.postRedisplay "cleanup";
6448 state
.uioh <- state
.uioh#button
b d x y m;
6450 else state
.uioh <- state
.uioh#multiclick m_clicks
x y m
6455 m_lastclicktime
<- infinity
;
6456 state
.uioh <- state
.uioh#button
b d x y m
6460 state
.uioh <- state
.uioh#button
b d x y m
6463 state
.mpos
<- (x, y);
6464 state
.uioh <- state
.uioh#motion
x y
6465 method pmotion
x y =
6466 state
.mpos
<- (x, y);
6467 state
.uioh <- state
.uioh#pmotion
x y
6469 let mascm = m land (
6470 Wsi.altmask
+ Wsi.shiftmask
+ Wsi.ctrlmask
+ Wsi.metamask
6473 let x = state
.x and y = state
.y in
6475 if x != state
.x || y != state
.y then self#
cleanup
6477 match state
.keystate
with
6479 let km = k
, mascm in
6482 let modehash = state
.uioh#
modehash in
6483 try Hashtbl.find modehash km
6485 try Hashtbl.find (findkeyhash conf
"global") km
6486 with Not_found
-> KMinsrt
(k
, m)
6488 | KMinsrt
(k
, m) -> keyboard k
m
6489 | KMinsrl
l -> List.iter
(fun (k
, m) -> keyboard k
m) l
6490 | KMmulti
(l, r) -> state
.keystate
<- KSinto
(l, r)
6492 | KSinto
((k'
, m'
) :: [], insrt
) when k'
=k
&& m'
land mascm = m'
->
6493 List.iter
(fun (k
, m) -> keyboard k
m) insrt
;
6494 state
.keystate
<- KSnone
6495 | KSinto
((k'
, m'
) :: keys, insrt
) when k'
=k
&& m'
land mascm = m'
->
6496 state
.keystate
<- KSinto
(keys, insrt
)
6497 | KSinto
_ -> state
.keystate
<- KSnone
6500 state
.mpos
<- (x, y);
6501 state
.uioh <- state
.uioh#pmotion
x y
6502 method leave = state
.mpos
<- (-1, -1)
6503 method winstate wsl
= state
.winstate
<- wsl
6504 method quit
= raise Quit
6505 end) !rootwid conf
.cwinw conf
.cwinh platform
in
6507 setbgcol conf
.bgcolor
;
6511 List.exists
GlMisc.check_extension
6512 [ "GL_ARB_texture_rectangle"
6513 ; "GL_EXT_texture_recangle"
6514 ; "GL_NV_texture_rectangle" ]
6516 then (dolog
"OpenGL does not suppport rectangular textures"; exit
1);
6519 let r = GlMisc.get_string `renderer
in
6520 let p = "Mesa DRI Intel(" in
6521 let l = String.length
p in
6522 String.length
r > l && String.sub
r 0 l = p
6525 defconf
.sliceheight
<- 1024;
6526 defconf
.texcount
<- 32;
6527 defconf
.usepbo
<- true;
6531 match Unix.socketpair
Unix.PF_UNIX
Unix.SOCK_STREAM
0 with
6532 | (exception exn
) ->
6533 dolog
"socketpair failed: %s" @@ exntos exn
;
6541 setcheckers conf
.checkers
;
6543 opengl_has_pbo := GlMisc.check_extension
"GL_ARB_pixel_buffer_object";
6546 conf
.angle
, conf
.fitmodel
, (conf
.trimmargins
, conf
.trimfuzz
),
6547 conf
.texcount
, conf
.sliceheight
, conf
.mustoresize
, conf
.colorspace
,
6548 !Config.fontpath
, !trimcachepath,
6552 List.iter
GlArray.enable
[`texture_coord
; `vertex
];
6554 reshape ~firsttime
:true winw winh
;
6558 Wsi.settitle
"llpp (history)";
6562 state
.text <- "Opening " ^
(mbtoutf8 state
.path);
6563 opendoc state
.path state
.password;
6567 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
6568 Sys.set_signal
Sys.sighup
(Sys.Signal_handle
(fun _ -> reload ()));
6571 match Unix.waitpid
[Unix.WNOHANG
] ~
-1 with
6572 | (exception (Unix.Unix_error
(Unix.ECHILD
, _, _))) -> ()
6573 | (exception exn
) -> dolog
"Unix.waitpid: %s" @@ exntos exn
6575 | _pid
, _status
-> reap ()
6577 Sys.set_signal
Sys.sigchld
(Sys.Signal_handle
(fun _ -> doreap := true));
6581 if nonemptystr
!rcmdpath
6582 then remoteopen !rcmdpath
6587 let rec loop deadline
=
6593 let r = [state
.ss; state
.wsfd] in
6597 | Some fd
-> fd
:: r
6601 state
.redisplay
<- false;
6608 if deadline
= infinity
6610 else max
0.0 (deadline
-. now)
6615 try Unix.select
r [] [] timeout
6616 with Unix.Unix_error
(Unix.EINTR
, _, _) -> [], [], []
6622 if state
.ghyll
== noghyll
6624 match state
.autoscroll
with
6625 | Some step
when step
!= 0 ->
6626 let y = state
.y + step
in
6627 let fy = if conf
.maxhfit
then state
.winh
else 0 in
6630 then state
.maxy - fy
6631 else if y >= state
.maxy - fy then 0 else y
6633 if state
.mode = View
6634 then gotoxy_and_clear_text state
.x y
6635 else gotoxy state
.x y;
6638 else deadline
+. 0.01
6643 let rec checkfds = function
6645 | fd
:: rest
when fd
= state
.ss ->
6646 let cmd = rcmd state
.ss in
6650 | fd
:: rest
when fd
= state
.wsfd ->
6654 | fd
:: rest
when Some fd
= !optrfd ->
6655 begin match remote fd
with
6656 | None
-> optrfd := remoteopen !rcmdpath;
6657 | opt -> optrfd := opt
6662 dolog
"select returned unknown descriptor";
6668 if deadline
= infinity
6672 match state
.autoscroll
with
6673 | Some step
when step
!= 0 -> deadline1
6674 | _ -> if state
.ghyll
== noghyll
then infinity
else deadline1
6682 Config.save leavebirdseye;
6683 if hasunsavedchanges
()