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
.winw
- 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 setzoom ?
(x=state
.winw
/2) ?
(y=state
.winh
/2) zoom =
2078 let w = float state
.w /. zoom in
2079 let hw = w /. 2.0 in
2080 let x0 = float x -. hw in
2081 let y0 = float y -. hw in
2082 gotoxy (state
.x - truncate
x0) (state
.y + truncate
y0);
2086 let setcolumns mode columns coverA coverB
=
2087 state
.prevcolumns
<- Some
(conf
.columns
, conf
.zoom);
2091 then impmsg "split mode doesn't work in bird's eye"
2093 conf
.columns
<- Csplit
(-columns
, E.a);
2101 conf
.columns
<- Csingle
E.a;
2106 conf
.columns
<- Cmulti
((columns
, coverA
, coverB
), E.a);
2110 reshape state
.winw state
.winh
;
2113 let resetmstate () =
2114 state
.mstate
<- Mnone
;
2115 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
2118 let enterbirdseye () =
2119 let zoom = float conf
.thumbw
/. float state
.winw
in
2120 let birdseyepageno =
2121 let cy = state
.winh
/ 2 in
2125 let rec fold best
= function
2128 let d = cy - (l.pagedispy + l.pagevh/2)
2129 and dbest
= cy - (best
.pagedispy + best
.pagevh/2) in
2130 if abs
d < abs dbest
2137 state
.mode
<- Birdseye
(
2138 { conf
with zoom = conf
.zoom }, state
.x, birdseyepageno, -1, getanchor
()
2142 conf
.presentation
<- false;
2143 conf
.interpagespace
<- 10;
2144 conf
.hlinks
<- false;
2145 conf
.fitmodel
<- FitPage
;
2147 conf
.maxwait
<- None
;
2149 match conf
.beyecolumns
with
2152 Cmulti
((c, 0, 0), E.a)
2153 | None
-> Csingle
E.a
2157 state
.text <- Printf.sprintf
"birds eye mode on (zoom %3.1f%%)"
2162 reshape state
.winw state
.winh
;
2165 let leavebirdseye (c, leftx
, pageno, _, anchor) goback
=
2167 conf
.zoom <- c.zoom;
2168 conf
.presentation
<- c.presentation
;
2169 conf
.interpagespace
<- c.interpagespace
;
2170 conf
.maxwait
<- c.maxwait
;
2171 conf
.hlinks
<- c.hlinks
;
2172 conf
.fitmodel
<- c.fitmodel
;
2173 conf
.beyecolumns
<- (
2174 match conf
.columns
with
2175 | Cmulti
((c, _, _), _) -> Some
c
2177 | Csplit
_ -> failwith
"leaving bird's eye split mode"
2180 match c.columns
with
2181 | Cmulti
(c, _) -> Cmulti
(c, E.a)
2182 | Csingle
_ -> Csingle
E.a
2183 | Csplit
(c, _) -> Csplit
(c, E.a)
2187 state
.text <- Printf.sprintf
"birds eye mode off (zoom %3.1f%%)"
2190 reshape state
.winw state
.winh
;
2191 state
.anchor <- if goback
then anchor else (pageno, 0.0, 1.0);
2195 let togglebirdseye () =
2196 match state
.mode
with
2197 | Birdseye vals
-> leavebirdseye vals
true
2198 | View
-> enterbirdseye ()
2203 let upbirdseye incr
(conf
, leftx
, pageno, hooverpageno
, anchor) =
2204 let pageno = max
0 (pageno - incr
) in
2205 let rec loop = function
2206 | [] -> gotopage1 pageno 0
2207 | l :: _ when l.pageno = pageno ->
2208 if l.pagedispy >= 0 && l.pagey = 0
2209 then G.postRedisplay "upbirdseye"
2210 else gotopage1 pageno 0
2211 | _ :: rest
-> loop rest
2215 state
.mode
<- Birdseye
(conf
, leftx
, pageno, hooverpageno
, anchor)
2218 let downbirdseye incr
(conf
, leftx
, pageno, hooverpageno
, anchor) =
2219 let pageno = min
(state
.pagecount
- 1) (pageno + incr
) in
2220 state
.mode
<- Birdseye
(conf
, leftx
, pageno, hooverpageno
, anchor);
2221 let rec loop = function
2223 let y, h = getpageyh
pageno in
2224 let dy = (y - state
.y) - (state
.winh
- h - conf
.interpagespace
) in
2225 gotoxy state
.x (clamp dy)
2226 | l :: _ when l.pageno = pageno ->
2227 if l.pagevh != l.pageh
2228 then gotoxy state
.x (clamp (l.pageh
- l.pagevh + conf
.interpagespace
))
2229 else G.postRedisplay "downbirdseye"
2230 | _ :: rest
-> loop rest
2236 let optentry mode
_ key =
2237 let btos b = if b then "on" else "off" in
2238 if key >= 32 && key < 127
2240 let c = Char.chr
key in
2244 try conf
.scrollstep
<- int_of_string
s with exn
->
2245 state
.text <- Printf.sprintf
"bad integer `%s': %s" s @@ exntos exn
2247 TEswitch
("scroll step: ", E.s, None
, intentry, ondone, true)
2252 conf
.autoscrollstep
<- boundastep state
.winh
(int_of_string
s);
2253 if state
.autoscroll
<> None
2254 then state
.autoscroll
<- Some conf
.autoscrollstep
2256 state
.text <- Printf.sprintf
"bad integer `%s': %s" s @@ exntos exn
2258 TEswitch
("auto scroll step: ", E.s, None
, intentry, ondone, true)
2263 let n, a, b = multicolumns_of_string
s in
2264 setcolumns mode
n a b;
2266 state
.text <- Printf.sprintf
"bad columns `%s': %s" s @@ exntos exn
2268 TEswitch
("columns: ", E.s, None
, textentry, ondone, true)
2273 let zoom = float (int_of_string
s) /. 100.0 in
2276 state
.text <- Printf.sprintf
"bad integer `%s': %s" s @@ exntos exn
2278 TEswitch
("zoom: ", E.s, None
, intentry, ondone, true)
2283 conf
.thumbw
<- bound
(int_of_string
s) 2 4096;
2285 Printf.sprintf
"thumbnail width is set to %d" conf
.thumbw
;
2286 begin match mode
with
2288 leavebirdseye beye
false;
2295 state
.text <- Printf.sprintf
"bad integer `%s': %s" s @@ exntos exn
2297 TEswitch
("thumbnail width: ", E.s, None
, intentry, ondone, true)
2301 match int_of_string
s with
2302 | angle
-> reqlayout angle conf
.fitmodel
2305 Printf.sprintf
"bad integer `%s': %s" s @@ exntos exn
2307 TEswitch
("rotation: ", E.s, None
, intentry, ondone, true)
2310 conf
.icase
<- not conf
.icase
;
2311 TEdone
("case insensitive search " ^
(btos conf
.icase
))
2314 conf
.preload <- not conf
.preload;
2315 gotoxy state
.x state
.y;
2316 TEdone
("preload " ^
(btos conf
.preload))
2319 conf
.verbose
<- not conf
.verbose
;
2320 TEdone
("verbose " ^
(btos conf
.verbose
))
2323 conf
.debug
<- not conf
.debug
;
2324 TEdone
("debug " ^
(btos conf
.debug
))
2327 conf
.maxhfit
<- not conf
.maxhfit
;
2328 state
.maxy
<- calcheight
();
2329 TEdone
("maxhfit " ^
(btos conf
.maxhfit
))
2332 conf
.crophack
<- not conf
.crophack
;
2333 TEdone
("crophack " ^
btos conf
.crophack
)
2337 match conf
.maxwait
with
2339 conf
.maxwait
<- Some infinity
;
2340 "always wait for page to complete"
2342 conf
.maxwait
<- None
;
2343 "show placeholder if page is not ready"
2348 conf
.underinfo
<- not conf
.underinfo
;
2349 TEdone
("underinfo " ^
btos conf
.underinfo
)
2352 conf
.savebmarks
<- not conf
.savebmarks
;
2353 TEdone
("persistent bookmarks " ^
btos conf
.savebmarks
)
2359 match state
.layout with
2364 conf
.interpagespace
<- int_of_string
s;
2365 docolumns conf
.columns
;
2366 state
.maxy
<- calcheight
();
2367 let y = getpagey
pageno in
2368 gotoxy state
.x (y + py)
2370 state
.text <- Printf.sprintf
"bad integer `%s': %s" s @@ exntos exn
2372 TEswitch
("vertical margin: ", E.s, None
, intentry, ondone, true)
2376 match conf
.fitmodel
with
2377 | FitProportional
-> FitWidth
2378 | FitWidth
| FitPage
-> FitProportional
2380 reqlayout conf
.angle
fm;
2381 TEdone
("proportional display " ^
btos (fm == FitProportional
))
2384 settrim (not conf
.trimmargins
) conf
.trimfuzz
;
2385 TEdone
("trim margins " ^
btos conf
.trimmargins
)
2388 conf
.invert
<- not conf
.invert
;
2389 TEdone
("invert colors " ^
btos conf
.invert
)
2393 cbput state
.hists
.sel
s;
2396 TEswitch
("selection command: ", E.s, Some
(onhist state
.hists
.sel
),
2397 textentry, ondone, true)
2401 then conf
.pax
<- Some
(ref (0.0, 0, 0))
2402 else conf
.pax
<- None
;
2403 TEdone
("PAX " ^
btos (conf
.pax
!= None
))
2406 state
.text <- Printf.sprintf
"bad option %d `%c'" key c;
2412 class type lvsource
= object
2413 method getitemcount
: int
2414 method getitem
: int -> (string * int)
2415 method hasaction
: int -> bool
2423 method getactive
: int
2424 method getfirst
: int
2426 method getminfo
: (int * int) array
2429 class virtual lvsourcebase
= object
2430 val mutable m_active
= 0
2431 val mutable m_first
= 0
2432 val mutable m_pan
= 0
2433 method getactive
= m_active
2434 method getfirst
= m_first
2435 method getpan
= m_pan
2436 method getminfo
: (int * int) array
= E.a
2439 let textentrykeyboard
2440 key _mask
((c, text, opthist
, onkey
, ondone, cancelonempty
), onleave
) =
2442 let key = Wsi.keypadtodigitkey
key in
2444 state
.mode
<- Textentry
(te
, onleave
);
2446 G.postRedisplay "textentrykeyboard enttext";
2448 let histaction cmd
=
2451 | Some
(action, _) ->
2452 state
.mode
<- Textentry
(
2453 (c, action cmd
, opthist
, onkey
, ondone, cancelonempty
), onleave
2455 G.postRedisplay "textentry histaction"
2459 if emptystr
text && cancelonempty
2462 G.postRedisplay "textentrykeyboard after cancel";
2465 let s = withoutlastutf8
text in
2466 enttext (c, s, opthist
, onkey
, ondone, cancelonempty
)
2468 | @enter
| @kpenter
->
2471 G.postRedisplay "textentrykeyboard after confirm"
2473 | @up
| @kpup
-> histaction HCprev
2474 | @down
| @kpdown
-> histaction HCnext
2475 | @home
| @kphome
-> histaction HCfirst
2476 | @jend
| @kpend
-> histaction HClast
2481 begin match opthist
with
2483 | Some
(_, onhistcancel
) -> onhistcancel
()
2487 G.postRedisplay "textentrykeyboard after cancel2"
2490 enttext (c, E.s, opthist
, onkey
, ondone, cancelonempty
)
2493 | @delete
| @kpdelete
-> ()
2495 | _ when key != 0 && not
(Wsi.isspecialkey
key) ->
2496 begin match onkey
text key with
2500 G.postRedisplay "textentrykeyboard after confirm2";
2503 enttext (c, text, opthist
, onkey
, ondone, cancelonempty
);
2507 G.postRedisplay "textentrykeyboard after cancel3"
2510 state
.mode
<- Textentry
(te
, onleave
);
2511 G.postRedisplay "textentrykeyboard switch";
2515 vlog "unhandled key %s" (Wsi.keyname
key)
2518 let firstof first active
=
2519 if first
> active
|| abs
(first
- active
) > fstate
.maxrows
- 1
2520 then max
0 (active
- (fstate
.maxrows
/2))
2524 let calcfirst first active
=
2527 let rows = active
- first
in
2528 if rows > fstate
.maxrows
then active
- fstate
.maxrows
else first
2532 let scrollph y maxy
=
2533 let sh = float (maxy
+ state
.winh
) /. float state
.winh
in
2534 let sh = float state
.winh
/. sh in
2535 let sh = max
sh (float conf
.scrollh
) in
2537 let percent = float y /. float maxy
in
2538 let position = (float state
.winh
-. sh) *. percent in
2541 if position +. sh > float state
.winh
2542 then float state
.winh
-. sh
2548 let adderrmsg src msg
=
2549 Buffer.add_string state
.errmsgs msg
;
2550 state
.newerrmsgs
<- true;
2554 let adderrfmt src fmt
=
2555 Format.ksprintf
(fun s -> adderrmsg src
s) fmt
;
2558 let coe s = (s :> uioh
);;
2560 class listview ~zebra ~helpmode ~
(source
:lvsource
) ~trusted ~modehash
=
2562 val m_pan
= source#getpan
2563 val m_first
= source#getfirst
2564 val m_active
= source#getactive
2566 val m_prev_uioh
= state
.uioh
2568 method private elemunder
y =
2572 let n = y / (fstate
.fontsize
+1) in
2573 if m_first
+ n < source#getitemcount
2575 if source#hasaction
(m_first
+ n)
2576 then Some
(m_first
+ n)
2583 GlFunc.blend_func ~src
:`src_alpha ~dst
:`one_minus_src_alpha
;
2584 GlDraw.color (0., 0., 0.) ~alpha
:0.85;
2585 filledrect 0. 0. (float state
.winw
) (float state
.winh
);
2586 GlDraw.color (1., 1., 1.);
2587 Gl.enable `texture_2d
;
2588 let fs = fstate
.fontsize
in
2590 let hw = (wadjsb () + xadjsb () + state
.winw
)/3 in
2591 let ww = fstate
.wwidth
in
2592 let tabw = 17.0*.ww in
2593 let itemcount = source#getitemcount
in
2594 let minfo = source#getminfo
in
2597 then float (xadjsb ()), float (state
.winw
- 1)
2598 else 0.0, float (state
.winw
- conf
.scrollbw
- 1)
2600 let xadj = xadjsb () in
2602 if (row - m_first
) > fstate
.maxrows
2605 if row >= 0 && row < itemcount
2607 let (s, level
) = source#getitem
row in
2608 let y = (row - m_first
) * nfs in
2610 (if conf
.leftscroll
then float xadj else 5.0)
2611 +. (float (level
+ m_pan
)) *. ww in
2614 (let c = if row land 1 = 0 then 1.0 else 0.92 in (c,c,c));
2618 Gl.disable `texture_2d
;
2619 let alpha = if source#hasaction
row then 0.9 else 0.3 in
2620 GlDraw.color (1., 1., 1.) ~
alpha;
2621 linerect (x0 +. 1.) (float (y + 1)) (x1) (float (y + fs + 3));
2622 Gl.enable `texture_2d
;
2625 if zebra
&& row land 1 = 1
2629 GlDraw.color (c,c,c);
2630 let drawtabularstring s =
2632 let x'
= truncate
(x0 +. x) in
2633 let pos = nindex
s '
\000'
in
2635 then drawstring1 fs x'
(y+nfs) s
2637 let s1 = String.sub
s 0 pos
2638 and s2
= String.sub
s (pos+1) (String.length
s - pos - 1) in
2643 let s'
= withoutlastutf8
s in
2644 let s = s' ^
"@Uellipsis" in
2645 let w = measurestr
fs s in
2646 if float x'
+. w +. ww < float (hw + x'
)
2651 if float x'
+. ww +. measurestr
fs s1 > float (hw + x'
)
2655 ignore
(drawstring1 fs x'
(y+nfs) s1);
2656 drawstring1 fs (hw + x'
) (y+nfs) s2
2660 let x = if helpmode
&& row > 0 then x +. ww else x in
2661 let tabpos = nindex
s '
\t'
in
2664 let len = String.length
s - tabpos - 1 in
2665 let s1 = String.sub
s 0 tabpos
2666 and s2
= String.sub
s (tabpos + 1) len in
2667 let nx = drawstr x s1 in
2669 let x = x +. (max
tabw sw) in
2672 let len = String.length
s - 2 in
2673 if len > 0 && s.[0] = '
\xc2'
&& s.[1] = '
\xb7'
2675 let s = String.sub
s 2 len in
2676 let x = if not helpmode
then x +. ww else x in
2677 GlDraw.color (1.2, 1.2, 1.2);
2678 let vinc = drawstring1 (fs+fs/4)
2679 (truncate
(x -. ww)) (y+nfs) s in
2680 GlDraw.color (1., 1., 1.);
2681 vinc +. (float fs *. 0.8)
2687 ignore
(drawtabularstring s);
2693 GlDraw.color (1.0, 1.0, 1.0) ~
alpha:0.5;
2694 let xadj = float (xadjsb () + 5) in
2696 if (row - m_first
) > fstate
.maxrows
2699 if row >= 0 && row < itemcount
2701 let (s, level
) = source#getitem
row in
2702 let pos0 = nindex
s '
\000'
in
2703 let y = (row - m_first
) * nfs in
2704 let x = float (level
+ m_pan
) *. ww in
2705 let (first
, last
) = minfo.(row) in
2707 if pos0 > 0 && first
> pos0
2708 then String.sub
s (pos0+1) (first
-pos0-1)
2709 else String.sub
s 0 first
2711 let suffix = String.sub
s first
(last
- first
) in
2712 let w1 = measurestr fstate
.fontsize
prefix in
2713 let w2 = measurestr fstate
.fontsize
suffix in
2714 let x = x +. if conf
.leftscroll
then xadj else 5.0 in
2715 let x = if pos0 > 0 && first
> pos0 then x +. float hw else x in
2717 and y0 = float (y+2) in
2719 and y1 = float (y+fs+3) in
2720 filledrect x0 y0 x1 y1;
2725 Gl.disable `texture_2d
;
2726 if Array.length
minfo > 0 then loop m_first
;
2729 method updownlevel incr
=
2730 let len = source#getitemcount
in
2732 if m_active
>= 0 && m_active
< len
2733 then snd
(source#getitem m_active
)
2737 if i
= len then i
-1 else if i
= -1 then 0 else
2738 let _, l = source#getitem i
in
2739 if l != curlevel then i
else flow (i
+incr
)
2741 let active = flow m_active
in
2742 let first = calcfirst m_first
active in
2743 G.postRedisplay "outline updownlevel";
2744 {< m_active
= active; m_first
= first >}
2746 method private key1
key mask
=
2747 let set1 active first qsearch
=
2748 coe {< m_active
= active; m_first
= first; m_qsearch
= qsearch
>}
2750 let search active pattern incr
=
2751 let active = if active = -1 then m_first
else active in
2754 if n >= 0 && n < source#getitemcount
2756 let s, _ = source#getitem
n in
2757 match Str.search_forward re
s 0 with
2758 | (exception Not_found
) -> loop (n + incr
)
2765 let qpat = Str.quote pattern
in
2766 match Str.regexp_case_fold
qpat with
2769 adderrfmt "listview key1" "regexp_case_fold for `%S' failed: %S\n"
2770 qpat @@ Printexc.to_string exn
;
2773 let itemcount = source#getitemcount
in
2774 let find start incr
=
2776 if i
= -1 || i
= itemcount
2779 if source#hasaction i
2781 else find (i
+ incr
)
2786 let set active first =
2787 let first = bound
first 0 (itemcount - fstate
.maxrows
) in
2789 coe {< m_active
= active; m_first
= first; m_qsearch
= E.s >}
2792 let isvisible first n = n >= first && n - first <= fstate
.maxrows
in
2794 let incr1 = if incr
> 0 then 1 else -1 in
2795 if isvisible m_first m_active
2798 let next = m_active
+ incr
in
2800 if next < 0 || next >= itemcount
2802 else find next incr1
2804 if abs
(m_active
- next) > fstate
.maxrows
2810 let first = m_first
+ incr
in
2811 let first = bound
first 0 (itemcount - fstate
.maxrows
) in
2813 let next = m_active
+ incr
in
2814 let next = bound
next 0 (itemcount - 1) in
2821 if isvisible first next
2828 let first = min
next m_first
in
2830 if abs
(next - first) > fstate
.maxrows
2836 let first = m_first
+ incr
in
2837 let first = bound
first 0 (itemcount - 1) in
2839 let next = m_active
+ incr
in
2840 let next = bound
next 0 (itemcount - 1) in
2841 let next = find next incr1 in
2843 if next = -1 || abs
(m_active
- first) > fstate
.maxrows
2845 let active = if m_active
= -1 then next else m_active
in
2850 if isvisible first active
2856 G.postRedisplay "listview navigate";
2860 | (@r
|@s) when Wsi.withctrl mask
->
2861 let incr = if key = @r
then -1 else 1 in
2863 match search (m_active
+ incr) m_qsearch
incr with
2865 state
.text <- m_qsearch ^
" [not found]";
2868 state
.text <- m_qsearch
;
2869 active, firstof m_first
active
2871 G.postRedisplay "listview ctrl-r/s";
2872 set1 active first m_qsearch
;
2874 | @insert
when Wsi.withctrl mask
->
2875 if m_active
>= 0 && m_active
< source#getitemcount
2877 let s, _ = source#getitem m_active
in
2883 if emptystr m_qsearch
2886 let qsearch = withoutlastutf8 m_qsearch
in
2890 G.postRedisplay "listview empty qsearch";
2891 set1 m_active m_first
E.s;
2895 match search m_active
qsearch ~
-1 with
2897 state
.text <- qsearch ^
" [not found]";
2900 state
.text <- qsearch;
2901 active, firstof m_first
active
2903 G.postRedisplay "listview backspace qsearch";
2904 set1 active first qsearch
2907 | key when (key != 0 && not
(Wsi.isspecialkey
key)) ->
2908 let pattern = m_qsearch ^ toutf8
key in
2910 match search m_active
pattern 1 with
2912 state
.text <- pattern ^
" [not found]";
2915 state
.text <- pattern;
2916 active, firstof m_first
active
2918 G.postRedisplay "listview qsearch add";
2919 set1 active first pattern;
2923 if emptystr m_qsearch
2925 G.postRedisplay "list view escape";
2926 let mx, my
= state
.mpos
in
2930 source#exit ~uioh
:(coe self
)
2931 ~cancel
:true ~
active:m_active ~
first:m_first ~pan
:m_pan
2933 | None
-> m_prev_uioh
2938 G.postRedisplay "list view kill qsearch";
2939 coe {< m_qsearch
= E.s >}
2942 | @enter
| @kpenter
->
2944 let self = {< m_qsearch
= E.s >} in
2946 G.postRedisplay "listview enter";
2947 if m_active
>= 0 && m_active
< source#getitemcount
2949 source#exit ~uioh
:(coe self) ~cancel
:false
2950 ~
active:m_active ~
first:m_first ~pan
:m_pan
;
2953 source#exit ~uioh
:(coe self) ~cancel
:true
2954 ~
active:m_active ~
first:m_first ~pan
:m_pan
;
2957 begin match opt with
2958 | None
-> m_prev_uioh
2962 | @delete
| @kpdelete
->
2965 | @up
| @kpup
-> navigate ~
-1
2966 | @down
| @kpdown
-> navigate 1
2967 | @prior
| @kpprior
-> navigate ~
-(fstate
.maxrows
)
2968 | @next | @kpnext
-> navigate fstate
.maxrows
2970 | @right
| @kpright
->
2972 G.postRedisplay "listview right";
2973 coe {< m_pan
= m_pan
- 1 >}
2975 | @left | @kpleft
->
2977 G.postRedisplay "listview left";
2978 coe {< m_pan
= m_pan
+ 1 >}
2980 | @home
| @kphome
->
2981 let active = find 0 1 in
2982 G.postRedisplay "listview home";
2986 let first = max
0 (itemcount - fstate
.maxrows
) in
2987 let active = find (itemcount - 1) ~
-1 in
2988 G.postRedisplay "listview end";
2991 | key when (key = 0 || Wsi.isspecialkey
key) ->
2995 dolog
"listview unknown key %#x" key; coe self
2997 method key key mask
=
2998 match state
.mode
with
2999 | Textentry te
-> textentrykeyboard key mask te
; coe self
3002 | LinkNav
_ -> self#key1
key mask
3004 method button button down
x y _ =
3007 | 1 when vscrollhit x ->
3008 G.postRedisplay "listview scroll";
3011 let _, position, sh = self#
scrollph in
3012 if y > truncate
position && y < truncate
(position +. sh)
3014 state
.mstate
<- Mscrolly
;
3018 let s = float (max
0 (y - conf
.scrollh
)) /. float state
.winh
in
3019 let first = truncate
(s *. float source#getitemcount
) in
3020 let first = min source#getitemcount
first in
3021 Some
(coe {< m_first
= first; m_active
= first >})
3023 state
.mstate
<- Mnone
;
3027 begin match self#elemunder
y with
3029 G.postRedisplay "listview click";
3030 source#exit ~uioh
:(coe {< m_active
= n >})
3031 ~cancel
:false ~
active:n ~
first:m_first ~pan
:m_pan
3035 | n when (n == 4 || n == 5) && not down
->
3036 let len = source#getitemcount
in
3038 if n = 5 && m_first
+ fstate
.maxrows
>= len
3042 let first = m_first
+ (if n == 4 then -1 else 1) in
3043 bound
first 0 (len - 1)
3045 G.postRedisplay "listview wheel";
3046 Some
(coe {< m_first
= first >})
3047 | n when (n = 6 || n = 7) && not down
->
3048 let inc = if n = 7 then -1 else 1 in
3049 G.postRedisplay "listview hwheel";
3050 Some
(coe {< m_pan
= m_pan
+ inc >})
3055 | None
-> m_prev_uioh
3058 method multiclick
_ x y = self#button
1 true x y
3061 match state
.mstate
with
3063 let s = float (max
0 (y - conf
.scrollh
)) /. float state
.winh
in
3064 let first = truncate
(s *. float source#getitemcount
) in
3065 let first = min source#getitemcount
first in
3066 G.postRedisplay "listview motion";
3067 coe {< m_first
= first; m_active
= first >}
3075 method pmotion
x y =
3076 if x < state
.winw
- conf
.scrollbw
3079 match self#elemunder
y with
3080 | None
-> Wsi.setcursor
Wsi.CURSOR_INHERIT
; m_active
3081 | Some
n -> Wsi.setcursor
Wsi.CURSOR_INFO
; n
3085 then (G.postRedisplay "listview pmotion"; {< m_active
= n >})
3090 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
3094 method infochanged
_ = ()
3096 method scrollpw
= (0, 0.0, 0.0)
3098 let nfs = fstate
.fontsize
+ 1 in
3099 let y = m_first
* nfs in
3100 let itemcount = source#getitemcount
in
3101 let maxi = max
0 (itemcount - fstate
.maxrows
) in
3102 let maxy = maxi * nfs in
3103 let p, h = scrollph y maxy in
3106 method modehash
= modehash
3107 method eformsgs
= false
3108 method alwaysscrolly
= true
3111 class outlinelistview ~zebra ~source
=
3112 let settext autonarrow
s =
3115 let ss = source#statestr
in
3119 else "{" ^
ss ^
"} [" ^
s ^
"]"
3120 else state
.text <- s
3126 ~source
:(source
:> lvsource
)
3128 ~modehash
:(findkeyhash conf
"outline")
3131 val m_autonarrow
= false
3133 method! key key mask
=
3135 if emptystr state
.text
3137 else fstate
.maxrows - 2
3139 let calcfirst first active =
3142 let rows = active - first in
3143 if rows > maxrows then active - maxrows else first
3147 let active = m_active
+ incr in
3148 let active = bound
active 0 (source#getitemcount
- 1) in
3149 let first = calcfirst m_first
active in
3150 G.postRedisplay "outline navigate";
3151 coe {< m_active
= active; m_first
= first >}
3153 let navscroll first =
3155 let dist = m_active
- first in
3161 else first + maxrows
3164 G.postRedisplay "outline navscroll";
3165 coe {< m_first
= first; m_active
= active >}
3167 let ctrl = Wsi.withctrl mask
in
3172 then (source#denarrow
; E.s)
3174 let pattern = source#renarrow
in
3175 if nonemptystr m_qsearch
3176 then (source#narrow m_qsearch
; m_qsearch
)
3180 settext (not m_autonarrow
) text;
3181 G.postRedisplay "toggle auto narrowing";
3182 coe {< m_first
= 0; m_active
= 0; m_autonarrow
= not m_autonarrow
>}
3184 | @slash
when emptystr m_qsearch
&& not m_autonarrow
->
3186 G.postRedisplay "toggle auto narrowing";
3187 coe {< m_first
= 0; m_active
= 0; m_autonarrow
= true >}
3190 source#narrow m_qsearch
;
3192 then source#add_narrow_pattern m_qsearch
;
3193 G.postRedisplay "outline ctrl-n";
3194 coe {< m_first
= 0; m_active
= 0 >}
3197 let active = source#calcactive
(getanchor
()) in
3198 let first = firstof m_first
active in
3199 G.postRedisplay "outline ctrl-s";
3200 coe {< m_first
= first; m_active
= active >}
3203 G.postRedisplay "outline ctrl-u";
3204 if m_autonarrow
&& nonemptystr m_qsearch
3206 ignore
(source#renarrow
);
3207 settext m_autonarrow
E.s;
3208 coe {< m_first
= 0; m_active
= 0; m_qsearch
= E.s >}
3211 source#del_narrow_pattern
;
3212 let pattern = source#renarrow
in
3214 if emptystr
pattern then E.s else "Narrowed to " ^
pattern
3216 settext m_autonarrow
text;
3217 coe {< m_first
= 0; m_active
= 0; m_qsearch
= E.s >}
3221 let first = max
0 (m_active
- (fstate
.maxrows / 2)) in
3222 G.postRedisplay "outline ctrl-l";
3223 coe {< m_first
= first >}
3225 | @tab
when m_autonarrow
->
3226 if nonemptystr m_qsearch
3228 G.postRedisplay "outline list view tab";
3229 source#add_narrow_pattern m_qsearch
;
3231 coe {< m_qsearch
= E.s >}
3235 | @escape
when m_autonarrow
->
3236 if nonemptystr m_qsearch
3237 then source#add_narrow_pattern m_qsearch
;
3240 | @enter
| @kpenter
when m_autonarrow
->
3241 if nonemptystr m_qsearch
3242 then source#add_narrow_pattern m_qsearch
;
3245 | key when m_autonarrow
&& (not
(Wsi.isspecialkey
key)) ->
3246 let pattern = m_qsearch ^ toutf8
key in
3247 G.postRedisplay "outlinelistview autonarrow add";
3248 source#narrow
pattern;
3249 settext true pattern;
3250 coe {< m_first
= 0; m_active
= 0; m_qsearch
= pattern >}
3252 | key when m_autonarrow
&& key = @backspace
->
3253 if emptystr m_qsearch
3256 let pattern = withoutlastutf8 m_qsearch
in
3257 G.postRedisplay "outlinelistview autonarrow backspace";
3258 ignore
(source#renarrow
);
3259 source#narrow
pattern;
3260 settext true pattern;
3261 coe {< m_first
= 0; m_active
= 0; m_qsearch
= pattern >}
3263 | @up
| @kpup
when ctrl ->
3264 navscroll (max
0 (m_first
- 1))
3266 | @down
| @kpdown
when ctrl ->
3267 navscroll (min
(source#getitemcount
- 1) (m_first
+ 1))
3269 | @up
| @kpup
-> navigate ~
-1
3270 | @down
| @kpdown
-> navigate 1
3271 | @prior
| @kpprior
-> navigate ~
-(fstate
.maxrows)
3272 | @next | @kpnext
-> navigate fstate
.maxrows
3274 | @right
| @kpright
->
3278 G.postRedisplay "outline ctrl right";
3279 {< m_pan
= m_pan
+ 1 >}
3281 else self#updownlevel
1
3285 | @left | @kpleft
->
3289 G.postRedisplay "outline ctrl left";
3290 {< m_pan
= m_pan
- 1 >}
3292 else self#updownlevel ~
-1
3296 | @home
| @kphome
->
3297 G.postRedisplay "outline home";
3298 coe {< m_first
= 0; m_active
= 0 >}
3301 let active = source#getitemcount
- 1 in
3302 let first = max
0 (active - fstate
.maxrows) in
3303 G.postRedisplay "outline end";
3304 coe {< m_active
= active; m_first
= first >}
3306 | _ -> super#
key key mask
3309 let genhistoutlines () =
3311 |> List.sort
(fun (_, c1
, _, _, _, _) (_, c2
, _, _, _, _) ->
3312 compare c2
.lastvisit c1
.lastvisit
)
3314 (fun ((path
, c, _, _, _, origin
) as hist
) ->
3315 let path = if nonemptystr origin
then origin
else path in
3316 let base = mbtoutf8
@@ Filename.basename
path in
3317 (base ^
"\000" ^
c.title
, 1, Ohistory hist
)
3322 let gotohist (path, c, bookmarks
, x, anchor, origin
) =
3323 Config.save
leavebirdseye;
3324 state
.anchor <- anchor;
3325 state
.bookmarks
<- bookmarks
;
3326 state
.origin
<- origin
;
3329 let x0, y0, x1, y1 = conf
.trimfuzz
in
3330 wcmd "trimset %d %d %d %d %d" (btod conf
.trimmargins
) x0 y0 x1 y1;
3331 reshape ~firsttime
:true state
.winw state
.winh
;
3332 opendoc path origin
;
3336 let makecheckers () =
3337 (* Based on lablGL-1.04/LablGlut/examples/lablGL/checker.ml which had
3339 converted by Issac Trotts. July 25, 2002 *)
3340 let image = GlPix.create `ubyte ~format
:`luminance ~width
:2 ~height
:2 in
3341 Raw.sets_string
(GlPix.to_raw
image) ~
pos:0 "\255\200\200\255";
3342 let id = GlTex.gen_texture
() in
3343 GlTex.bind_texture ~target
:`texture_2d
id;
3344 GlPix.store
(`unpack_alignment
1);
3345 GlTex.image2d
image;
3346 List.iter
(GlTex.parameter ~target
:`texture_2d
)
3347 [ `mag_filter `nearest
; `min_filter `nearest
];
3351 let setcheckers enabled
=
3352 match state
.checkerstexid
with
3354 if enabled
then state
.checkerstexid
<- Some
(makecheckers ())
3356 | Some checkerstexid
->
3359 GlTex.delete_texture checkerstexid
;
3360 state
.checkerstexid
<- None
;
3364 let describe_location () =
3365 let fn = page_of_y state
.y in
3366 let ln = page_of_y
(state
.y + state
.winh
- hscrollh () - 1) in
3367 let maxy = state
.maxy - (if conf
.maxhfit
then state
.winh
else 0) in
3371 else (100. *. (float state
.y /. float maxy))
3375 Printf.sprintf
"page %d of %d [%.2f%%]"
3376 (fn+1) state
.pagecount
percent
3379 "pages %d-%d of %d [%.2f%%]"
3380 (fn+1) (ln+1) state
.pagecount
percent
3383 let setpresentationmode v
=
3384 let n = page_of_y state
.y in
3385 state
.anchor <- (n, 0.0, 1.0);
3386 conf
.presentation
<- v
;
3387 if conf
.fitmodel
= FitPage
3388 then reqlayout conf
.angle conf
.fitmodel
;
3392 let setbgcol (r
, g, b) =
3394 let r = r *. 255.0 |> truncate
3395 and g = g *. 255.0 |> truncate
3396 and b = b *. 255.0 |> truncate
in
3397 r lsl 16 |> (lor) (g lsl 8) |> (lor) b
3399 Wsi.setwinbgcol
col;
3403 let btos b = if b then "@Uradical" else E.s in
3404 let showextended = ref false in
3405 let leave mode
_ = state
.mode
<- mode
in
3408 val mutable m_l
= []
3409 val mutable m_a
= E.a
3410 val mutable m_prev_uioh
= nouioh
3411 val mutable m_prev_mode
= View
3413 inherit lvsourcebase
3415 method reset prev_mode prev_uioh
=
3416 m_a
<- Array.of_list
(List.rev m_l
);
3418 m_prev_mode
<- prev_mode
;
3419 m_prev_uioh
<- prev_uioh
;
3421 method int name get
set =
3423 (name
, `
int get
, 1, Action
(
3426 try set (int_of_string
s)
3428 state
.text <- Printf.sprintf
"bad integer `%s': %s"
3432 let te = name ^
": ", E.s, None
, intentry, ondone, true in
3433 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3437 method int_with_suffix name get
set =
3439 (name
, `intws get
, 1, Action
(
3442 try set (int_of_string_with_suffix
s)
3444 state
.text <- Printf.sprintf
"bad integer `%s': %s"
3449 name ^
": ", E.s, None
, intentry_with_suffix, ondone, true
3451 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3455 method bool ?
(offset
=1) ?
(btos=btos) name get
set =
3457 (name
, `
bool (btos, get
), offset
, Action
(
3464 method color name get
set =
3466 (name
, `
color get
, 1, Action
(
3468 let invalid = (nan
, nan
, nan
) in
3471 try color_of_string
s
3473 state
.text <- Printf.sprintf
"bad color `%s': %s"
3480 let te = name ^
": ", E.s, None
, textentry, ondone, true in
3481 state
.text <- color_to_string
(get
());
3482 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3486 method string name get
set =
3488 (name
, `
string get
, 1, Action
(
3490 let ondone s = set s in
3491 let te = name ^
": ", E.s, None
, textentry, ondone, true in
3492 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3496 method colorspace name get
set =
3498 (name
, `
string get
, 1, Action
(
3502 inherit lvsourcebase
3505 m_active
<- CSTE.to_int conf
.colorspace
;
3508 method getitemcount
=
3509 Array.length
CSTE.names
3512 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3513 ignore
(uioh
, first, pan
);
3514 if not cancel
then set active;
3516 method hasaction
_ = true
3520 let modehash = findkeyhash conf
"info" in
3521 coe (new listview ~zebra
:false ~helpmode
:false
3522 ~
source ~trusted
:true ~
modehash)
3525 method paxmark name get
set =
3527 (name
, `
string get
, 1, Action
(
3531 inherit lvsourcebase
3534 m_active
<- MTE.to_int conf
.paxmark
;
3537 method getitemcount
= Array.length
MTE.names
3538 method getitem
n = (MTE.names
.(n), 0)
3539 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3540 ignore
(uioh
, first, pan
);
3541 if not cancel
then set active;
3543 method hasaction
_ = true
3547 let modehash = findkeyhash conf
"info" in
3548 coe (new listview ~zebra
:false ~helpmode
:false
3549 ~
source ~trusted
:true ~
modehash)
3552 method fitmodel name get
set =
3554 (name
, `
string get
, 1, Action
(
3558 inherit lvsourcebase
3561 m_active
<- FMTE.to_int conf
.fitmodel
;
3564 method getitemcount
= Array.length
FMTE.names
3565 method getitem
n = (FMTE.names
.(n), 0)
3566 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3567 ignore
(uioh
, first, pan
);
3568 if not cancel
then set active;
3570 method hasaction
_ = true
3574 let modehash = findkeyhash conf
"info" in
3575 coe (new listview ~zebra
:false ~helpmode
:false
3576 ~
source ~trusted
:true ~
modehash)
3579 method caption
s offset
=
3580 m_l
<- (s, `empty
, offset
, Noaction
) :: m_l
3582 method caption2
s f offset
=
3583 m_l
<- (s, `
string f, offset
, Noaction
) :: m_l
3585 method getitemcount
= Array.length m_a
3588 let tostr = function
3589 | `
int f -> string_of_int
(f ())
3590 | `intws
f -> string_with_suffix_of_int
(f ())
3592 | `
color f -> color_to_string
(f ())
3593 | `
bool (btos, f) -> btos (f ())
3596 let name, t
, offset
, _ = m_a
.(n) in
3597 ((let s = tostr t
in
3599 then Printf.sprintf
"%s\t%s" name s
3603 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3608 match m_a
.(active) with
3609 | _, _, _, Action
f -> f uioh
3610 | _, _, _, Noaction
-> uioh
3621 method hasaction
n =
3623 | _, _, _, Action
_ -> true
3624 | _, _, _, Noaction
-> false
3626 initializer m_active
<- 1
3629 let rec fillsrc prevmode prevuioh
=
3630 let sep () = src#caption
E.s 0 in
3631 let colorp name get
set =
3633 (fun () -> color_to_string
(get
()))
3636 let c = color_of_string
v in
3639 state
.text <- Printf.sprintf
"bad color `%s': %s" v @@ exntos exn
3642 let oldmode = state
.mode
in
3643 let birdseye = isbirdseye state
.mode
in
3645 src#caption
(if birdseye then "Setup (Bird's eye)" else "Setup") 0;
3647 src#
bool "presentation mode"
3648 (fun () -> conf
.presentation
)
3649 (fun v -> setpresentationmode v);
3651 src#
bool "ignore case in searches"
3652 (fun () -> conf
.icase
)
3653 (fun v -> conf
.icase
<- v);
3656 (fun () -> conf
.preload)
3657 (fun v -> conf
.preload <- v);
3659 src#
bool "highlight links"
3660 (fun () -> conf
.hlinks
)
3661 (fun v -> conf
.hlinks
<- v);
3663 src#
bool "under info"
3664 (fun () -> conf
.underinfo
)
3665 (fun v -> conf
.underinfo
<- v);
3667 src#
bool "persistent bookmarks"
3668 (fun () -> conf
.savebmarks
)
3669 (fun v -> conf
.savebmarks
<- v);
3671 src#fitmodel
"fit model"
3672 (fun () -> FMTE.to_string conf
.fitmodel
)
3673 (fun v -> reqlayout conf
.angle
(FMTE.of_int
v));
3675 src#
bool "trim margins"
3676 (fun () -> conf
.trimmargins
)
3677 (fun v -> settrim v conf
.trimfuzz
; fillsrc prevmode prevuioh
);
3679 src#
bool "persistent location"
3680 (fun () -> conf
.jumpback
)
3681 (fun v -> conf
.jumpback
<- v);
3684 src#
int "inter-page space"
3685 (fun () -> conf
.interpagespace
)
3687 conf
.interpagespace
<- n;
3688 docolumns conf
.columns
;
3690 match state
.layout with
3695 state
.maxy <- calcheight
();
3696 let y = getpagey
pageno in
3697 gotoxy state
.x (y + py)
3701 (fun () -> conf
.pagebias
)
3702 (fun v -> conf
.pagebias
<- v);
3704 src#
int "scroll step"
3705 (fun () -> conf
.scrollstep
)
3706 (fun n -> conf
.scrollstep
<- n);
3708 src#
int "horizontal scroll step"
3709 (fun () -> conf
.hscrollstep
)
3710 (fun v -> conf
.hscrollstep
<- v);
3712 src#
int "auto scroll step"
3714 match state
.autoscroll
with
3716 | _ -> conf
.autoscrollstep
)
3718 let n = boundastep state
.winh
n in
3719 if state
.autoscroll
<> None
3720 then state
.autoscroll
<- Some
n;
3721 conf
.autoscrollstep
<- n);
3724 (fun () -> truncate
(conf
.zoom *. 100.))
3725 (fun v -> setzoom ((float v) /. 100.));
3728 (fun () -> conf
.angle
)
3729 (fun v -> reqlayout v conf
.fitmodel
);
3731 src#
int "scroll bar width"
3732 (fun () -> conf
.scrollbw
)
3735 reshape state
.winw state
.winh
;
3738 src#
int "scroll handle height"
3739 (fun () -> conf
.scrollh
)
3740 (fun v -> conf
.scrollh
<- v;);
3742 src#
int "thumbnail width"
3743 (fun () -> conf
.thumbw
)
3745 conf
.thumbw
<- min
4096 v;
3748 leavebirdseye beye
false;
3755 let mode = state
.mode in
3756 src#
string "columns"
3758 match conf
.columns
with
3760 | Cmulti
(multi
, _) -> multicolumns_to_string multi
3761 | Csplit
(count
, _) -> "-" ^ string_of_int count
3764 let n, a, b = multicolumns_of_string
v in
3765 setcolumns mode n a b);
3768 src#caption
"Pixmap cache" 0;
3769 src#int_with_suffix
"size (advisory)"
3770 (fun () -> conf
.memlimit
)
3771 (fun v -> conf
.memlimit
<- v);
3774 (fun () -> Printf.sprintf
"%s bytes, %d tiles"
3775 (string_with_suffix_of_int state
.memused
)
3776 (Hashtbl.length state
.tilemap
)) 1;
3779 src#caption
"Layout" 0;
3780 src#caption2
"Dimension"
3782 Printf.sprintf
"%dx%d (virtual %dx%d)"
3783 state
.winw state
.winh
3788 src#caption2
"Position" (fun () ->
3789 Printf.sprintf
"%dx%d" state
.x state
.y
3792 src#caption2
"Position" (fun () -> describe_location ()) 1
3796 src#
bool ~offset
:0 ~
btos:(fun v -> if v then "(on)" else "(off)")
3797 "Save these parameters as global defaults at exit"
3798 (fun () -> conf
.bedefault
)
3799 (fun v -> conf
.bedefault
<- v)
3803 let btos b = if b then "@Ulguillemet" else "@Urguillemet" in
3804 src#
bool ~offset
:0 ~
btos "Extended parameters"
3805 (fun () -> !showextended)
3806 (fun v -> showextended := v; fillsrc prevmode prevuioh
);
3810 (fun () -> conf
.checkers
)
3811 (fun v -> conf
.checkers
<- v; setcheckers v);
3812 src#
bool "update cursor"
3813 (fun () -> conf
.updatecurs
)
3814 (fun v -> conf
.updatecurs
<- v);
3815 src#
bool "scroll-bar on the left"
3816 (fun () -> conf
.leftscroll
)
3817 (fun v -> conf
.leftscroll
<- v);
3819 (fun () -> conf
.verbose
)
3820 (fun v -> conf
.verbose
<- v);
3821 src#
bool "invert colors"
3822 (fun () -> conf
.invert
)
3823 (fun v -> conf
.invert
<- v);
3825 (fun () -> conf
.maxhfit
)
3826 (fun v -> conf
.maxhfit
<- v);
3828 (fun () -> conf
.pax
!= None
)
3831 then conf
.pax
<- Some
(ref (now
(), 0, 0))
3832 else conf
.pax
<- None
);
3833 src#
string "uri launcher"
3834 (fun () -> conf
.urilauncher
)
3835 (fun v -> conf
.urilauncher
<- v);
3836 src#
string "path launcher"
3837 (fun () -> conf
.pathlauncher
)
3838 (fun v -> conf
.pathlauncher
<- v);
3839 src#
string "tile size"
3840 (fun () -> Printf.sprintf
"%dx%d" conf
.tilew conf
.tileh
)
3843 let w, h = Scanf.sscanf
v "%dx%d" (fun w h -> w, h) in
3844 conf
.tilew
<- max
64 w;
3845 conf
.tileh
<- max
64 h;
3848 state
.text <- Printf.sprintf
"bad tile size `%s': %s"
3851 src#
int "texture count"
3852 (fun () -> conf
.texcount
)
3855 then conf
.texcount
<- v
3856 else impmsg "failed to set texture count please retry later"
3858 src#
int "slice height"
3859 (fun () -> conf
.sliceheight
)
3861 conf
.sliceheight
<- v;
3862 wcmd "sliceh %d" conf
.sliceheight
;
3864 src#
int "anti-aliasing level"
3865 (fun () -> conf
.aalevel
)
3867 conf
.aalevel
<- bound
v 0 8;
3868 state
.anchor <- getanchor
();
3869 opendoc state
.path state
.password;
3871 src#
string "page scroll scaling factor"
3872 (fun () -> string_of_float conf
.pgscale)
3875 let s = float_of_string
v in
3878 state
.text <- Printf.sprintf
3879 "bad page scroll scaling factor `%s': %s" v @@ exntos exn
3882 src#
int "ui font size"
3883 (fun () -> fstate
.fontsize
)
3884 (fun v -> setfontsize (bound
v 5 100));
3885 src#
int "hint font size"
3886 (fun () -> conf
.hfsize
)
3887 (fun v -> conf
.hfsize
<- bound
v 5 100);
3888 colorp "background color"
3889 (fun () -> conf
.bgcolor
)
3890 (fun v -> conf
.bgcolor
<- v; setbgcol v);
3891 src#
bool "crop hack"
3892 (fun () -> conf
.crophack
)
3893 (fun v -> conf
.crophack
<- v);
3894 src#
string "trim fuzz"
3895 (fun () -> irect_to_string conf
.trimfuzz
)
3898 conf
.trimfuzz
<- irect_of_string
v;
3900 then settrim true conf
.trimfuzz
;
3902 state
.text <- Printf.sprintf
"bad irect `%s': %s" v @@ exntos exn
3904 src#
string "throttle"
3906 match conf
.maxwait
with
3907 | None
-> "show place holder if page is not ready"
3910 then "wait for page to fully render"
3912 "wait " ^ string_of_float
time
3913 ^
" seconds before showing placeholder"
3917 let f = float_of_string
v in
3919 then conf
.maxwait
<- None
3920 else conf
.maxwait
<- Some
f
3922 state
.text <- Printf.sprintf
"bad time `%s': %s" v @@ exntos exn
3924 src#
string "ghyll scroll"
3926 match conf
.ghyllscroll
with
3928 | Some nab
-> ghyllscroll_to_string nab
3931 try conf
.ghyllscroll
<- ghyllscroll_of_string
v
3934 state
.text <- Printf.sprintf
"bad ghyll `%s': %s" v msg
3936 state
.text <- Printf.sprintf
"bad ghyll `%s': %s" v @@ exntos exn
3938 src#
string "selection command"
3939 (fun () -> conf
.selcmd
)
3940 (fun v -> conf
.selcmd
<- v);
3941 src#
string "synctex command"
3942 (fun () -> conf
.stcmd
)
3943 (fun v -> conf
.stcmd
<- v);
3944 src#
string "pax command"
3945 (fun () -> conf
.paxcmd
)
3946 (fun v -> conf
.paxcmd
<- v);
3947 src#
string "ask password command"
3948 (fun () -> conf
.passcmd)
3949 (fun v -> conf
.passcmd <- v);
3950 src#
string "save path command"
3951 (fun () -> conf
.savecmd
)
3952 (fun v -> conf
.savecmd
<- v);
3953 src#colorspace
"color space"
3954 (fun () -> CSTE.to_string conf
.colorspace
)
3956 conf
.colorspace
<- CSTE.of_int
v;
3960 src#paxmark
"pax mark method"
3961 (fun () -> MTE.to_string conf
.paxmark
)
3962 (fun v -> conf
.paxmark
<- MTE.of_int
v);
3963 if bousable
() && !opengl_has_pbo
3966 (fun () -> conf
.usepbo
)
3967 (fun v -> conf
.usepbo
<- v);
3968 src#
bool "mouse wheel scrolls pages"
3969 (fun () -> conf
.wheelbypage
)
3970 (fun v -> conf
.wheelbypage
<- v);
3971 src#
bool "open remote links in a new instance"
3972 (fun () -> conf
.riani
)
3973 (fun v -> conf
.riani
<- v);
3974 src#
bool "edit annotations inline"
3975 (fun () -> conf
.annotinline
)
3976 (fun v -> conf
.annotinline
<- v);
3977 src#
bool "coarse positioning in presentation mode"
3978 (fun () -> conf
.coarseprespos
)
3979 (fun v -> conf
.coarseprespos
<- v);
3983 src#caption
"Document" 0;
3984 List.iter
(fun (_, s) -> src#caption
s 1) state
.docinfo
;
3985 src#caption2
"Pages"
3986 (fun () -> string_of_int state
.pagecount
) 1;
3987 src#caption2
"Dimensions"
3988 (fun () -> string_of_int
(List.length state
.pdims
)) 1;
3992 src#caption
"Trimmed margins" 0;
3993 src#caption2
"Dimensions"
3994 (fun () -> string_of_int
(List.length state
.pdims
)) 1;
3998 src#caption
"OpenGL" 0;
3999 src#caption
(Printf.sprintf
"Vendor\t%s" (GlMisc.get_string `vendor
)) 1;
4000 src#caption
(Printf.sprintf
"Renderer\t%s" (GlMisc.get_string `renderer
)) 1;
4003 src#caption
"Location" 0;
4004 if nonemptystr state
.origin
4005 then src#caption
("Orign\t" ^ mbtoutf8 state
.origin
) 1;
4006 src#caption
("Path\t" ^ mbtoutf8 state
.path) 1;
4008 src#reset prevmode prevuioh
;
4013 let prevmode = state
.mode
4014 and prevuioh
= state
.uioh in
4015 fillsrc prevmode prevuioh
;
4016 let source = (src :> lvsource
) in
4017 let modehash = findkeyhash conf
"info" in
4018 state
.uioh <- coe (object (self)
4019 inherit listview ~zebra
:false ~helpmode
:false
4020 ~
source ~trusted
:true ~
modehash as super
4021 val mutable m_prevmemused
= 0
4022 method! infochanged
= function
4024 if m_prevmemused
!= state
.memused
4026 m_prevmemused
<- state
.memused
;
4027 G.postRedisplay "memusedchanged";
4029 | Pdim
-> G.postRedisplay "pdimchanged"
4030 | Docinfo
-> fillsrc prevmode prevuioh
4032 method! key key mask
=
4033 if not
(Wsi.withctrl mask
)
4036 | @left | @kpleft
-> coe (self#updownlevel ~
-1)
4037 | @right
| @kpright
-> coe (self#updownlevel
1)
4038 | _ -> super#
key key mask
4039 else super#
key key mask
4041 G.postRedisplay "info";
4047 inherit lvsourcebase
4048 method getitemcount
= Array.length state
.help
4050 let s, l, _ = state
.help
.(n) in
4053 method exit ~
uioh ~cancel ~
active ~
first ~pan
=
4057 match state
.help
.(active) with
4058 | _, _, Action
f -> Some
(f uioh)
4059 | _, _, Noaction
-> Some
uioh
4068 method hasaction
n =
4069 match state
.help
.(n) with
4070 | _, _, Action
_ -> true
4071 | _, _, Noaction
-> false
4077 let modehash = findkeyhash conf
"help" in
4079 state
.uioh <- coe (new listview
4080 ~zebra
:false ~helpmode
:true
4081 ~
source ~trusted
:true ~
modehash);
4082 G.postRedisplay "help";
4088 inherit lvsourcebase
4089 val mutable m_items
= E.a
4091 method getitemcount
= 1 + Array.length m_items
4096 else m_items
.(n-1), 0
4098 method exit ~
uioh ~cancel ~
active ~
first ~pan
=
4103 then Buffer.clear state
.errmsgs
;
4110 method hasaction
n =
4114 state
.newerrmsgs
<- false;
4115 let l = Str.split newlinere
(Buffer.contents state
.errmsgs
) in
4116 m_items
<- Array.of_list
l
4125 let source = (msgsource :> lvsource
) in
4126 let modehash = findkeyhash conf
"listview" in
4127 state
.uioh <- coe (object
4128 inherit listview ~zebra
:false ~helpmode
:false
4129 ~
source ~trusted
:false ~
modehash as super
4132 then msgsource#reset
;
4135 G.postRedisplay "msgs";
4139 let editor = getenvwithdef
"EDITOR" E.s in
4143 let tmppath = Filename.temp_file
"llpp" "note" in
4146 let oc = open_out
tmppath in
4150 let execstr = editor ^
" " ^
tmppath in
4152 match spawn
execstr [] with
4153 | (exception exn
) ->
4154 impmsg "spawn(%S) failed: %s" execstr @@ exntos exn
;
4157 match Unix.waitpid
[] pid with
4158 | (exception exn
) ->
4159 impmsg "waitpid(%d) failed: %s" pid @@ exntos exn
;
4163 | Unix.WEXITED
0 -> filecontents
tmppath
4165 impmsg "editor process(%s) exited abnormally: %d" execstr n;
4167 | Unix.WSIGNALED
n ->
4168 impmsg "editor process(%s) was killed by signal %d" execstr n;
4170 | Unix.WSTOPPED
n ->
4171 impmsg "editor(%s) process was stopped by signal %d" execstr n;
4174 match Unix.unlink
tmppath with
4175 | (exception exn
) ->
4176 impmsg "failed to ulink %S: %s" tmppath @@ exntos exn
;
4181 let enterannotmode opaque slinkindex
=
4184 inherit lvsourcebase
4185 val mutable m_text
= E.s
4186 val mutable m_items
= E.a
4188 method getitemcount
= Array.length m_items
4191 let label, _func
= m_items
.(n) in
4194 method exit ~
uioh ~cancel ~
active ~
first ~pan
=
4195 ignore
(uioh, first, pan
);
4198 let _label, func
= m_items
.(active) in
4203 method hasaction
n = nonemptystr
@@ fst m_items
.(n)
4206 let rec split accu b i
=
4208 if p = String.length
s
4209 then (String.sub
s b (p-b), unit) :: accu
4211 if (i
> 70 && s.[p] = ' '
) || s.[p] = '
\r'
|| s.[p] = '
\n'
4213 let ss = if i
= 0 then E.s else String.sub
s b i
in
4214 split ((ss, unit)::accu) (p+1) 0
4219 wcmd "freepage %s" (~
> opaque);
4221 Hashtbl.fold (fun key opaque'
accu ->
4222 if opaque'
= opaque'
4223 then key :: accu else accu) state
.pagemap
[]
4225 List.iter
(Hashtbl.remove state
.pagemap
) keys;
4227 gotoxy state
.x state
.y
4230 delannot
opaque slinkindex
;
4233 let edit inline
() =
4238 modannot
opaque slinkindex
s;
4244 let mode = state
.mode in
4247 ("annotation: ", m_text
, None
, textentry, update, true),
4248 fun _ -> state
.mode <- mode);
4252 let s = getusertext m_text
in
4257 ( "[Copy]", fun () -> selstring m_text
)
4258 :: ("[Delete]", dele)
4259 :: ("[Edit]", edit conf
.annotinline
)
4261 :: split [] 0 0 |> List.rev
|> Array.of_list
4268 let s = getannotcontents
opaque slinkindex
in
4271 let source = (msgsource :> lvsource
) in
4272 let modehash = findkeyhash conf
"listview" in
4273 state
.uioh <- coe (object
4274 inherit listview ~zebra
:false ~helpmode
:false
4275 ~
source ~trusted
:false ~
modehash
4277 G.postRedisplay "enterannotmode";
4280 let gotounder under =
4281 let getpath filename
=
4283 if nonemptystr filename
4285 if Filename.is_relative filename
4287 let dir = Filename.dirname state
.path in
4289 if Filename.is_implicit
dir
4290 then Filename.concat
(Sys.getcwd
()) dir
4293 Filename.concat
dir filename
4297 if Sys.file_exists
path
4302 | Ulinkgoto
(pageno, top) ->
4307 if conf
.presentation
&& conf
.coarseprespos
4311 gotopage1 pageno top;
4314 | Ulinkuri
s -> gotouri
s
4316 | Uremote
(filename
, pageno) ->
4317 let path = getpath filename
in
4322 let command = Printf.sprintf
"%s -page %d %S" !selfexec pageno path in
4323 match spawn
command [] with
4325 | (exception exn
) ->
4326 dolog
"failed to execute `%s': %s" command @@ exntos exn
4328 let anchor = getanchor
() in
4329 let ranchor = state
.path, state
.password, anchor, state
.origin
in
4330 state
.origin
<- E.s;
4331 state
.anchor <- (pageno, 0.0, 0.0);
4332 state
.ranchors
<- ranchor :: state
.ranchors
;
4335 else impmsg "cannot find %s" filename
4337 | Uremotedest
(filename
, destname
) ->
4338 let path = getpath filename
in
4343 let command = !selfexec ^
" " ^
path ^
" -dest " ^ destname
in
4344 match spawn
command [] with
4345 | (exception exn
) ->
4346 dolog
"failed to execute `%s': %s" command @@ exntos exn
4349 let anchor = getanchor
() in
4350 let ranchor = state
.path, state
.password, anchor, state
.origin
in
4351 state
.origin
<- E.s;
4352 state
.nameddest
<- destname
;
4353 state
.ranchors
<- ranchor :: state
.ranchors
;
4356 else impmsg "cannot find %s" filename
4358 | Uunexpected
_ | Ulaunch
_ | Unamed
_ | Utext
_ | Unone
-> ()
4359 | Uannotation
(opaque, slinkindex
) -> enterannotmode opaque slinkindex
4362 let gotooutline (_, _, kind
) =
4366 let (pageno, y, _) = anchor in
4368 (if conf
.presentation
then (pageno, y, 1.0) else anchor)
4372 | Ouri
uri -> gotounder (Ulinkuri
uri)
4373 | Olaunch cmd
-> gotounder (Ulaunch cmd
)
4374 | Oremote remote
-> gotounder (Uremote remote
)
4375 | Ohistory hist
-> gotohist hist
4376 | Oremotedest remotedest
-> gotounder (Uremotedest remotedest
)
4379 class outlinesoucebase fetchoutlines
= object (self)
4380 inherit lvsourcebase
4381 val mutable m_items
= E.a
4382 val mutable m_minfo
= E.a
4383 val mutable m_orig_items
= E.a
4384 val mutable m_orig_minfo
= E.a
4385 val mutable m_narrow_patterns
= []
4386 val mutable m_gen
= -1
4388 method getitemcount
= Array.length m_items
4391 let s, n, _ = m_items
.(n) in
4394 method exit ~
(uioh:uioh) ~cancel ~
active ~
(first:int) ~pan
:
4396 ignore
(uioh, first);
4398 if m_narrow_patterns
= []
4399 then m_orig_items
, m_orig_minfo
4400 else m_items
, m_minfo
4407 gotooutline m_items
.(active);
4415 method hasaction
(_:int) = true
4418 if Array.length m_items
!= Array.length m_orig_items
4421 match m_narrow_patterns
with
4423 | many
-> String.concat
"@Uellipsis" (List.rev many
)
4425 "Narrowed to " ^
s ^
" (ctrl-u to restore)"
4429 match m_narrow_patterns
with
4432 | head
:: _ -> "@Uellipsis" ^ head
4434 method narrow
pattern =
4435 match Str.regexp_case_fold
pattern with
4436 | (exception _) -> ()
4438 let rec loop accu minfo n =
4441 m_items
<- Array.of_list
accu;
4442 m_minfo
<- Array.of_list
minfo;
4445 let (s, _, _) as o = m_items
.(n) in
4447 match Str.search_forward re
s 0 with
4448 | (exception Not_found
) -> accu, minfo
4449 | first -> o :: accu, (first, Str.match_end
()) :: minfo
4451 loop accu minfo (n-1)
4453 loop [] [] (Array.length m_items
- 1)
4455 method! getminfo
= m_minfo
4458 m_orig_items
<- fetchoutlines
();
4459 m_minfo
<- m_orig_minfo
;
4460 m_items
<- m_orig_items
4462 method add_narrow_pattern
pattern =
4463 m_narrow_patterns
<- pattern :: m_narrow_patterns
4465 method del_narrow_pattern
=
4466 match m_narrow_patterns
with
4467 | _ :: rest
-> m_narrow_patterns
<- rest
4472 match m_narrow_patterns
with
4473 | pattern :: [] -> self#narrow
pattern; pattern
4475 List.fold_left
(fun accu pattern ->
4476 self#narrow
pattern;
4477 pattern ^
"@Uellipsis" ^
accu) E.s list
4479 method calcactive
(_:anchor) = 0
4481 method reset
anchor items =
4482 if state
.gen
!= m_gen
4484 m_orig_items
<- items;
4486 m_narrow_patterns
<- [];
4488 m_orig_minfo
<- E.a;
4492 if items != m_orig_items
4494 m_orig_items
<- items;
4495 if m_narrow_patterns
== []
4496 then m_items
<- items;
4499 let active = self#calcactive
anchor in
4501 m_first
<- firstof m_first
active
4505 let outlinesource fetchoutlines
=
4507 inherit outlinesoucebase fetchoutlines
4508 method! calcactive
anchor =
4509 let rely = getanchory anchor in
4510 let rec loop n best bestd
=
4511 if n = Array.length m_items
4514 let _, _, kind
= m_items
.(n) in
4517 let orely = getanchory anchor in
4518 let d = abs
(orely - rely) in
4521 else loop (n+1) best bestd
4522 | Onone
| Oremote
_ | Olaunch
_
4523 | Oremotedest
_ | Ouri
_ | Ohistory
_ ->
4524 loop (n+1) best bestd
4530 let enteroutlinemode, enterbookmarkmode
, enterhistmode
=
4531 let mkselector sourcetype
=
4532 let fetchoutlines () =
4533 match sourcetype
with
4534 | `bookmarks
-> Array.of_list state
.bookmarks
4535 | `outlines
-> state
.outlines
4536 | `history
-> genhistoutlines ()
4539 if sourcetype
= `history
4540 then new outlinesoucebase
fetchoutlines
4541 else outlinesource fetchoutlines
4544 let outlines = fetchoutlines () in
4545 if Array.length
outlines = 0
4547 showtext ' ' errmsg
;
4551 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
4552 let anchor = getanchor
() in
4553 source#reset
anchor outlines;
4554 state
.text <- source#greetmsg
;
4556 coe (new outlinelistview ~zebra
:(sourcetype
=`history
) ~
source);
4557 G.postRedisplay "enter selector";
4560 let mkenter sourcetype errmsg
=
4561 let enter = mkselector sourcetype
in
4562 fun () -> enter errmsg
4564 (**)mkenter `
outlines "document has no outline"
4565 , mkenter `bookmarks
"document has no bookmarks (yet)"
4566 , mkenter `history
"history is empty"
4569 let quickbookmark ?title
() =
4570 match state
.layout with
4576 let tm = Unix.localtime
(now
()) in
4578 "Quick (page %d) (bookmarked at %02d/%02d/%d %02d:%02d)"
4582 (tm.Unix.tm_year
+ 1900)
4585 | Some
title -> title
4587 state
.bookmarks
<- (title, 0, Oanchor
(getanchor1
l)) :: state
.bookmarks
4590 let setautoscrollspeed step goingdown
=
4591 let incr = max
1 ((abs step
) / 2) in
4592 let incr = if goingdown
then incr else -incr in
4593 let astep = boundastep state
.winh
(step
+ incr) in
4594 state
.autoscroll
<- Some
astep;
4598 match conf
.columns
with
4600 | Csingle
_ | Cmulti
_ -> state
.x != 0 || conf
.zoom > 1.0
4603 let panbound x = bound
x (-state
.w) (wadjsb () + state
.winw
);;
4605 let existsinrow pageno (columns
, coverA
, coverB
) p =
4606 let last = ((pageno - coverA
) mod columns
) + columns
in
4607 let rec any = function
4610 if l.pageno = coverA
- 1 || l.pageno = state
.pagecount
- coverB
4614 then (if l.pageno = last then false else any rest
)
4622 match state
.layout with
4624 let pageno = page_of_y state
.y in
4625 gotoghyll (getpagey
(pageno+1))
4627 match conf
.columns
with
4629 if conf
.presentation
&& rest
== [] && l.pageh
> l.pagey + l.pagevh
4631 let y = clamp (pgscale state
.winh
) in
4634 let pageno = min
(l.pageno+1) (state
.pagecount
-1) in
4635 gotoghyll (getpagey
pageno)
4636 | Cmulti
((c, _, _) as cl
, _) ->
4637 if conf
.presentation
4638 && (existsinrow l.pageno cl
4639 (fun l -> l.pageh
> l.pagey + l.pagevh))
4641 let y = clamp (pgscale state
.winh
) in
4644 let pageno = min
(l.pageno+c) (state
.pagecount
-1) in
4645 gotoghyll (getpagey
pageno)
4647 if l.pageno < state
.pagecount
- 1 || l.pagecol
< n - 1
4649 let pagey, pageh
= getpageyh
l.pageno in
4650 let pagey = pagey + pageh
* l.pagecol
in
4651 let ips = if l.pagecol
= 0 then 0 else conf
.interpagespace
in
4652 gotoghyll (pagey + pageh
+ ips)
4656 match state
.layout with
4658 let pageno = page_of_y state
.y in
4659 gotoghyll (getpagey
(pageno-1))
4661 match conf
.columns
with
4663 if conf
.presentation
&& l.pagey != 0
4665 gotoghyll (clamp (pgscale ~
-(state
.winh
)))
4667 let pageno = max
0 (l.pageno-1) in
4668 gotoghyll (getpagey
pageno)
4669 | Cmulti
((c, _, coverB
) as cl
, _) ->
4670 if conf
.presentation
&&
4671 (existsinrow l.pageno cl
(fun l -> l.pagey != 0))
4673 gotoghyll (clamp (pgscale ~
-(state
.winh
)))
4676 if l.pageno = state
.pagecount
- coverB
4680 let pageno = max
0 (l.pageno-decr) in
4681 gotoghyll (getpagey
pageno)
4689 let pageno = max
0 (l.pageno-1) in
4690 let pagey, pageh
= getpageyh
pageno in
4693 let pagey, pageh
= getpageyh
l.pageno in
4694 pagey + pageh
* (l.pagecol
-1) - conf
.interpagespace
4700 if emptystr conf
.savecmd
4701 then error
"don't know where to save modified document"
4703 let savecmd = Str.global_replace percentsre state
.path conf
.savecmd in
4706 (fun s -> error
"failed to obtain path to the saved copy: %s" s)
4711 let tmp = path ^
".tmp" in
4713 Unix.rename
tmp path;
4716 let viewkeyboard key mask
=
4718 let mode = state
.mode in
4719 state
.mode <- Textentry
(te, fun _ -> state
.mode <- mode);
4722 G.postRedisplay "view:enttext"
4724 let ctrl = Wsi.withctrl mask
in
4725 let key = Wsi.keypadtodigitkey
key in
4730 if hasunsavedchanges
()
4734 if conf
.angle
mod 360 = 0 && not
(isbirdseye state
.mode)
4736 state
.mode <- LinkNav
(Ltgendir
0);
4737 gotoxy state
.x state
.y;
4739 else impmsg "keyboard link navigation does not work under rotation"
4742 begin match state
.mstate
with
4745 G.postRedisplay "kill rect";
4748 | Mscrolly
| Mscrollx
4751 begin match state
.mode with
4754 G.postRedisplay "esc leave linknav"
4758 match state
.ranchors
with
4760 | (path, password, anchor, origin
) :: rest
->
4761 state
.ranchors
<- rest
;
4762 state
.anchor <- anchor;
4763 state
.origin
<- origin
;
4764 state
.nameddest
<- E.s;
4765 opendoc path password
4770 gotoghyll (getnav ~
-1)
4781 Hashtbl.iter
(fun _ opaque ->
4783 Hashtbl.clear state
.prects
) state
.pagemap
;
4784 G.postRedisplay "dehighlight";
4786 | @slash
| @question
->
4787 let ondone isforw
s =
4788 cbput state
.hists
.pat
s;
4789 state
.searchpattern
<- s;
4792 let s = String.make
1 (Char.chr
key) in
4793 enttext (s, E.s, Some
(onhist state
.hists
.pat
),
4794 textentry, ondone (key = @slash
), true)
4796 | @plus
| @kpplus
| @equals
when ctrl ->
4797 let incr = if conf
.zoom +. 0.01 > 0.1 then 0.1 else 0.01 in
4798 setzoom (conf
.zoom +. incr)
4800 | @plus
| @kpplus
->
4803 try int_of_string
s with exn
->
4804 state
.text <- Printf.sprintf
"bad integer `%s': %s" s @@ exntos exn
;
4810 state
.text <- "page bias is now " ^ string_of_int
n;
4813 enttext ("page bias: ", E.s, None
, intentry, ondone, true)
4815 | @minus
| @kpminus
when ctrl ->
4816 let decr = if conf
.zoom -. 0.1 < 0.1 then 0.01 else 0.1 in
4817 setzoom (max
0.01 (conf
.zoom -. decr))
4819 | @minus
| @kpminus
->
4820 let ondone msg
= state
.text <- msg
in
4822 "option [acfhilpstvxACFPRSZTISM]: ", E.s, None
,
4823 optentry state
.mode, ondone, true
4828 then gotoxy 0 state
.y
4831 | (@1 | @2) when ctrl && conf
.fitmodel
!= FitPage
-> (* ctrl-1/2 *)
4833 match conf
.columns
with
4834 | Csingle
_ | Cmulti
_ -> 1
4835 | Csplit
(n, _) -> n
4837 let h = state
.winh
-
4838 conf
.interpagespace
lsl (if conf
.presentation
then 1 else 0)
4840 let zoom = zoomforh state
.winw
h (vscrollw ()) cols in
4841 if zoom > 0.0 && (key = @2 || zoom < 1.0)
4846 match conf
.fitmodel
with
4847 | FitWidth
-> FitProportional
4848 | FitProportional
-> FitPage
4849 | FitPage
-> FitWidth
4851 state
.text <- "fit model: " ^
FMTE.to_string
fm;
4852 reqlayout conf
.angle
fm
4854 | @4 when ctrl -> (* ctrl-4 *)
4855 let zoom = getmaxw
() /. float state
.winw
in
4856 if zoom > 0.0 then setzoom zoom
4864 | (48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57)
4865 when not
ctrl -> (* 0..9 *)
4868 try int_of_string
s with exn
->
4869 state
.text <- Printf.sprintf
"bad integer `%s': %s" s @@ exntos exn
;
4875 cbput state
.hists
.pag
(string_of_int
n);
4876 gotopage1 (n + conf
.pagebias
- 1) 0;
4879 let pageentry text key =
4880 match Char.unsafe_chr
key with
4881 | '
g'
-> TEdone
text
4882 | _ -> intentry text key
4884 let text = String.make
1 (Char.chr
key) in
4885 enttext (":", text, Some
(onhist state
.hists
.pag
),
4886 pageentry, ondone, true)
4889 conf
.scrollb
<- if conf
.scrollb
= 0 then (scrollbvv
lor scrollbhv
) else 0;
4890 reshape state
.winw state
.winh
;
4893 state
.bzoom
<- not state
.bzoom
;
4895 showtext ' '
("block zoom " ^
if state
.bzoom
then "on" else "off")
4898 conf
.hlinks
<- not conf
.hlinks
;
4899 state
.text <- "highlightlinks " ^
if conf
.hlinks
then "on" else "off";
4900 G.postRedisplay "toggle highlightlinks";
4903 if conf
.angle
mod 360 = 0
4905 state
.glinks
<- true;
4906 let mode = state
.mode in
4909 (":", E.s, None
, linknentry, linknact gotounder, false),
4911 state
.glinks
<- false;
4915 G.postRedisplay "view:linkent(F)"
4917 else impmsg "hint mode does not work under rotation"
4920 state
.glinks
<- true;
4921 let mode = state
.mode in
4922 state
.mode <- Textentry
(
4924 ":", E.s, None
, linknentry, linknact (fun under ->
4925 selstring (undertext under);
4929 state
.glinks
<- false;
4933 G.postRedisplay "view:linkent"
4936 begin match state
.autoscroll
with
4938 conf
.autoscrollstep
<- step
;
4939 state
.autoscroll
<- None
4941 if conf
.autoscrollstep
= 0
4942 then state
.autoscroll
<- Some
1
4943 else state
.autoscroll
<- Some conf
.autoscrollstep
4947 launchpath () (* XXX where do error messages go? *)
4950 setpresentationmode (not conf
.presentation
);
4951 showtext ' '
("presentation mode " ^
4952 if conf
.presentation
then "on" else "off");
4955 if List.mem
Wsi.Fullscreen state
.winstate
4956 then Wsi.reshape conf
.cwinw conf
.cwinh
4957 else Wsi.fullscreen
()
4960 search state
.searchpattern
false
4963 search state
.searchpattern
true
4966 begin match state
.layout with
4969 gotoghyll (getpagey
l.pageno)
4975 | @delete
| @kpdelete
-> (* delete *)
4979 showtext ' '
(describe_location ());
4982 begin match state
.layout with
4985 Wsi.reshape (l.pagew
+ vscrollw ()) l.pageh
;
4990 enterbookmarkmode
()
4998 | @e when Buffer.length state
.errmsgs
> 0 ->
5003 match state
.layout with
5008 (s, 0, Oanchor
(getanchor1
l)) :: state
.bookmarks
5011 enttext ("bookmark: ", E.s, None
, textentry, ondone, true)
5015 showtext ' '
"Quick bookmark added";
5018 begin match state
.layout with
5020 let rect = getpdimrect
l.pagedimno
in
5024 (truncate
(1.8 *. (rect.(1) -. rect.(0))),
5025 truncate
(1.2 *. (rect.(3) -. rect.(0))))
5027 (truncate
(rect.(1) -. rect.(0)),
5028 truncate
(rect.(3) -. rect.(0)))
5030 let w = truncate
((float w)*.conf
.zoom)
5031 and h = truncate
((float h)*.conf
.zoom) in
5034 state
.anchor <- getanchor
();
5035 Wsi.reshape (w + vscrollw ()) (h + conf
.interpagespace
)
5037 G.postRedisplay "z";
5042 | @x -> state
.roam
()
5045 reqlayout (conf
.angle
+
5046 (if key = @Gt
then 30 else -30)) conf
.fitmodel
5050 bound
(conf
.colorscale
+. (if key = 93 then 0.1 else -0.1)) 0.0 1.0
5052 G.postRedisplay "brightness";
5054 | @c when state
.mode = View
->
5059 let m = (wadjsb () + state
.winw
- state
.w) / 2 in
5060 gotoxy_and_clear_text m state
.y
5064 match state
.prevcolumns
with
5065 | None
-> (1, 0, 0), 1.0
5066 | Some
(columns
, z
) ->
5069 | Csplit
(c, _) -> -c, 0, 0
5070 | Cmulti
((c, a, b), _) -> c, a, b
5071 | Csingle
_ -> 1, 0, 0
5075 setcolumns View
c a b;
5078 | @down
| @up
when ctrl && Wsi.withshift mask
->
5079 let zoom, x = state
.prevzoom
in
5083 | @k
| @up
| @kpup
->
5084 begin match state
.autoscroll
with
5086 begin match state
.mode with
5087 | Birdseye beye
-> upbirdseye 1 beye
5092 then gotoxy_and_clear_text state
.x (clamp ~
-(state
.winh
/2))
5094 if not
(Wsi.withshift mask
) && conf
.presentation
5096 else gotoghyll1 true (clamp (-conf
.scrollstep
))
5100 setautoscrollspeed n false
5103 | @j
| @down
| @kpdown
->
5104 begin match state
.autoscroll
with
5106 begin match state
.mode with
5107 | Birdseye beye
-> downbirdseye 1 beye
5112 then gotoxy_and_clear_text state
.x (clamp (state
.winh
/2))
5114 if not
(Wsi.withshift mask
) && conf
.presentation
5116 else gotoghyll1 true (clamp (conf
.scrollstep
))
5120 setautoscrollspeed n true
5123 | @left | @right
| @kpleft
| @kpright
when not
(Wsi.withalt mask
) ->
5129 else conf
.hscrollstep
5131 let dx = if key = @left || key = @kpleft
then dx else -dx in
5132 gotoxy_and_clear_text (panbound (state
.x + dx)) state
.y
5135 G.postRedisplay "left/right"
5138 | @prior
| @kpprior
->
5142 match state
.layout with
5144 | l :: _ -> state
.y - l.pagey
5146 clamp (pgscale (-state
.winh
))
5150 | @next | @kpnext
->
5154 match List.rev state
.layout with
5156 | l :: _ -> getpagey
l.pageno
5158 clamp (pgscale state
.winh
)
5162 | @g | @home
| @kphome
->
5165 | @G
| @jend
| @kpend
->
5167 gotoghyll (clamp state
.maxy)
5169 | @right
| @kpright
when Wsi.withalt mask
->
5170 gotoghyll (getnav 1)
5171 | @left | @kpleft
when Wsi.withalt mask
->
5172 gotoghyll (getnav ~
-1)
5177 | @v when conf
.debug
->
5180 match getopaque l.pageno with
5183 let x0, y0, x1, y1 = pagebbox
opaque in
5184 let rect = (float x0, float y0,
5187 float x0, float y1) in
5189 let color = (0.0, 0.0, 1.0 /. (l.pageno mod 3 |> float), 0.5) in
5190 state
.rects
<- (l.pageno, color, rect) :: state
.rects
;
5192 G.postRedisplay "v";
5195 let mode = state
.mode in
5196 let cmd = ref E.s in
5197 let onleave = function
5198 | Cancel
-> state
.mode <- mode
5201 match getopaque l.pageno with
5202 | Some
opaque -> pipesel opaque !cmd
5203 | None
-> ()) state
.layout;
5207 cbput state
.hists
.sel
s;
5211 "| ", !cmd, Some
(onhist state
.hists
.sel
), textentry, ondone, true
5213 G.postRedisplay "|";
5214 state
.mode <- Textentry
(te, onleave);
5217 vlog "huh? %s" (Wsi.keyname
key)
5220 let linknavkeyboard key mask
linknav =
5221 let getpage pageno =
5222 let rec loop = function
5224 | l :: _ when l.pageno = pageno -> Some
l
5225 | _ :: rest
-> loop rest
5226 in loop state
.layout
5228 let doexact (pageno, n) =
5229 match getopaque pageno, getpage pageno with
5230 | Some
opaque, Some
l ->
5231 if key = @enter || key = @kpenter
5233 let under = getlink
opaque n in
5234 G.postRedisplay "link gotounder";
5241 Some
(findlink
opaque LDfirst
), -1
5244 Some
(findlink
opaque LDlast
), 1
5247 Some
(findlink
opaque (LDleft
n)), -1
5250 Some
(findlink
opaque (LDright
n)), 1
5253 Some
(findlink
opaque (LDup
n)), -1
5256 Some
(findlink
opaque (LDdown
n)), 1
5261 begin match findpwl
l.pageno dir with
5265 state
.mode <- LinkNav
(Ltgendir
dir);
5266 let y, h = getpageyh
pageno in
5269 then y + h - state
.winh
5274 begin match getopaque pageno, getpage pageno with
5275 | Some
opaque, Some
_ ->
5277 let ld = if dir > 0 then LDfirst
else LDlast
in
5280 begin match link with
5282 showlinktype (getlink
opaque m);
5283 state
.mode <- LinkNav
(Ltexact
(pageno, m));
5284 G.postRedisplay "linknav jpage";
5285 | Lnotfound
-> notfound dir
5291 begin match opt with
5292 | Some Lnotfound
-> pwl l dir;
5293 | Some
(Lfound
m) ->
5297 let _, y0, _, y1 = getlinkrect
opaque m in
5299 then gotopage1 l.pageno y0
5301 let d = fstate
.fontsize
+ 1 in
5302 if y1 - l.pagey > l.pagevh - d
5303 then gotopage1 l.pageno (y1 - state
.winh
- hscrollh () + d)
5304 else G.postRedisplay "linknav";
5306 showlinktype (getlink
opaque m);
5307 state
.mode <- LinkNav
(Ltexact
(l.pageno, m));
5310 | None
-> viewkeyboard key mask
5312 | _ -> viewkeyboard key mask
5317 G.postRedisplay "leave linknav"
5321 | Ltgendir
_ | Ltnotready
_ -> viewkeyboard key mask
5322 | Ltexact exact
-> doexact exact
5325 let keyboard key mask
=
5326 if (key = @g && Wsi.withctrl mask
) && not
(istextentry state
.mode)
5327 then wcmd "interrupt"
5328 else state
.uioh <- state
.uioh#
key key mask
5331 let birdseyekeyboard key mask
5332 ((oconf
, leftx
, pageno, hooverpageno
, anchor) as beye
) =
5334 match conf
.columns
with
5336 | Cmulti
((c, _, _), _) -> c
5337 | Csplit
_ -> failwith
"bird's eye split mode"
5339 let pgh layout = List.fold_left
5340 (fun m l -> max
l.pageh
m) state
.winh
layout in
5342 | @l when Wsi.withctrl mask
->
5343 let y, h = getpageyh
pageno in
5344 let top = (state
.winh
- h) / 2 in
5345 gotoxy state
.x (max
0 (y - top))
5346 | @enter | @kpenter
-> leavebirdseye beye
false
5347 | @escape
-> leavebirdseye beye
true
5348 | @up
-> upbirdseye incr beye
5349 | @down
-> downbirdseye incr beye
5350 | @left -> upbirdseye 1 beye
5351 | @right
-> downbirdseye 1 beye
5354 begin match state
.layout with
5358 state
.mode <- Birdseye
(
5359 oconf
, leftx
, l.pageno, hooverpageno
, anchor
5361 gotopage1 l.pageno 0;
5364 let layout = layout state
.x (state
.y-state
.winh
)
5366 (pgh state
.layout) in
5368 | [] -> gotoxy state
.x (clamp (-state
.winh
))
5370 state
.mode <- Birdseye
(
5371 oconf
, leftx
, l.pageno, hooverpageno
, anchor
5373 gotopage1 l.pageno 0
5376 | [] -> gotoxy state
.x (clamp (-state
.winh
))
5380 begin match List.rev state
.layout with
5382 let layout = layout state
.x
5383 (state
.y + (pgh state
.layout))
5384 state
.winw state
.winh
in
5385 begin match layout with
5387 let incr = l.pageh
- l.pagevh in
5392 oconf
, leftx
, state
.pagecount
- 1, hooverpageno
, anchor
5394 G.postRedisplay "birdseye pagedown";
5396 else gotoxy state
.x (clamp (incr + conf
.interpagespace
*2));
5400 Birdseye
(oconf
, leftx
, l.pageno, hooverpageno
, anchor);
5401 gotopage1 l.pageno 0;
5404 | [] -> gotoxy state
.x (clamp state
.winh
)
5408 state
.mode <- Birdseye
(oconf
, leftx
, 0, hooverpageno
, anchor);
5412 let pageno = state
.pagecount
- 1 in
5413 state
.mode <- Birdseye
(oconf
, leftx
, pageno, hooverpageno
, anchor);
5414 if not
(pagevisible state
.layout pageno)
5417 match List.rev state
.pdims
with
5419 | (_, _, h, _) :: _ -> h
5423 (max
0 (getpagey
pageno - (state
.winh
- h - conf
.interpagespace
)))
5424 else G.postRedisplay "birdseye end";
5426 | _ -> viewkeyboard key mask
5431 match state
.mode with
5432 | Textentry
_ -> scalecolor 0.4
5434 | View
-> scalecolor 1.0
5435 | Birdseye
(_, _, pageno, hooverpageno
, _) ->
5436 if l.pageno = hooverpageno
5439 if l.pageno = pageno
5441 let c = scalecolor 1.0 in
5443 GlDraw.line_width
3.0;
5444 let dispx = xadjsb () + l.pagedispx in
5446 (float (dispx-1)) (float (l.pagedispy-1))
5447 (float (dispx+l.pagevw+1))
5448 (float (l.pagedispy+l.pagevh+1))
5450 GlDraw.line_width
1.0;
5459 let postdrawpage l linkindexbase
=
5460 match getopaque l.pageno with
5462 if tileready l l.pagex
l.pagey
5464 let x = l.pagedispx - l.pagex
+ xadjsb ()
5465 and y = l.pagedispy - l.pagey in
5467 match conf
.columns
with
5468 | Csingle
_ | Cmulti
_ ->
5469 (if conf
.hlinks
then 1 else 0)
5471 && not
(isbirdseye state
.mode) then 2 else 0)
5475 match state
.mode with
5476 | Textentry
((_, s, _, _, _, _), _) when state
.glinks
-> s
5482 Hashtbl.find_all state
.prects
l.pageno |>
5483 List.iter
(fun vals
-> drawprect
opaque x y vals
);
5484 let n = postprocess
opaque hlmask x y (linkindexbase
, s, conf
.hfsize
) in
5486 then (state
.redisplay
<- true; 0)
5492 let scrollindicator () =
5493 let sbw, ph
, sh = state
.uioh#
scrollph in
5494 let sbh, pw, sw = state
.uioh#scrollpw
in
5499 else ((state
.winw
- sbw), state
.winw
, 0)
5502 GlDraw.color (0.64, 0.64, 0.64);
5503 filledrect (float x0) 0. (float x1) (float state
.winh
);
5505 (float hx0
) (float (state
.winh
- sbh))
5506 (float (hx0
+ wadjsb () + state
.winw
)) (float state
.winh
)
5508 GlDraw.color (0.0, 0.0, 0.0);
5510 filledrect (float x0) ph
(float x1) (ph
+. sh);
5511 let pw = pw +. float hx0
in
5512 filledrect pw (float (state
.winh
- sbh)) (pw +. sw) (float state
.winh
);
5516 match state
.mstate
with
5517 | Mnone
| Mscrolly
| Mscrollx
| Mpan
_ | Mzoom
_ | Mzoomrect
_ ->
5520 | Msel
((x0, y0), (x1, y1)) ->
5521 let identify opaque l px py = Some
(opaque, l.pageno, px, py) in
5522 let o0,n0
,px0
,py0
= onppundermouse identify x0 y0 (~
< E.s, -1, 0, 0) in
5523 let _o1,n1
,px1
,py1
= onppundermouse identify x1 y1 (~
< E.s, -1, 0, 0) in
5524 if n0
!= -1 && n0
= n1
then seltext
o0 (px0
, py0
, px1
, py1
);
5527 let showrects = function [] -> () | rects
->
5529 GlDraw.color (0.0, 0.0, 1.0) ~
alpha:0.5;
5530 GlFunc.blend_func ~
src:`src_alpha ~dst
:`one_minus_src_alpha
;
5532 (fun (pageno, c, (x0, y0, x1, y1, x2
, y2
, x3
, y3
)) ->
5534 if l.pageno = pageno
5536 let dx = float (l.pagedispx - l.pagex
) in
5537 let dy = float (l.pagedispy - l.pagey) in
5538 let r, g, b, alpha = c in
5539 GlDraw.color (r, g, b) ~
alpha;
5540 filledrect2 (x0+.dx) (y0+.dy)
5552 begin match conf
.columns
, state
.layout with
5553 | Csingle
_, _ :: _ ->
5554 GlDraw.color (scalecolor2 conf
.bgcolor
);
5556 List.fold_left
(fun y l ->
5559 let x1 = l.pagedispx + xadjsb () in
5560 let y1 = (l.pagedispy + l.pagevh) in
5561 filledrect (float x0) (float y0) (float x1) (float y1);
5562 let x0 = x1 + l.pagevw in
5563 let x1 = state
.winw
in
5564 filledrect1 (float x0) (float y0) (float x1) (float y1);
5568 and x1 = state
.winw
in
5570 and y1 = l.pagedispy in
5571 filledrect1 (float x0) (float y0) (float x1) (float y1);
5573 l.pagedispy + l.pagevh) 0 state
.layout
5576 and x1 = state
.winw
in
5578 and y1 = state
.winh
in
5579 filledrect1 (float x0) (float y0) (float x1) (float y1)
5580 | (Cmulti
_ | Csplit
_), _ | Csingle
_, [] ->
5581 GlClear.color (scalecolor2 conf
.bgcolor
);
5582 GlClear.clear
[`
color];
5584 List.iter
drawpage state
.layout;
5586 match state
.mode with
5587 | LinkNav
(Ltexact
(pageno, linkno
)) ->
5588 begin match getopaque pageno with
5590 let dx = xadjsb () in
5591 let x0, y0, x1, y1 = getlinkrect
opaque linkno
in
5592 let x0 = x0 + dx and x1 = x1 + dx in
5593 let color = (0.0, 0.0, 0.5, 0.5) in
5600 | None
-> state
.rects
5602 | LinkNav
(Ltgendir
_) | LinkNav
(Ltnotready
_)
5605 | View
-> state
.rects
5608 let rec postloop linkindexbase
= function
5610 let linkindexbase = linkindexbase + postdrawpage l linkindexbase in
5611 postloop linkindexbase rest
5615 postloop 0 state
.layout;
5617 begin match state
.mstate
with
5618 | Mzoomrect
((x0, y0), (x1, y1)) ->
5620 GlDraw.color (0.3, 0.3, 0.3) ~
alpha:0.5;
5621 GlFunc.blend_func ~
src:`src_alpha ~dst
:`one_minus_src_alpha
;
5622 filledrect (float x0) (float y0) (float x1) (float y1);
5626 | Mscrolly
| Mscrollx
5635 let zoomrect x y x1 y1 =
5638 and y0 = min
y y1 in
5639 let zoom = (float state
.w) /. float (x1 - x0) in
5642 let adjw = wadjsb () + state
.winw
in
5644 then (adjw - state
.w) / 2
5647 match conf
.fitmodel
with
5648 | FitWidth
| FitProportional
-> simple ()
5650 match conf
.columns
with
5652 onppundermouse (fun _ l _ _ -> Some
l.pagedispx) x0 y0 x0
5653 | Cmulti
_ | Csingle
_ -> simple ()
5655 gotoxy ((state
.x + margin) - x0) (state
.y + y0);
5656 state
.anchor <- getanchor
();
5661 let annot inline
x y =
5662 match unproject x y with
5663 | Some
(opaque, n, ux
, uy
) ->
5665 addannot
opaque ux uy
text;
5666 wcmd "freepage %s" (~
> opaque);
5667 Hashtbl.remove state
.pagemap
(n, state
.gen
);
5669 gotoxy state
.x state
.y
5673 let ondone s = add s in
5674 let mode = state
.mode in
5675 state
.mode <- Textentry
(
5676 ("annotation: ", E.s, None
, textentry, ondone, true),
5677 fun _ -> state
.mode <- mode);
5680 G.postRedisplay "annot"
5682 add @@ getusertext E.s
5687 let g opaque l px py =
5688 match rectofblock
opaque px py with
5690 let x0 = a.(0) -. 20. in
5691 let x1 = a.(1) +. 20. in
5692 let y0 = a.(2) -. 20. in
5693 let zoom = (float state
.w) /. (x1 -. x0) in
5694 let pagey = getpagey
l.pageno in
5695 let margin = (state
.w - l.pagew
)/2 in
5696 let nx = -truncate
x0 - margin in
5697 gotoxy_and_clear_text nx (pagey + truncate
y0);
5698 state
.anchor <- getanchor
();
5703 match conf
.columns
with
5705 impmsg "block zooming does not work properly in split columns mode"
5706 | Cmulti
_ | Csingle
_ -> onppundermouse g x y ()
5710 let winw = wadjsb () + state
.winw - 1 in
5711 let s = float x /. float winw in
5712 let destx = truncate
(float (state
.w + winw) *. s) in
5713 gotoxy_and_clear_text (winw - destx) state
.y;
5714 state
.mstate
<- Mscrollx
;
5718 let s = float y /. float state
.winh
in
5719 let desty = truncate
(float (state
.maxy - state
.winh
) *. s) in
5720 gotoxy_and_clear_text state
.x desty;
5721 state
.mstate
<- Mscrolly
;
5724 let viewmulticlick clicks
x y mask
=
5725 let g opaque l px py =
5733 if markunder
opaque px py mark
5737 match getopaque l.pageno with
5739 | Some
opaque -> pipesel opaque cmd
5741 state
.roam
<- (fun () -> dopipe conf
.paxcmd
);
5742 if not
(Wsi.withctrl mask
) then dopipe conf
.selcmd
;
5747 G.postRedisplay "viewmulticlick";
5748 onppundermouse g x y (fun () -> impmsg "nothing to select") ();
5752 match conf
.columns
with
5754 | Csingle
_ | Cmulti
_ -> conf
.angle
mod 360 = 0
5757 let viewmouse button down
x y mask
=
5759 | n when (n == 4 || n == 5) && not down
->
5760 if Wsi.withctrl mask
5762 match state
.mstate
with
5763 | Mzoom
(oldn
, i
) ->
5771 if conf
.zoom +. 0.01 > 0.1 then 0.1 else 0.01
5773 if conf
.zoom -. 0.1 < 0.1 then -0.01 else -0.1
5775 let zoom = conf
.zoom -. incr in
5777 state
.mstate
<- Mzoom
(n, 0);
5779 state
.mstate
<- Mzoom
(n, i
+1);
5781 else state
.mstate
<- Mzoom
(n, 0)
5785 | Mscrolly
| Mscrollx
5787 | Mnone
-> state
.mstate
<- Mzoom
(n, 0)
5790 match state
.autoscroll
with
5791 | Some step
-> setautoscrollspeed step
(n=4)
5793 if conf
.wheelbypage
|| conf
.presentation
5802 then -conf
.scrollstep
5803 else conf
.scrollstep
5805 let incr = incr * 2 in
5806 let y = clamp incr in
5807 gotoxy_and_clear_text state
.x y
5810 | n when (n = 6 || n = 7) && not down
&& canpan () ->
5812 panbound (state
.x + (if n = 7 then -2 else 2) * conf
.hscrollstep
) in
5813 gotoxy_and_clear_text x state
.y
5815 | 1 when Wsi.withshift mask
->
5816 state
.mstate
<- Mnone
;
5819 match unproject x y with
5821 | Some
(_, pageno, ux
, uy
) ->
5822 let cmd = Printf.sprintf
5824 conf
.stcmd state
.path pageno ux uy
5826 match spawn
cmd [] with
5827 | (exception exn
) ->
5828 impmsg "execution of synctex command(%S) failed: %S"
5829 conf
.stcmd
@@ exntos exn
5833 | 1 when Wsi.withctrl mask
->
5836 Wsi.setcursor
Wsi.CURSOR_FLEUR
;
5837 state
.mstate
<- Mpan
(x, y)
5840 state
.mstate
<- Mnone
5845 if Wsi.withshift mask
5847 annot conf
.annotinline
x y;
5848 G.postRedisplay "addannot"
5852 Wsi.setcursor
Wsi.CURSOR_CYCLE
;
5853 state
.mstate
<- Mzoomrect
(p, p)
5856 match state
.mstate
with
5857 | Mzoomrect
((x0, y0), _) ->
5858 if abs
(x-x0) > 10 && abs
(y - y0) > 10
5859 then zoomrect x0 y0 x y
5862 G.postRedisplay "kill accidental zoom rect";
5866 | Mscrolly
| Mscrollx
5872 | 1 when vscrollhit x ->
5875 let _, position, sh = state
.uioh#
scrollph in
5876 if y > truncate
position && y < truncate
(position +. sh)
5877 then state
.mstate
<- Mscrolly
5880 state
.mstate
<- Mnone
5882 | 1 when y > state
.winh
- hscrollh () ->
5885 let _, position, sw = state
.uioh#scrollpw
in
5886 if x > truncate
position && x < truncate
(position +. sw)
5887 then state
.mstate
<- Mscrollx
5890 state
.mstate
<- Mnone
5892 | 1 when state
.bzoom
-> if not down
then zoomblock x y
5895 let dest = if down
then getunder x y else Unone
in
5896 begin match dest with
5899 | Uremote
_ | Uremotedest
_
5900 | Uunexpected
_ | Ulaunch
_ | Unamed
_ ->
5903 | Unone
when down
->
5904 Wsi.setcursor
Wsi.CURSOR_FLEUR
;
5905 state
.mstate
<- Mpan
(x, y);
5907 | Uannotation
(opaque, slinkindex
) -> enterannotmode opaque slinkindex
5909 | Unone
| Utext
_ ->
5914 state
.mstate
<- Msel
((x, y), (x, y));
5915 G.postRedisplay "mouse select";
5919 match state
.mstate
with
5922 | Mzoom
_ | Mscrollx
| Mscrolly
->
5923 state
.mstate
<- Mnone
5925 | Mzoomrect
((x0, y0), _) ->
5929 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
5930 state
.mstate
<- Mnone
5932 | Msel
((x0, y0), (x1, y1)) ->
5933 let rec loop = function
5937 let a0 = l.pagedispy in
5938 let a1 = a0 + l.pagevh in
5939 let b0 = l.pagedispx in
5940 let b1 = b0 + l.pagevw in
5941 ((y0 >= a0 && y0 <= a1) || (y1 >= a0 && y1 <= a1))
5942 && ((x0 >= b0 && x0 <= b1) || (x1 >= b0 && x1 <= b1))
5946 match getopaque l.pageno with
5949 match Unix.pipe
() with
5950 | (exception exn
) ->
5951 impmsg "cannot create sel pipe: %s" @@
5955 Ne.clo fd
(fun msg
->
5956 dolog
"%s close failed: %s" what msg
)
5959 try spawn
cmd [r, 0; w, -1]
5961 dolog
"cannot execute %S: %s"
5968 G.postRedisplay "copysel";
5970 else clo "Msel pipe/w" w;
5971 clo "Msel pipe/r" r;
5973 dosel conf
.selcmd
();
5974 state
.roam
<- dosel conf
.paxcmd
;
5986 let birdseyemouse button down
x y mask
5987 (conf
, leftx
, _, hooverpageno
, anchor) =
5990 let rec loop = function
5993 if y > l.pagedispy && y < l.pagedispy + l.pagevh
5994 && x > l.pagedispx && x < l.pagedispx + l.pagevw
5996 leavebirdseye (conf
, leftx
, l.pageno, hooverpageno
, anchor) false;
6002 | _ -> viewmouse button down
x y mask
6008 method key key mask
=
6009 begin match state
.mode with
6010 | Textentry
textentry -> textentrykeyboard key mask
textentry
6011 | Birdseye
birdseye -> birdseyekeyboard key mask
birdseye
6012 | View
-> viewkeyboard key mask
6013 | LinkNav
linknav -> linknavkeyboard key mask
linknav
6017 method button button bstate
x y mask
=
6018 begin match state
.mode with
6020 | View
-> viewmouse button bstate
x y mask
6021 | Birdseye beye
-> birdseyemouse button bstate
x y mask beye
6026 method multiclick clicks
x y mask
=
6027 begin match state
.mode with
6029 | View
-> viewmulticlick clicks
x y mask
6036 begin match state
.mode with
6038 | View
| Birdseye
_ | LinkNav
_ ->
6039 match state
.mstate
with
6040 | Mzoom
_ | Mnone
-> ()
6045 state
.mstate
<- Mpan
(x, y);
6046 let x = if canpan () then panbound (state
.x + dx) else state
.x in
6048 gotoxy_and_clear_text x y
6051 state
.mstate
<- Msel
(a, (x, y));
6052 G.postRedisplay "motion select";
6055 let y = min state
.winh
(max
0 y) in
6059 let x = min state
.winw (max
0 x) in
6062 | Mzoomrect
(p0
, _) ->
6063 state
.mstate
<- Mzoomrect
(p0
, (x, y));
6064 G.postRedisplay "motion zoomrect";
6068 method pmotion
x y =
6069 begin match state
.mode with
6070 | Birdseye
(conf
, leftx
, pageno, hooverpageno
, anchor) ->
6071 let rec loop = function
6073 if hooverpageno
!= -1
6075 state
.mode <- Birdseye
(conf
, leftx
, pageno, -1, anchor);
6076 G.postRedisplay "pmotion birdseye no hoover";
6079 if y > l.pagedispy && y < l.pagedispy + l.pagevh
6080 && x > l.pagedispx && x < l.pagedispx + l.pagevw
6082 state
.mode <- Birdseye
(conf
, leftx
, pageno, l.pageno, anchor);
6083 G.postRedisplay "pmotion birdseye hoover";
6093 match state
.mstate
with
6094 | Mpan
_ | Msel
_ | Mzoom
_ | Mscrolly
| Mscrollx
| Mzoomrect
_ -> ()
6102 let past, _, _ = !r in
6104 let delta = now -. past in
6107 else r := (now, x, y)
6111 method infochanged
_ = ()
6114 let maxy = state
.maxy - (if conf
.maxhfit
then state
.winh
else 0) in
6117 then 0.0, float state
.winh
6118 else scrollph state
.y maxy
6123 let winw = wadjsb () + state
.winw in
6124 let fwinw = float winw in
6126 let sw = fwinw /. float state
.w in
6127 let sw = fwinw *. sw in
6128 max
sw (float conf
.scrollh
)
6131 let maxx = state
.w + winw in
6132 let x = winw - state
.x in
6133 let percent = float x /. float maxx in
6134 (fwinw -. sw) *. percent
6136 hscrollh (), position, sw
6140 match state
.mode with
6141 | LinkNav
_ -> "links"
6142 | Textentry
_ -> "textentry"
6143 | Birdseye
_ -> "birdseye"
6146 findkeyhash conf
modename
6148 method eformsgs
= true
6149 method alwaysscrolly
= false
6152 let addrect pageno r g b a x0 y0 x1 y1 =
6153 Hashtbl.add state
.prects
pageno [|r; g; b; a; x0; y0; x1; y1|];
6157 let cl = splitatspace cmds
in
6159 try Scanf.sscanf
s fmt
f
6161 adderrfmt "remote exec"
6162 "error processing '%S': %s\n" cmds
@@ exntos exn
6164 let rectx s pageno (r, g, b, a) x0 y0 x1 y1 =
6165 vlog "%s page %d color (%f %f %f %f) x0,y0,x1,y1 = %f %f %f %f"
6166 s pageno r g b a x0 y0 x1 y1;
6170 let _,w1,h1
,_ = getpagedim
pageno in
6171 let sw = float w1 /. float w
6172 and sh = float h1
/. float h in
6176 and y1s
= y1 *. sh in
6177 let rect = (x0s,y0s
,x1s
,y0s
,x1s
,y1s
,x0s,y1s
) in
6178 let color = (r, g, b, a) in
6179 if conf
.verbose
then debugrect rect;
6180 state
.rects <- (pageno, color, rect) :: state
.rects;
6185 | "reload", "" -> reload ()
6187 scan args
"%u %f %f"
6189 let cmd, _ = state
.geomcmds
in
6191 then gotopagexy !wtmode pageno x y
6194 gotopagexy !wtmode pageno x y;
6197 state
.reprf
<- f state
.reprf
6199 | "goto1", args
-> scan args
"%u %f" gotopage
6202 (fun filename
pageno -> gotounder (Uremote
(filename
, pageno)))
6205 (fun filename
dest -> gotounder (Uremotedest
(filename
, dest)))
6207 scan args
"%u %u %f %f %f %f"
6208 (fun pageno c x0 y0 x1 y1 ->
6209 let color = (0.0, 0.0, 1.0 /. float c, 0.5) in
6210 rectx "rect" pageno color x0 y0 x1 y1;
6213 scan args
"%u %f %f %f %f %f %f %f %f"
6214 (fun pageno r g b alpha x0 y0 x1 y1 ->
6215 addrect pageno r g b alpha x0 y0 x1 y1;
6216 G.postRedisplay "prect"
6219 scan args
"%u %f %f"
6222 match getopaque pageno with
6223 | Some
opaque -> opaque
6226 pgoto optopaque pageno x y;
6227 let rec fixx = function
6230 if l.pageno = pageno
6231 then gotoxy (state
.x - l.pagedispx) state
.y
6236 match conf
.columns
with
6237 | Csingle
_ | Csplit
_ -> 1
6238 | Cmulti
((n, _, _), _) -> n
6240 layout 0 state
.y (state
.winw * mult) state
.winh
6244 | "activatewin", "" -> Wsi.activatewin
()
6245 | "quit", "" -> raise Quit
6248 let l = Config.keys_of_string
keys in
6249 List.iter
(fun (k
, m) -> keyboard k
m) l
6251 adderrfmt "error processing keys" "`%S': %s\n" cmds
@@ exntos exn
6253 | "clearrects", "" ->
6254 Hashtbl.clear state
.prects
;
6255 G.postRedisplay "clearrects"
6257 adderrfmt "remote command"
6258 "error processing remote command: %S\n" cmds
;
6262 let scratch = Bytes.create
80 in
6263 let buf = Buffer.create
80 in
6265 match tempfailureretry
(Unix.read fd
scratch 0) 80 with
6266 | (exception Unix.Unix_error
(Unix.EAGAIN
, _, _)) -> None
6269 if Buffer.length
buf > 0
6271 let s = Buffer.contents
buf in
6279 match Bytes.index_from
scratch ppos '
\n'
with
6280 | pos -> if pos >= n then -1 else pos
6281 | (exception Not_found
) -> -1
6285 Buffer.add_subbytes
buf scratch ppos
(nlpos-ppos
);
6286 let s = Buffer.contents
buf in
6292 Buffer.add_subbytes
buf scratch ppos
(n-ppos
);
6298 let remoteopen path =
6299 try Some
(Unix.openfile
path [Unix.O_NONBLOCK
; Unix.O_RDONLY
] 0o0)
6301 adderrfmt "remoteopen" "error opening %S: %s" path @@ exntos exn
;
6306 let gcconfig = ref E.s in
6307 let trimcachepath = ref E.s in
6308 let rcmdpath = ref E.s in
6309 let pageno = ref None
in
6310 let rootwid = ref 0 in
6311 let openlast = ref false in
6312 let nofc = ref false in
6313 let doreap = ref false in
6314 selfexec := Sys.executable_name
;
6317 [("-p", Arg.String
(fun s -> state
.password <- s),
6318 "<password> Set password");
6322 Config.fontpath
:= s;
6323 selfexec := !selfexec ^
" -f " ^
Filename.quote
s;
6325 "<path> Set path to the user interface font");
6329 selfexec := !selfexec ^
" -c " ^
Filename.quote
s;
6330 Config.confpath
:= s),
6331 "<path> Set path to the configuration file");
6333 ("-last", Arg.Set
openlast, " Open last document");
6335 ("-page", Arg.Int
(fun pageno1
-> pageno := Some
(pageno1
-1)),
6336 "<page-number> Jump to page");
6338 ("-tcf", Arg.String
(fun s -> trimcachepath := s),
6339 "<path> Set path to the trim cache file");
6341 ("-dest", Arg.String
(fun s -> state
.nameddest
<- s),
6342 "<named-destination> Set named destination");
6344 ("-wtmode", Arg.Set
wtmode, " Operate in wt mode");
6345 ("-cxack", Arg.Set
cxack, " Cut corners");
6347 ("-remote", Arg.String
(fun s -> rcmdpath := s),
6348 "<path> Set path to the remote commands source");
6350 ("-origin", Arg.String
(fun s -> state
.origin
<- s),
6351 "<original-path> Set original path");
6353 ("-gc", Arg.Set_string
gcconfig,
6354 "<script-path> Collect garbage with the help of a script");
6356 ("-nofc", Arg.Set
nofc, " Do not use fontconfig");
6358 ("-v", Arg.Unit
(fun () ->
6360 "%s\nconfiguration path: %s\n"
6364 exit
0), " Print version and exit");
6366 ("-embed", Arg.Set_int
rootwid,
6367 "<window-id> Embed into window")
6370 (fun s -> state
.path <- s)
6371 ("Usage: " ^
Sys.argv
.(0) ^
" [options] some.pdf\nOptions:")
6374 then selfexec := !selfexec ^
" -wtmode";
6376 let histmode = emptystr state
.path && not
!openlast in
6378 if not
(Config.load !openlast)
6379 then dolog
"failed to load configuration";
6381 begin match !pageno with
6382 | Some
pageno -> state
.anchor <- (pageno, 0.0, 0.0)
6386 if nonemptystr
!gcconfig
6389 match Unix.socketpair
Unix.PF_UNIX
Unix.SOCK_STREAM
0 with
6390 | (exception exn
) -> error
"socketpair for gc failed: %s" @@ exntos exn
6393 match spawn
!gcconfig [(c, 0); (c, 1); (s, -1)] with
6394 | (exception exn
) -> error
"failed to execute gc script: %s" @@ exntos exn
6396 Ne.clo c @@ (fun s -> error
"failed to close gc fd %s" s);
6401 let wsfd, winw, winh
= Wsi.init
(object (self)
6402 val mutable m_clicks
= 0
6403 val mutable m_click_x
= 0
6404 val mutable m_click_y
= 0
6405 val mutable m_lastclicktime
= infinity
6407 method private cleanup =
6408 state
.roam
<- noroam
;
6409 Hashtbl.iter
(fun _ opaque -> clearmark
opaque) state
.pagemap
6410 method expose
= G.postRedisplay "expose"
6414 | Wsi.Unobscured
-> "unobscured"
6415 | Wsi.PartiallyObscured
-> "partiallyobscured"
6416 | Wsi.FullyObscured
-> "fullyobscured"
6418 vlog "visibility change %s" name
6419 method display = display ()
6420 method map mapped
= vlog "mapped %b" mapped
6421 method reshape w h =
6424 method mouse
b d x y m =
6425 if d && canselect ()
6427 (* http://blogs.msdn.com/b/oldnewthing/archive/2004/10/18/243925.aspx *)
6433 if abs
x - m_click_x
> 10
6434 || abs
y - m_click_y
> 10
6435 || abs_float
(t -. m_lastclicktime
) > 0.3
6437 m_clicks
<- m_clicks
+ 1;
6438 m_lastclicktime
<- t;
6442 G.postRedisplay "cleanup";
6443 state
.uioh <- state
.uioh#button
b d x y m;
6445 else state
.uioh <- state
.uioh#multiclick m_clicks
x y m
6450 m_lastclicktime
<- infinity
;
6451 state
.uioh <- state
.uioh#button
b d x y m
6455 state
.uioh <- state
.uioh#button
b d x y m
6458 state
.mpos
<- (x, y);
6459 state
.uioh <- state
.uioh#motion
x y
6460 method pmotion
x y =
6461 state
.mpos
<- (x, y);
6462 state
.uioh <- state
.uioh#pmotion
x y
6464 let mascm = m land (
6465 Wsi.altmask
+ Wsi.shiftmask
+ Wsi.ctrlmask
+ Wsi.metamask
6468 let x = state
.x and y = state
.y in
6470 if x != state
.x || y != state
.y then self#
cleanup
6472 match state
.keystate
with
6474 let km = k
, mascm in
6477 let modehash = state
.uioh#
modehash in
6478 try Hashtbl.find modehash km
6480 try Hashtbl.find (findkeyhash conf
"global") km
6481 with Not_found
-> KMinsrt
(k
, m)
6483 | KMinsrt
(k
, m) -> keyboard k
m
6484 | KMinsrl
l -> List.iter
(fun (k
, m) -> keyboard k
m) l
6485 | KMmulti
(l, r) -> state
.keystate
<- KSinto
(l, r)
6487 | KSinto
((k'
, m'
) :: [], insrt
) when k'
=k
&& m'
land mascm = m'
->
6488 List.iter
(fun (k
, m) -> keyboard k
m) insrt
;
6489 state
.keystate
<- KSnone
6490 | KSinto
((k'
, m'
) :: keys, insrt
) when k'
=k
&& m'
land mascm = m'
->
6491 state
.keystate
<- KSinto
(keys, insrt
)
6492 | KSinto
_ -> state
.keystate
<- KSnone
6495 state
.mpos
<- (x, y);
6496 state
.uioh <- state
.uioh#pmotion
x y
6497 method leave = state
.mpos
<- (-1, -1)
6498 method winstate wsl
= state
.winstate
<- wsl
6499 method quit
= raise Quit
6500 end) !rootwid conf
.cwinw conf
.cwinh platform
in
6502 setbgcol conf
.bgcolor
;
6506 List.exists
GlMisc.check_extension
6507 [ "GL_ARB_texture_rectangle"
6508 ; "GL_EXT_texture_recangle"
6509 ; "GL_NV_texture_rectangle" ]
6511 then (dolog
"OpenGL does not suppport rectangular textures"; exit
1);
6514 let r = GlMisc.get_string `renderer
in
6515 let p = "Mesa DRI Intel(" in
6516 let l = String.length
p in
6517 String.length
r > l && String.sub
r 0 l = p
6520 defconf
.sliceheight
<- 1024;
6521 defconf
.texcount
<- 32;
6522 defconf
.usepbo
<- true;
6526 match Unix.socketpair
Unix.PF_UNIX
Unix.SOCK_STREAM
0 with
6527 | (exception exn
) ->
6528 dolog
"socketpair failed: %s" @@ exntos exn
;
6536 setcheckers conf
.checkers
;
6538 opengl_has_pbo := GlMisc.check_extension
"GL_ARB_pixel_buffer_object";
6541 conf
.angle
, conf
.fitmodel
, (conf
.trimmargins
, conf
.trimfuzz
),
6542 conf
.texcount
, conf
.sliceheight
, conf
.mustoresize
, conf
.colorspace
,
6543 !Config.fontpath
, !trimcachepath,
6547 List.iter
GlArray.enable
[`texture_coord
; `vertex
];
6549 reshape ~firsttime
:true winw winh
;
6553 Wsi.settitle
"llpp (history)";
6557 state
.text <- "Opening " ^
(mbtoutf8 state
.path);
6558 opendoc state
.path state
.password;
6562 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
6563 Sys.set_signal
Sys.sighup
(Sys.Signal_handle
(fun _ -> reload ()));
6566 match Unix.waitpid
[Unix.WNOHANG
] ~
-1 with
6567 | (exception (Unix.Unix_error
(Unix.ECHILD
, _, _))) -> ()
6568 | (exception exn
) -> dolog
"Unix.waitpid: %s" @@ exntos exn
6570 | _pid
, _status
-> reap ()
6572 Sys.set_signal
Sys.sigchld
(Sys.Signal_handle
(fun _ -> doreap := true));
6576 if nonemptystr
!rcmdpath
6577 then remoteopen !rcmdpath
6582 let rec loop deadline
=
6588 let r = [state
.ss; state
.wsfd] in
6592 | Some fd
-> fd
:: r
6596 state
.redisplay
<- false;
6603 if deadline
= infinity
6605 else max
0.0 (deadline
-. now)
6610 try Unix.select
r [] [] timeout
6611 with Unix.Unix_error
(Unix.EINTR
, _, _) -> [], [], []
6617 if state
.ghyll
== noghyll
6619 match state
.autoscroll
with
6620 | Some step
when step
!= 0 ->
6621 let y = state
.y + step
in
6622 let fy = if conf
.maxhfit
then state
.winh
else 0 in
6625 then state
.maxy - fy
6626 else if y >= state
.maxy - fy then 0 else y
6628 if state
.mode = View
6629 then gotoxy_and_clear_text state
.x y
6630 else gotoxy state
.x y;
6633 else deadline
+. 0.01
6638 let rec checkfds = function
6640 | fd
:: rest
when fd
= state
.ss ->
6641 let cmd = rcmd state
.ss in
6645 | fd
:: rest
when fd
= state
.wsfd ->
6649 | fd
:: rest
when Some fd
= !optrfd ->
6650 begin match remote fd
with
6651 | None
-> optrfd := remoteopen !rcmdpath;
6652 | opt -> optrfd := opt
6657 dolog
"select returned unknown descriptor";
6663 if deadline
= infinity
6667 match state
.autoscroll
with
6668 | Some step
when step
!= 0 -> deadline1
6669 | _ -> if state
.ghyll
== noghyll
then infinity
else deadline1
6677 Config.save leavebirdseye;
6678 if hasunsavedchanges
()