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-hscrollh ())*.conf
.zoom
) in
1142 let d = conf
.interpagespace
lsl (if conf
.presentation
then 1 else 0) in
1146 let opendoc path password
=
1148 state
.password
<- password
;
1149 state
.gen
<- state
.gen
+ 1;
1150 state
.docinfo
<- [];
1151 state
.outlines
<- [||];
1154 setaalevel conf
.aalevel
;
1156 if emptystr state
.origin
1160 Wsi.settitle
("llpp " ^
(mbtoutf8
(Filename.basename
titlepath)));
1161 wcmd "open %d %d %s\000%s\000" (btod
!wtmode) (btod
!cxack) path password
;
1162 invalidate "reqlayout"
1164 wcmd "reqlayout %d %d %d %s\000"
1165 conf
.angle
(FMTE.to_int conf
.fitmodel
)
1166 (stateh state
.winh
) state
.nameddest
1171 state
.anchor <- getanchor
();
1172 opendoc state
.path state
.password
;
1176 let c = c *. conf
.colorscale
in
1180 let scalecolor2 (r
, g, b) =
1181 (r
*. conf
.colorscale
, g *. conf
.colorscale
, b *. conf
.colorscale
);
1184 let docolumns columns
=
1185 let wadj = wadjsb () in
1188 let a = Array.make state
.pagecount
(-1, -1, -1, (-1, -1, -1, -1)) in
1189 let wadj = wadjsb () in
1190 let rec loop pageno
pdimno pdim
y ph pdims
=
1191 if pageno
= state
.pagecount
1194 let pdimno, ((_
, w, h, xoff
) as pdim
), pdims
=
1196 | ((pageno'
, _
, _
, _
) as pdim
) :: rest
when pageno'
= pageno
->
1197 pdimno+1, pdim
, rest
1201 let x = max
0 (((wadj + state
.winw
- w) / 2) - xoff
) in
1203 (if conf
.presentation
1204 then (if pageno
= 0 then calcips
h else calcips ph
+ calcips
h)
1205 else (if pageno
= 0 then 0 else conf
.interpagespace
)
1208 a.(pageno
) <- (pdimno, x, y, pdim
);
1209 loop (pageno
+1) pdimno pdim
(y + h) h pdims
1211 loop 0 ~
-1 (-1,-1,-1,-1) 0 0 state
.pdims
;
1212 conf
.columns
<- Csingle
a;
1214 | Cmulti
((columns
, coverA
, coverB
), _
) ->
1215 let a = Array.make state
.pagecount
(-1, -1, -1, (-1, -1, -1, -1)) in
1216 let rec loop pageno
pdimno pdim
x y rowh pdims
=
1217 let rec fixrow m
= if m
= pageno
then () else
1218 let (pdimno, x, y, ((_
, _
, h, _
) as pdim
)) = a.(m
) in
1221 let y = y + (rowh
- h) / 2 in
1222 a.(m
) <- (pdimno, x, y, pdim
);
1226 if pageno
= state
.pagecount
1227 then fixrow (((pageno
- 1) / columns
) * columns
)
1229 let pdimno, ((_
, w, h, xoff
) as pdim
), pdims
=
1231 | ((pageno'
, _
, _
, _
) as pdim
) :: rest
when pageno'
= pageno
->
1232 pdimno+1, pdim
, rest
1237 if pageno
= coverA
- 1 || pageno
= state
.pagecount
- coverB
1239 let x = (wadj + state
.winw
- w) / 2 in
1241 if conf
.presentation
then calcips
h else conf
.interpagespace
in
1242 x, y + ips + rowh
, h
1245 if (pageno
- coverA
) mod columns
= 0
1247 let x = max
0 (wadj + state
.winw
- state
.w) / 2 in
1249 if conf
.presentation
1251 let ips = calcips
h in
1252 y + (if pageno
= 0 then 0 else calcips rowh
+ ips)
1254 y + (if pageno
= 0 then 0 else conf
.interpagespace
)
1258 else x, y, max rowh
h
1262 if pageno
> 1 && (pageno
- coverA
) mod columns
= 0
1265 if pageno
= columns
&& conf
.presentation
1267 let ips = calcips rowh
in
1268 for i
= 0 to pred columns
1270 let (pdimno, x, y, pdim
) = a.(i
) in
1271 a.(i
) <- (pdimno, x, y+ips, pdim
)
1277 fixrow (pageno
- columns
);
1282 a.(pageno
) <- (pdimno, x, y, pdim
);
1283 let x = x + w + xoff
*2 + conf
.interpagespace
in
1284 loop (pageno
+1) pdimno pdim
x y rowh' pdims
1286 loop 0 ~
-1 (-1,-1,-1,-1) 0 0 0 state
.pdims
;
1287 conf
.columns
<- Cmulti
((columns
, coverA
, coverB
), a);
1290 let a = Array.make
(state
.pagecount
*c) (-1, -1, -1, (-1, -1, -1, -1)) in
1291 let rec loop pageno
pdimno pdim
y pdims
=
1292 if pageno
= state
.pagecount
1295 let pdimno, ((_
, w, h, _
) as pdim
), pdims
=
1297 | ((pageno'
, _
, _
, _
) as pdim
) :: rest
when pageno'
= pageno
->
1298 pdimno+1, pdim
, rest
1303 let rec loop1 n x y =
1304 if n = c then y else (
1305 a.(pageno
*c + n) <- (pdimno, x, y, pdim
);
1306 loop1 (n+1) (x+cw) (y + h + conf
.interpagespace
)
1309 let y = loop1 0 0 y in
1310 loop (pageno
+1) pdimno pdim
y pdims
1312 loop 0 ~
-1 (-1,-1,-1,-1) 0 state
.pdims
;
1313 conf
.columns
<- Csplit
(c, a);
1317 docolumns conf
.columns
;
1318 state
.maxy
<- calcheight
();
1319 if state
.reprf
== noreprf
1321 match state
.mode
with
1322 | Birdseye
(_
, _
, pageno
, _
, _
) ->
1323 let y, h = getpageyh pageno
in
1324 let top = (state
.winh
- h) / 2 in
1325 gotoxy state
.x (max
0 (y - top))
1329 let y = getanchory state
.anchor in
1330 let y = min
y (state
.maxy
- (state
.winh
- hscrollh ())) in
1335 state
.reprf
<- noreprf
;
1339 let reshape ?
(firsttime
=false) w h =
1340 GlDraw.viewport ~
x:0 ~
y:0 ~
w:w ~
h:h;
1341 if not firsttime
&& nogeomcmds state
.geomcmds
1342 then state
.anchor <- getanchor
();
1345 let w = truncate
(float (w - vscrollw ()) *. conf
.zoom
) in
1348 setfontsize fstate
.fontsize
;
1349 GlMat.mode `modelview
;
1350 GlMat.load_identity
();
1352 GlMat.mode `projection
;
1353 GlMat.load_identity
();
1354 GlMat.rotate ~
x:1.0 ~angle
:180.0 ();
1355 GlMat.translate ~
x:~
-.1.0 ~
y:~
-.1.0 ();
1356 GlMat.scale3
(2.0 /. float state
.winw
, 2.0 /. float state
.winh
, 1.0);
1361 else float state
.x /. float state
.w
1363 invalidate "geometry"
1367 then state
.x <- truncate
(relx *. float w);
1369 match conf
.columns
with
1371 | Cmulti
((c, _
, _
), _
) -> (w - (c-1)*conf
.interpagespace
) / c
1372 | Csplit
(c, _
) -> w * c
1374 wcmd "geometry %d %d %d"
1375 w (stateh h) (FMTE.to_int conf
.fitmodel
)
1380 let len = String.length state
.text in
1381 let x0 = xadjsb () in
1384 match state
.mode
with
1385 | Textentry _
| View
| LinkNav _
->
1386 let h, _
, _
= state
.uioh#scrollpw
in
1391 filledrect x (float (state
.winh
- (fstate
.fontsize
+ 4) - hscrollh))
1392 (x+.w) (float (state
.winh
- hscrollh))
1395 let w = float (wadjsb () + state
.winw
- 1) in
1396 if state
.progress
>= 0.0 && state
.progress
< 1.0
1398 GlDraw.color (0.3, 0.3, 0.3);
1399 let w1 = w *. state
.progress
in
1401 GlDraw.color (0.0, 0.0, 0.0);
1402 rect (float x0+.w1) (float x0+.w-.w1)
1405 GlDraw.color (0.0, 0.0, 0.0);
1409 GlDraw.color (1.0, 1.0, 1.0);
1410 drawstring fstate
.fontsize
1411 (if conf
.leftscroll
then x0 + 2 else x0 + if len > 0 then 8 else 2)
1412 (state
.winh
- hscrollh - 5) s;
1415 match state
.mode
with
1416 | Textentry
((prefix
, text, _
, _
, _
, _
), _
) ->
1420 Printf.sprintf
"%s%s_ [%s]" prefix
text state
.text
1422 Printf.sprintf
"%s%s_" prefix
text
1428 | LinkNav _
-> state
.text
1433 if not
(istextentry state
.mode
) && state
.uioh#eformsgs
1435 let s1 = "(press 'e' to review error messasges)" in
1436 if nonemptystr
s then s ^
" " ^
s1 else s1
1446 let len = Queue.length state
.tilelru
in
1448 match state
.throttle
with
1451 then preloadlayout state
.x state
.y state
.winw state
.winh
1453 | Some
(layout, _
, _
) ->
1457 if state
.memused
<= conf
.memlimit
1462 let (k
, p
, s) as lruitem
= Queue.pop state
.tilelru
in
1463 let n, gen
, colorspace
, angle
, pagew
, pageh
, col, row = k
in
1464 let (_
, pw, ph
, _
) = getpagedim
n in
1467 && colorspace
= conf
.colorspace
1468 && angle
= conf
.angle
1472 let x = col*conf
.tilew
1473 and y = row*conf
.tileh
in
1474 tilevisible (Lazy.force_val
layout) n x y
1476 then Queue.push lruitem state
.tilelru
1479 wcmd "freetile %s" (~
> p
);
1480 state
.memused
<- state
.memused
- s;
1481 state
.uioh#infochanged Memused
;
1482 Hashtbl.remove state
.tilemap k
;
1490 let onpagerect pageno
f =
1492 match conf
.columns
with
1493 | Cmulti
(_
, b) -> b
1495 | Csplit
(_
, b) -> b
1497 if pageno
>= 0 && pageno
< Array.length
b
1499 let (_
, _
, _
, (_
, w, h, _
)) = b.(pageno
) in
1503 let gotopagexy1 wtmode pageno
x y =
1504 let _,w1,h1
,leftx
= getpagedim pageno
in
1505 let top = y /. (float h1
) in
1506 let left = x /. (float w1) in
1507 let py, w, h = getpageywh pageno
in
1508 let wh = state
.winh
- hscrollh () in
1509 let x = left *. (float w) in
1510 let x = leftx
+ state
.x + truncate
x in
1511 let wadj = wadjsb () in
1513 if x < 0 || x >= wadj + state
.winw
1517 let pdy = truncate
(top *. float h) in
1518 let y'
= py + pdy in
1519 let dy = y'
- state
.y in
1521 if x != state
.x || not
(dy > 0 && dy < wh)
1523 if conf
.presentation
1525 if abs
(py - y'
) > wh
1532 if state
.x != sx || state
.y != sy
1537 let ww = wadj + state
.winw
in
1539 and qy
= pdy / wh in
1541 and y = py + qy
* wh in
1542 let x = if -x + ww > w1 then -(w1-ww) else x
1543 and y'
= if y + wh > state
.maxy
then state
.maxy
- wh else y in
1545 if conf
.presentation
1547 if abs
(py - y'
) > wh
1556 gotoxy_and_clear_text x y;
1558 else gotoxy_and_clear_text state
.x state
.y;
1561 let gotopagexy wtmode pageno
x y =
1562 match state
.mode
with
1563 | Birdseye
_ -> gotopage pageno
0.0
1566 | LinkNav
_ -> gotopagexy1 wtmode pageno
x y
1569 let getpassword () =
1570 let passcmd = getenvwithdef
"LLPP_ASKPASS" conf
.passcmd in
1575 impmsg "error getting password: %s" s;
1576 dolog
"%s" s) passcmd;
1579 let pgoto opaque pageno
x y =
1580 let pdimno = getpdimno pageno
in
1581 let x, y = project opaque pageno
pdimno x y in
1582 gotopagexy false pageno
x y;
1586 (* dolog "%S" cmds; *)
1587 let spl = splitatspace cmds
in
1589 try Scanf.sscanf
s fmt
f
1591 dolog
"error processing '%S': %s" cmds
@@ exntos exn
;
1594 let addoutline outline
=
1595 match state
.currently
with
1596 | Outlining outlines
->
1597 state
.currently
<- Outlining
(outline
:: outlines
)
1598 | Idle
-> state
.currently
<- Outlining
[outline
]
1601 dolog
"invalid outlining state";
1602 logcurrently state
.currently
1606 state
.uioh#infochanged Pdim
;
1609 | "clearrects", "" ->
1610 state
.rects
<- state
.rects1
;
1611 G.postRedisplay "clearrects";
1613 | "continue", args
->
1614 let n = scan args
"%u" (fun n -> n) in
1615 state
.pagecount
<- n;
1616 begin match state
.currently
with
1618 state
.currently
<- Idle
;
1619 state
.outlines
<- Array.of_list
(List.rev
l)
1625 let cur, cmds
= state
.geomcmds
in
1627 then failwith
"umpossible";
1629 begin match List.rev cmds
with
1631 state
.geomcmds
<- E.s, [];
1632 state
.throttle
<- None
;
1636 state
.geomcmds
<- s, List.rev rest
;
1638 if conf
.maxwait
= None
&& not
!wtmode
1639 then G.postRedisplay "continue";
1646 then showtext ' ' args
1649 Buffer.add_string state
.errmsgs args
;
1650 state
.newerrmsgs
<- true;
1651 G.postRedisplay "error message"
1653 | "progress", args
->
1654 let progress, text =
1657 f, String.sub args pos
(String.length args
- pos
))
1660 state
.progress <- progress;
1661 G.postRedisplay "progress"
1663 | "firstmatch", args
->
1664 let pageno, c, x0, y0, x1, y1, x2
, y2
, x3
, y3
=
1665 scan args
"%u %d %f %f %f %f %f %f %f %f"
1666 (fun p
c x0 y0 x1 y1 x2 y2 x3 y3
->
1667 (p
, c, x0, y0, x1, y1, x2
, y2
, x3
, y3
))
1669 let xoff = float (xadjsb ()) in
1673 and x3
= x3
+. xoff in
1674 let y = (getpagey
pageno) + truncate
y0 in
1677 then truncate
(xoff -. x0) + state
.winw
/2
1682 let color = (0.0, 0.0, 1.0 /. float c, 0.5) in
1683 state
.rects1
<- [pageno, color, (x0, y0, x1, y1, x2
, y2
, x3
, y3
)]
1686 let pageno, c, x0, y0, x1, y1, x2
, y2
, x3
, y3
=
1687 scan args
"%u %d %f %f %f %f %f %f %f %f"
1688 (fun p
c x0 y0 x1 y1 x2 y2 x3 y3
->
1689 (p
, c, x0, y0, x1, y1, x2
, y2
, x3
, y3
))
1691 let xoff = float (xadjsb ()) in
1695 and x3
= x3
+. xoff in
1696 let color = (0.0, 0.0, 1.0 /. float c, 0.5) in
1698 (pageno, color, (x0, y0, x1, y1, x2
, y2
, x3
, y3
)) :: state
.rects1
1701 let pageopaques, t
= scan args
"%s %f" (fun p t
-> p
, t
) in
1702 let pageopaque = ~
< pageopaques in
1703 begin match state
.currently
with
1704 | Loading
(l, gen
) ->
1705 vlog "page %d took %f sec" l.pageno t
;
1706 Hashtbl.replace state
.pagemap
(l.pageno, gen
) pageopaque;
1707 begin match state
.throttle
with
1709 let preloadedpages =
1711 then preloadlayout state
.x state
.y state
.winw state
.winh
1716 List.fold_left
(fun s l -> IntSet.add
l.pageno s)
1717 IntSet.empty
preloadedpages
1720 Hashtbl.fold (fun ((pageno, _) as key) opaque
accu ->
1721 if not
(IntSet.mem
pageno set)
1723 wcmd "freepage %s" (~
> opaque
);
1729 List.iter
(Hashtbl.remove state
.pagemap
) evictedpages;
1732 state
.currently
<- Idle
;
1735 tilepage l.pageno pageopaque state
.layout;
1737 load preloadedpages;
1738 let visible = pagevisible state
.layout l.pageno in
1741 match state
.mode
with
1742 | LinkNav
(Ltnotready
(pageno, dir
)) ->
1743 if pageno = l.pageno
1748 then LDfirstvisible
(l.pagex
, l.pagey, dir
)
1750 if dir
> 0 then LDfirst
else LDlast
1753 findlink
pageopaque ld
1758 showlinktype (getlink
pageopaque n);
1759 state
.mode
<- LinkNav
(Ltexact
(l.pageno, n))
1761 | LinkNav
(Ltgendir
_)
1762 | LinkNav
(Ltexact
_)
1768 if visible && layoutready state
.layout
1770 G.postRedisplay "page";
1774 | Some
(layout, _, _) ->
1775 state
.currently
<- Idle
;
1776 tilepage l.pageno pageopaque layout;
1783 dolog
"Inconsistent loading state";
1784 logcurrently state
.currently
;
1789 let (x, y, opaques
, size
, t
) =
1790 scan args
"%u %u %s %u %f"
1791 (fun x y p size t
-> (x, y, p
, size
, t
))
1793 let opaque = ~
< opaques
in
1794 begin match state
.currently
with
1795 | Tiling
(l, pageopaque, cs
, angle
, gen
, col, row, tilew
, tileh
) ->
1796 vlog "tile %d [%d,%d] took %f sec" l.pageno col row t
;
1799 if tilew
!= conf
.tilew
|| tileh
!= conf
.tileh
1801 wcmd "freetile %s" (~
> opaque);
1802 state
.currently
<- Idle
;
1806 puttileopaque l col row gen cs angle
opaque size t
;
1807 state
.memused
<- state
.memused
+ size
;
1808 state
.uioh#infochanged Memused
;
1810 Queue.push
((l.pageno, gen
, cs
, angle
, l.pagew
, l.pageh
, col, row),
1811 opaque, size
) state
.tilelru
;
1814 match state
.throttle
with
1815 | None
-> state
.layout
1816 | Some
(layout, _, _) -> layout
1819 state
.currently
<- Idle
;
1821 && conf
.colorspace
= cs
1822 && conf
.angle
= angle
1823 && tilevisible layout l.pageno x y
1824 then conttiling l.pageno pageopaque;
1826 begin match state
.throttle
with
1828 preload state
.layout;
1830 && conf
.colorspace
= cs
1831 && conf
.angle
= angle
1832 && tilevisible state
.layout l.pageno x y
1833 && (not
!wtmode || layoutready state
.layout)
1834 then G.postRedisplay "tile nothrottle";
1836 | Some
(layout, y, _) ->
1837 let ready = layoutready layout in
1841 state
.layout <- layout;
1842 state
.throttle
<- None
;
1843 G.postRedisplay "throttle";
1852 dolog
"Inconsistent tiling state";
1853 logcurrently state
.currently
;
1858 let (n, w, h, _) as pdim
=
1859 scan args
"%u %u %u %u" (fun n w h x -> n, w, h, x)
1862 match conf
.fitmodel
with
1864 | FitPage
| FitProportional
->
1865 match conf
.columns
with
1866 | Csplit
_ -> (n, w, h, 0)
1867 | Csingle
_ | Cmulti
_ -> pdim
1869 state
.uioh#infochanged Pdim
;
1870 state
.pdims
<- pdim :: state
.pdims
1873 let (l, n, t
, h, pos
) =
1874 scan args
"%u %u %d %u %n"
1875 (fun l n t
h pos
-> l, n, t
, h, pos
)
1877 let s = String.sub args pos
(String.length args
- pos
) in
1878 addoutline (s, l, Oanchor
(n, float t
/. float h, 0.0))
1881 let (l, len, pos
) = scan args
"%u %u %n" (fun l len pos
-> l, len, pos
) in
1882 let s = String.sub args pos
len in
1883 let pos2 = pos
+ len + 1 in
1884 let uri = String.sub args
pos2 (String.length args
- pos2) in
1885 addoutline (s, l, Ouri
uri)
1888 let (l, pos
) = scan args
"%u %n" (fun l pos
-> l, pos
) in
1889 let s = String.sub args pos
(String.length args
- pos
) in
1890 addoutline (s, l, Onone
)
1894 scan args
"%u %d %d" (fun n l t
-> n, l, t
)
1896 state
.reprf
<- (fun () -> gotopagexy !wtmode n (float l) (float t
))
1899 let pos = nindex args '
\t'
in
1900 if pos >= 0 && String.sub args
0 pos = "Title"
1902 let s = String.sub args
(pos+1) @@ String.length args
- pos - 1 in
1906 state
.docinfo
<- (1, args
) :: state
.docinfo
1909 state
.uioh#infochanged Docinfo
;
1910 state
.docinfo
<- List.rev state
.docinfo
1914 then Wsi.settitle
"Wrong password";
1915 let password = getpassword () in
1916 if emptystr
password
1917 then error
"document is password protected"
1918 else opendoc state
.path
password
1921 error
"unknown cmd `%S'" cmds
1926 let action = function
1927 | HCprev
-> cbget cb ~
-1
1928 | HCnext
-> cbget cb
1
1929 | HCfirst
-> cbget cb ~
-(cb
.rc)
1930 | HClast
-> cbget cb
(cb
.len - 1 - cb
.rc)
1931 and cancel
() = cb
.rc <- rc
1935 let search pattern forward
=
1936 match conf
.columns
with
1937 | Csplit
_ -> impmsg "searching does not work properly in split columns mode"
1940 if nonemptystr pattern
1943 match state
.layout with
1946 l.pageno, (l.pagey + if forward
then 0 else 0*l.pagevh)
1948 wcmd "search %d %d %d %d,%s\000"
1949 (btod conf
.icase
) pn py (btod forward
) pattern
;
1952 let intentry text key =
1954 if key >= 32 && key < 127
1956 let c = Char.chr
key in
1958 | '
0'
.. '
9'
-> addchar
text c
1960 state
.text <- Printf.sprintf
"invalid char (%d, `%c')" key c;
1963 state
.text <- Printf.sprintf
"invalid key (%d)" key;
1974 let l = String.length
s in
1975 let rec loop pos n = if pos = l then n else
1976 let m = Char.code
s.[pos] - (if pos = 0 && l > 1 then 96 else 97) in
1977 loop (pos+1) (n*26 + m)
1980 let rec loop n = function
1983 match getopaque l.pageno with
1984 | None
-> loop n rest
1986 let m = getlinkcount
opaque in
1989 let under = getlink
opaque n in
1992 else loop (n-m) rest
1994 loop n state
.layout;
1998 let linknentry text key =
1999 if key >= 32 && key < 127
2001 let text = addchar
text (Char.chr
key) in
2002 linknact (fun under -> state
.text <- undertext ~nopath
:true under) text;
2005 state
.text <- Printf.sprintf
"invalid key %d" key;
2010 let textentry text key =
2011 if Wsi.isspecialkey
key
2013 else TEcont
(text ^ toutf8
key)
2016 let reqlayout angle fitmodel
=
2017 match state
.throttle
with
2019 if nogeomcmds state
.geomcmds
2020 then state
.anchor <- getanchor
();
2021 conf
.angle
<- angle
mod 360;
2024 match state
.mode
with
2025 | LinkNav
_ -> state
.mode
<- View
2030 conf
.fitmodel
<- fitmodel
;
2031 invalidate "reqlayout"
2033 wcmd "reqlayout %d %d %d"
2034 conf
.angle
(FMTE.to_int conf
.fitmodel
) (stateh state
.winh
)
2039 let settrim trimmargins trimfuzz
=
2040 if nogeomcmds state
.geomcmds
2041 then state
.anchor <- getanchor
();
2042 conf
.trimmargins
<- trimmargins
;
2043 conf
.trimfuzz
<- trimfuzz
;
2044 let x0, y0, x1, y1 = trimfuzz
in
2045 invalidate "settrim"
2047 wcmd "settrim %d %d %d %d %d" (btod conf
.trimmargins
) x0 y0 x1 y1);
2052 match state
.throttle
with
2054 let zoom = max
0.0001 zoom in
2055 if zoom <> conf
.zoom
2057 state
.prevzoom
<- (conf
.zoom, state
.x);
2059 reshape state
.winw state
.winh
;
2060 state
.text <- Printf.sprintf
"zoom is now %-5.2f" (zoom *. 100.0);
2063 | Some
(layout, y, started
) ->
2065 match conf
.maxwait
with
2069 let dt = now
() -. started
in
2077 let pivotzoom ?
(vw=state
.winw
- vscrollw ())
2078 ?
(vh
=min state
.maxy
(state
.winh
- hscrollh ()))
2079 ?
(x=vw/2) ?
(y=vh
/2) zoom =
2080 if nogeomcmds state
.geomcmds
2082 let w = float state
.w /. zoom in
2083 let hw = w /. 2.0 in
2084 let ratio = float vh
/. float vw in
2085 let hh = hw *. ratio in
2086 let x0 = float x -. hw in
2087 let y0 = float y -. hh in
2088 gotoxy (state
.x - truncate
x0) (state
.y + truncate
y0);
2092 let setcolumns mode columns coverA coverB
=
2093 state
.prevcolumns
<- Some
(conf
.columns
, conf
.zoom);
2097 then impmsg "split mode doesn't work in bird's eye"
2099 conf
.columns
<- Csplit
(-columns
, E.a);
2107 conf
.columns
<- Csingle
E.a;
2112 conf
.columns
<- Cmulti
((columns
, coverA
, coverB
), E.a);
2116 reshape state
.winw state
.winh
;
2119 let resetmstate () =
2120 state
.mstate
<- Mnone
;
2121 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
2124 let enterbirdseye () =
2125 let zoom = float conf
.thumbw
/. float state
.winw
in
2126 let birdseyepageno =
2127 let cy = state
.winh
/ 2 in
2131 let rec fold best
= function
2134 let d = cy - (l.pagedispy + l.pagevh/2)
2135 and dbest
= cy - (best
.pagedispy + best
.pagevh/2) in
2136 if abs
d < abs dbest
2143 state
.mode
<- Birdseye
(
2144 { conf
with zoom = conf
.zoom }, state
.x, birdseyepageno, -1, getanchor
()
2148 conf
.presentation
<- false;
2149 conf
.interpagespace
<- 10;
2150 conf
.hlinks
<- false;
2151 conf
.fitmodel
<- FitPage
;
2153 conf
.maxwait
<- None
;
2155 match conf
.beyecolumns
with
2158 Cmulti
((c, 0, 0), E.a)
2159 | None
-> Csingle
E.a
2163 state
.text <- Printf.sprintf
"birds eye mode on (zoom %3.1f%%)"
2168 reshape state
.winw state
.winh
;
2171 let leavebirdseye (c, leftx
, pageno, _, anchor) goback
=
2173 conf
.zoom <- c.zoom;
2174 conf
.presentation
<- c.presentation
;
2175 conf
.interpagespace
<- c.interpagespace
;
2176 conf
.maxwait
<- c.maxwait
;
2177 conf
.hlinks
<- c.hlinks
;
2178 conf
.fitmodel
<- c.fitmodel
;
2179 conf
.beyecolumns
<- (
2180 match conf
.columns
with
2181 | Cmulti
((c, _, _), _) -> Some
c
2183 | Csplit
_ -> failwith
"leaving bird's eye split mode"
2186 match c.columns
with
2187 | Cmulti
(c, _) -> Cmulti
(c, E.a)
2188 | Csingle
_ -> Csingle
E.a
2189 | Csplit
(c, _) -> Csplit
(c, E.a)
2193 state
.text <- Printf.sprintf
"birds eye mode off (zoom %3.1f%%)"
2196 reshape state
.winw state
.winh
;
2197 state
.anchor <- if goback
then anchor else (pageno, 0.0, 1.0);
2201 let togglebirdseye () =
2202 match state
.mode
with
2203 | Birdseye vals
-> leavebirdseye vals
true
2204 | View
-> enterbirdseye ()
2209 let upbirdseye incr
(conf
, leftx
, pageno, hooverpageno
, anchor) =
2210 let pageno = max
0 (pageno - incr
) in
2211 let rec loop = function
2212 | [] -> gotopage1 pageno 0
2213 | l :: _ when l.pageno = pageno ->
2214 if l.pagedispy >= 0 && l.pagey = 0
2215 then G.postRedisplay "upbirdseye"
2216 else gotopage1 pageno 0
2217 | _ :: rest
-> loop rest
2221 state
.mode
<- Birdseye
(conf
, leftx
, pageno, hooverpageno
, anchor)
2224 let downbirdseye incr
(conf
, leftx
, pageno, hooverpageno
, anchor) =
2225 let pageno = min
(state
.pagecount
- 1) (pageno + incr
) in
2226 state
.mode
<- Birdseye
(conf
, leftx
, pageno, hooverpageno
, anchor);
2227 let rec loop = function
2229 let y, h = getpageyh
pageno in
2230 let dy = (y - state
.y) - (state
.winh
- h - conf
.interpagespace
) in
2231 gotoxy state
.x (clamp dy)
2232 | l :: _ when l.pageno = pageno ->
2233 if l.pagevh != l.pageh
2234 then gotoxy state
.x (clamp (l.pageh
- l.pagevh + conf
.interpagespace
))
2235 else G.postRedisplay "downbirdseye"
2236 | _ :: rest
-> loop rest
2242 let optentry mode
_ key =
2243 let btos b = if b then "on" else "off" in
2244 if key >= 32 && key < 127
2246 let c = Char.chr
key in
2250 try conf
.scrollstep
<- int_of_string
s with exn
->
2251 state
.text <- Printf.sprintf
"bad integer `%s': %s" s @@ exntos exn
2253 TEswitch
("scroll step: ", E.s, None
, intentry, ondone, true)
2258 conf
.autoscrollstep
<- boundastep state
.winh
(int_of_string
s);
2259 if state
.autoscroll
<> None
2260 then state
.autoscroll
<- Some conf
.autoscrollstep
2262 state
.text <- Printf.sprintf
"bad integer `%s': %s" s @@ exntos exn
2264 TEswitch
("auto scroll step: ", E.s, None
, intentry, ondone, true)
2269 let n, a, b = multicolumns_of_string
s in
2270 setcolumns mode
n a b;
2272 state
.text <- Printf.sprintf
"bad columns `%s': %s" s @@ exntos exn
2274 TEswitch
("columns: ", E.s, None
, textentry, ondone, true)
2279 let zoom = float (int_of_string
s) /. 100.0 in
2282 state
.text <- Printf.sprintf
"bad integer `%s': %s" s @@ exntos exn
2284 TEswitch
("zoom: ", E.s, None
, intentry, ondone, true)
2289 conf
.thumbw
<- bound
(int_of_string
s) 2 4096;
2291 Printf.sprintf
"thumbnail width is set to %d" conf
.thumbw
;
2292 begin match mode
with
2294 leavebirdseye beye
false;
2301 state
.text <- Printf.sprintf
"bad integer `%s': %s" s @@ exntos exn
2303 TEswitch
("thumbnail width: ", E.s, None
, intentry, ondone, true)
2307 match int_of_string
s with
2308 | angle
-> reqlayout angle conf
.fitmodel
2311 Printf.sprintf
"bad integer `%s': %s" s @@ exntos exn
2313 TEswitch
("rotation: ", E.s, None
, intentry, ondone, true)
2316 conf
.icase
<- not conf
.icase
;
2317 TEdone
("case insensitive search " ^
(btos conf
.icase
))
2320 conf
.preload <- not conf
.preload;
2321 gotoxy state
.x state
.y;
2322 TEdone
("preload " ^
(btos conf
.preload))
2325 conf
.verbose
<- not conf
.verbose
;
2326 TEdone
("verbose " ^
(btos conf
.verbose
))
2329 conf
.debug
<- not conf
.debug
;
2330 TEdone
("debug " ^
(btos conf
.debug
))
2333 conf
.maxhfit
<- not conf
.maxhfit
;
2334 state
.maxy
<- calcheight
();
2335 TEdone
("maxhfit " ^
(btos conf
.maxhfit
))
2338 conf
.crophack
<- not conf
.crophack
;
2339 TEdone
("crophack " ^
btos conf
.crophack
)
2343 match conf
.maxwait
with
2345 conf
.maxwait
<- Some infinity
;
2346 "always wait for page to complete"
2348 conf
.maxwait
<- None
;
2349 "show placeholder if page is not ready"
2354 conf
.underinfo
<- not conf
.underinfo
;
2355 TEdone
("underinfo " ^
btos conf
.underinfo
)
2358 conf
.savebmarks
<- not conf
.savebmarks
;
2359 TEdone
("persistent bookmarks " ^
btos conf
.savebmarks
)
2365 match state
.layout with
2370 conf
.interpagespace
<- int_of_string
s;
2371 docolumns conf
.columns
;
2372 state
.maxy
<- calcheight
();
2373 let y = getpagey
pageno in
2374 gotoxy state
.x (y + py)
2376 state
.text <- Printf.sprintf
"bad integer `%s': %s" s @@ exntos exn
2378 TEswitch
("vertical margin: ", E.s, None
, intentry, ondone, true)
2382 match conf
.fitmodel
with
2383 | FitProportional
-> FitWidth
2384 | FitWidth
| FitPage
-> FitProportional
2386 reqlayout conf
.angle
fm;
2387 TEdone
("proportional display " ^
btos (fm == FitProportional
))
2390 settrim (not conf
.trimmargins
) conf
.trimfuzz
;
2391 TEdone
("trim margins " ^
btos conf
.trimmargins
)
2394 conf
.invert
<- not conf
.invert
;
2395 TEdone
("invert colors " ^
btos conf
.invert
)
2399 cbput state
.hists
.sel
s;
2402 TEswitch
("selection command: ", E.s, Some
(onhist state
.hists
.sel
),
2403 textentry, ondone, true)
2407 then conf
.pax
<- Some
(ref (0.0, 0, 0))
2408 else conf
.pax
<- None
;
2409 TEdone
("PAX " ^
btos (conf
.pax
!= None
))
2412 state
.text <- Printf.sprintf
"bad option %d `%c'" key c;
2418 class type lvsource
= object
2419 method getitemcount
: int
2420 method getitem
: int -> (string * int)
2421 method hasaction
: int -> bool
2429 method getactive
: int
2430 method getfirst
: int
2432 method getminfo
: (int * int) array
2435 class virtual lvsourcebase
= object
2436 val mutable m_active
= 0
2437 val mutable m_first
= 0
2438 val mutable m_pan
= 0
2439 method getactive
= m_active
2440 method getfirst
= m_first
2441 method getpan
= m_pan
2442 method getminfo
: (int * int) array
= E.a
2445 let textentrykeyboard
2446 key _mask
((c, text, opthist
, onkey
, ondone, cancelonempty
), onleave
) =
2448 let key = Wsi.keypadtodigitkey
key in
2450 state
.mode
<- Textentry
(te
, onleave
);
2452 G.postRedisplay "textentrykeyboard enttext";
2454 let histaction cmd
=
2457 | Some
(action, _) ->
2458 state
.mode
<- Textentry
(
2459 (c, action cmd
, opthist
, onkey
, ondone, cancelonempty
), onleave
2461 G.postRedisplay "textentry histaction"
2465 if emptystr
text && cancelonempty
2468 G.postRedisplay "textentrykeyboard after cancel";
2471 let s = withoutlastutf8
text in
2472 enttext (c, s, opthist
, onkey
, ondone, cancelonempty
)
2474 | @enter
| @kpenter
->
2477 G.postRedisplay "textentrykeyboard after confirm"
2479 | @up
| @kpup
-> histaction HCprev
2480 | @down
| @kpdown
-> histaction HCnext
2481 | @home
| @kphome
-> histaction HCfirst
2482 | @jend
| @kpend
-> histaction HClast
2487 begin match opthist
with
2489 | Some
(_, onhistcancel
) -> onhistcancel
()
2493 G.postRedisplay "textentrykeyboard after cancel2"
2496 enttext (c, E.s, opthist
, onkey
, ondone, cancelonempty
)
2499 | @delete
| @kpdelete
-> ()
2501 | _ when key != 0 && not
(Wsi.isspecialkey
key) ->
2502 begin match onkey
text key with
2506 G.postRedisplay "textentrykeyboard after confirm2";
2509 enttext (c, text, opthist
, onkey
, ondone, cancelonempty
);
2513 G.postRedisplay "textentrykeyboard after cancel3"
2516 state
.mode
<- Textentry
(te
, onleave
);
2517 G.postRedisplay "textentrykeyboard switch";
2521 vlog "unhandled key %s" (Wsi.keyname
key)
2524 let firstof first active
=
2525 if first
> active
|| abs
(first
- active
) > fstate
.maxrows
- 1
2526 then max
0 (active
- (fstate
.maxrows
/2))
2530 let calcfirst first active
=
2533 let rows = active
- first
in
2534 if rows > fstate
.maxrows
then active
- fstate
.maxrows
else first
2538 let scrollph y maxy
=
2539 let sh = float (maxy
+ state
.winh
) /. float state
.winh
in
2540 let sh = float state
.winh
/. sh in
2541 let sh = max
sh (float conf
.scrollh
) in
2543 let percent = float y /. float maxy
in
2544 let position = (float state
.winh
-. sh) *. percent in
2547 if position +. sh > float state
.winh
2548 then float state
.winh
-. sh
2554 let adderrmsg src msg
=
2555 Buffer.add_string state
.errmsgs msg
;
2556 state
.newerrmsgs
<- true;
2560 let adderrfmt src fmt
=
2561 Format.ksprintf
(fun s -> adderrmsg src
s) fmt
;
2564 let coe s = (s :> uioh
);;
2566 class listview ~zebra ~helpmode ~
(source
:lvsource
) ~trusted ~modehash
=
2568 val m_pan
= source#getpan
2569 val m_first
= source#getfirst
2570 val m_active
= source#getactive
2572 val m_prev_uioh
= state
.uioh
2574 method private elemunder
y =
2578 let n = y / (fstate
.fontsize
+1) in
2579 if m_first
+ n < source#getitemcount
2581 if source#hasaction
(m_first
+ n)
2582 then Some
(m_first
+ n)
2589 GlFunc.blend_func ~src
:`src_alpha ~dst
:`one_minus_src_alpha
;
2590 GlDraw.color (0., 0., 0.) ~alpha
:0.85;
2591 filledrect 0. 0. (float state
.winw
) (float state
.winh
);
2592 GlDraw.color (1., 1., 1.);
2593 Gl.enable `texture_2d
;
2594 let fs = fstate
.fontsize
in
2596 let hw = (wadjsb () + xadjsb () + state
.winw
)/3 in
2597 let ww = fstate
.wwidth
in
2598 let tabw = 17.0*.ww in
2599 let itemcount = source#getitemcount
in
2600 let minfo = source#getminfo
in
2604 then float (state
.winw
- 1)
2605 else float (state
.winw
- conf
.scrollbw
- 1)
2607 let xadj = xadjsb () in
2609 if (row - m_first
) > fstate
.maxrows
2612 if row >= 0 && row < itemcount
2614 let (s, level
) = source#getitem
row in
2615 let y = (row - m_first
) * nfs in
2617 (if conf
.leftscroll
then float xadj else 5.0)
2618 +. (float (level
+ m_pan
)) *. ww in
2621 (let c = if row land 1 = 0 then 1.0 else 0.92 in (c,c,c));
2625 Gl.disable `texture_2d
;
2626 let alpha = if source#hasaction
row then 0.9 else 0.3 in
2627 GlDraw.color (1., 1., 1.) ~
alpha;
2628 linerect (float xadj +. x0 +. 1.)
2629 (float (y + 1)) (x1) (float (y + fs + 3));
2630 Gl.enable `texture_2d
;
2633 if zebra
&& row land 1 = 1
2637 GlDraw.color (c,c,c);
2638 let drawtabularstring s =
2640 let x'
= truncate
(x0 +. x) in
2641 let pos = nindex
s '
\000'
in
2643 then drawstring1 fs x'
(y+nfs) s
2645 let s1 = String.sub
s 0 pos
2646 and s2
= String.sub
s (pos+1) (String.length
s - pos - 1) in
2651 let s'
= withoutlastutf8
s in
2652 let s = s' ^
"@Uellipsis" in
2653 let w = measurestr
fs s in
2654 if float x'
+. w +. ww < float (hw + x'
)
2659 if float x'
+. ww +. measurestr
fs s1 > float (hw + x'
)
2663 ignore
(drawstring1 fs x'
(y+nfs) s1);
2664 drawstring1 fs (hw + x'
) (y+nfs) s2
2668 let x = if helpmode
&& row > 0 then x +. ww else x in
2669 let tabpos = nindex
s '
\t'
in
2672 let len = String.length
s - tabpos - 1 in
2673 let s1 = String.sub
s 0 tabpos
2674 and s2
= String.sub
s (tabpos + 1) len in
2675 let nx = drawstr x s1 in
2677 let x = x +. (max
tabw sw) in
2680 let len = String.length
s - 2 in
2681 if len > 0 && s.[0] = '
\xc2'
&& s.[1] = '
\xb7'
2683 let s = String.sub
s 2 len in
2684 let x = if not helpmode
then x +. ww else x in
2685 GlDraw.color (1.2, 1.2, 1.2);
2686 let vinc = drawstring1 (fs+fs/4)
2687 (truncate
(x -. ww)) (y+nfs) s in
2688 GlDraw.color (1., 1., 1.);
2689 vinc +. (float fs *. 0.8)
2695 ignore
(drawtabularstring s);
2701 GlDraw.color (1.0, 1.0, 1.0) ~
alpha:0.5;
2702 let xadj = float (xadjsb () + 5) in
2704 if (row - m_first
) > fstate
.maxrows
2707 if row >= 0 && row < itemcount
2709 let (s, level
) = source#getitem
row in
2710 let pos0 = nindex
s '
\000'
in
2711 let y = (row - m_first
) * nfs in
2712 let x = float (level
+ m_pan
) *. ww in
2713 let (first
, last
) = minfo.(row) in
2715 if pos0 > 0 && first
> pos0
2716 then String.sub
s (pos0+1) (first
-pos0-1)
2717 else String.sub
s 0 first
2719 let suffix = String.sub
s first
(last
- first
) in
2720 let w1 = measurestr fstate
.fontsize
prefix in
2721 let w2 = measurestr fstate
.fontsize
suffix in
2722 let x = x +. if conf
.leftscroll
then xadj else 5.0 in
2723 let x = if pos0 > 0 && first
> pos0 then x +. float hw else x in
2725 and y0 = float (y+2) in
2727 and y1 = float (y+fs+3) in
2728 filledrect x0 y0 x1 y1;
2733 Gl.disable `texture_2d
;
2734 if Array.length
minfo > 0 then loop m_first
;
2737 method updownlevel incr
=
2738 let len = source#getitemcount
in
2740 if m_active
>= 0 && m_active
< len
2741 then snd
(source#getitem m_active
)
2745 if i
= len then i
-1 else if i
= -1 then 0 else
2746 let _, l = source#getitem i
in
2747 if l != curlevel then i
else flow (i
+incr
)
2749 let active = flow m_active
in
2750 let first = calcfirst m_first
active in
2751 G.postRedisplay "outline updownlevel";
2752 {< m_active
= active; m_first
= first >}
2754 method private key1
key mask
=
2755 let set1 active first qsearch
=
2756 coe {< m_active
= active; m_first
= first; m_qsearch
= qsearch
>}
2758 let search active pattern incr
=
2759 let active = if active = -1 then m_first
else active in
2762 if n >= 0 && n < source#getitemcount
2764 let s, _ = source#getitem
n in
2765 match Str.search_forward re
s 0 with
2766 | (exception Not_found
) -> loop (n + incr
)
2773 let qpat = Str.quote pattern
in
2774 match Str.regexp_case_fold
qpat with
2777 adderrfmt "listview key1" "regexp_case_fold for `%S' failed: %S\n"
2778 qpat @@ Printexc.to_string exn
;
2781 let itemcount = source#getitemcount
in
2782 let find start incr
=
2784 if i
= -1 || i
= itemcount
2787 if source#hasaction i
2789 else find (i
+ incr
)
2794 let set active first =
2795 let first = bound
first 0 (itemcount - fstate
.maxrows
) in
2797 coe {< m_active
= active; m_first
= first; m_qsearch
= E.s >}
2800 let isvisible first n = n >= first && n - first <= fstate
.maxrows
in
2802 let incr1 = if incr
> 0 then 1 else -1 in
2803 if isvisible m_first m_active
2806 let next = m_active
+ incr
in
2808 if next < 0 || next >= itemcount
2810 else find next incr1
2812 if abs
(m_active
- next) > fstate
.maxrows
2818 let first = m_first
+ incr
in
2819 let first = bound
first 0 (itemcount - fstate
.maxrows
) in
2821 let next = m_active
+ incr
in
2822 let next = bound
next 0 (itemcount - 1) in
2829 if isvisible first next
2836 let first = min
next m_first
in
2838 if abs
(next - first) > fstate
.maxrows
2844 let first = m_first
+ incr
in
2845 let first = bound
first 0 (itemcount - 1) in
2847 let next = m_active
+ incr
in
2848 let next = bound
next 0 (itemcount - 1) in
2849 let next = find next incr1 in
2851 if next = -1 || abs
(m_active
- first) > fstate
.maxrows
2853 let active = if m_active
= -1 then next else m_active
in
2858 if isvisible first active
2864 G.postRedisplay "listview navigate";
2868 | (@r
|@s) when Wsi.withctrl mask
->
2869 let incr = if key = @r
then -1 else 1 in
2871 match search (m_active
+ incr) m_qsearch
incr with
2873 state
.text <- m_qsearch ^
" [not found]";
2876 state
.text <- m_qsearch
;
2877 active, firstof m_first
active
2879 G.postRedisplay "listview ctrl-r/s";
2880 set1 active first m_qsearch
;
2882 | @insert
when Wsi.withctrl mask
->
2883 if m_active
>= 0 && m_active
< source#getitemcount
2885 let s, _ = source#getitem m_active
in
2891 if emptystr m_qsearch
2894 let qsearch = withoutlastutf8 m_qsearch
in
2898 G.postRedisplay "listview empty qsearch";
2899 set1 m_active m_first
E.s;
2903 match search m_active
qsearch ~
-1 with
2905 state
.text <- qsearch ^
" [not found]";
2908 state
.text <- qsearch;
2909 active, firstof m_first
active
2911 G.postRedisplay "listview backspace qsearch";
2912 set1 active first qsearch
2915 | key when (key != 0 && not
(Wsi.isspecialkey
key)) ->
2916 let pattern = m_qsearch ^ toutf8
key in
2918 match search m_active
pattern 1 with
2920 state
.text <- pattern ^
" [not found]";
2923 state
.text <- pattern;
2924 active, firstof m_first
active
2926 G.postRedisplay "listview qsearch add";
2927 set1 active first pattern;
2931 if emptystr m_qsearch
2933 G.postRedisplay "list view escape";
2934 let mx, my
= state
.mpos
in
2938 source#exit ~uioh
:(coe self
)
2939 ~cancel
:true ~
active:m_active ~
first:m_first ~pan
:m_pan
2941 | None
-> m_prev_uioh
2946 G.postRedisplay "list view kill qsearch";
2947 coe {< m_qsearch
= E.s >}
2950 | @enter
| @kpenter
->
2952 let self = {< m_qsearch
= E.s >} in
2954 G.postRedisplay "listview enter";
2955 if m_active
>= 0 && m_active
< source#getitemcount
2957 source#exit ~uioh
:(coe self) ~cancel
:false
2958 ~
active:m_active ~
first:m_first ~pan
:m_pan
;
2961 source#exit ~uioh
:(coe self) ~cancel
:true
2962 ~
active:m_active ~
first:m_first ~pan
:m_pan
;
2965 begin match opt with
2966 | None
-> m_prev_uioh
2970 | @delete
| @kpdelete
->
2973 | @up
| @kpup
-> navigate ~
-1
2974 | @down
| @kpdown
-> navigate 1
2975 | @prior
| @kpprior
-> navigate ~
-(fstate
.maxrows
)
2976 | @next | @kpnext
-> navigate fstate
.maxrows
2978 | @right
| @kpright
->
2980 G.postRedisplay "listview right";
2981 coe {< m_pan
= m_pan
- 1 >}
2983 | @left | @kpleft
->
2985 G.postRedisplay "listview left";
2986 coe {< m_pan
= m_pan
+ 1 >}
2988 | @home
| @kphome
->
2989 let active = find 0 1 in
2990 G.postRedisplay "listview home";
2994 let first = max
0 (itemcount - fstate
.maxrows
) in
2995 let active = find (itemcount - 1) ~
-1 in
2996 G.postRedisplay "listview end";
2999 | key when (key = 0 || Wsi.isspecialkey
key) ->
3003 dolog
"listview unknown key %#x" key; coe self
3005 method key key mask
=
3006 match state
.mode
with
3007 | Textentry te
-> textentrykeyboard key mask te
; coe self
3010 | LinkNav
_ -> self#key1
key mask
3012 method button button down
x y _ =
3015 | 1 when vscrollhit x ->
3016 G.postRedisplay "listview scroll";
3019 let _, position, sh = self#
scrollph in
3020 if y > truncate
position && y < truncate
(position +. sh)
3022 state
.mstate
<- Mscrolly
;
3026 let s = float (max
0 (y - conf
.scrollh
)) /. float state
.winh
in
3027 let first = truncate
(s *. float source#getitemcount
) in
3028 let first = min source#getitemcount
first in
3029 Some
(coe {< m_first
= first; m_active
= first >})
3031 state
.mstate
<- Mnone
;
3035 begin match self#elemunder
y with
3037 G.postRedisplay "listview click";
3038 source#exit ~uioh
:(coe {< m_active
= n >})
3039 ~cancel
:false ~
active:n ~
first:m_first ~pan
:m_pan
3043 | n when (n == 4 || n == 5) && not down
->
3044 let len = source#getitemcount
in
3046 if n = 5 && m_first
+ fstate
.maxrows
>= len
3050 let first = m_first
+ (if n == 4 then -1 else 1) in
3051 bound
first 0 (len - 1)
3053 G.postRedisplay "listview wheel";
3054 Some
(coe {< m_first
= first >})
3055 | n when (n = 6 || n = 7) && not down
->
3056 let inc = if n = 7 then -1 else 1 in
3057 G.postRedisplay "listview hwheel";
3058 Some
(coe {< m_pan
= m_pan
+ inc >})
3063 | None
-> m_prev_uioh
3066 method multiclick
_ x y = self#button
1 true x y
3069 match state
.mstate
with
3071 let s = float (max
0 (y - conf
.scrollh
)) /. float state
.winh
in
3072 let first = truncate
(s *. float source#getitemcount
) in
3073 let first = min source#getitemcount
first in
3074 G.postRedisplay "listview motion";
3075 coe {< m_first
= first; m_active
= first >}
3083 method pmotion
x y =
3084 if x < state
.winw
- conf
.scrollbw
3087 match self#elemunder
y with
3088 | None
-> Wsi.setcursor
Wsi.CURSOR_INHERIT
; m_active
3089 | Some
n -> Wsi.setcursor
Wsi.CURSOR_INFO
; n
3093 then (G.postRedisplay "listview pmotion"; {< m_active
= n >})
3098 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
3102 method infochanged
_ = ()
3104 method scrollpw
= (0, 0.0, 0.0)
3106 let nfs = fstate
.fontsize
+ 1 in
3107 let y = m_first
* nfs in
3108 let itemcount = source#getitemcount
in
3109 let maxi = max
0 (itemcount - fstate
.maxrows
) in
3110 let maxy = maxi * nfs in
3111 let p, h = scrollph y maxy in
3114 method modehash
= modehash
3115 method eformsgs
= false
3116 method alwaysscrolly
= true
3119 class outlinelistview ~zebra ~source
=
3120 let settext autonarrow
s =
3123 let ss = source#statestr
in
3127 else "{" ^
ss ^
"} [" ^
s ^
"]"
3128 else state
.text <- s
3134 ~source
:(source
:> lvsource
)
3136 ~modehash
:(findkeyhash conf
"outline")
3139 val m_autonarrow
= false
3141 method! key key mask
=
3143 if emptystr state
.text
3145 else fstate
.maxrows - 2
3147 let calcfirst first active =
3150 let rows = active - first in
3151 if rows > maxrows then active - maxrows else first
3155 let active = m_active
+ incr in
3156 let active = bound
active 0 (source#getitemcount
- 1) in
3157 let first = calcfirst m_first
active in
3158 G.postRedisplay "outline navigate";
3159 coe {< m_active
= active; m_first
= first >}
3161 let navscroll first =
3163 let dist = m_active
- first in
3169 else first + maxrows
3172 G.postRedisplay "outline navscroll";
3173 coe {< m_first
= first; m_active
= active >}
3175 let ctrl = Wsi.withctrl mask
in
3180 then (source#denarrow
; E.s)
3182 let pattern = source#renarrow
in
3183 if nonemptystr m_qsearch
3184 then (source#narrow m_qsearch
; m_qsearch
)
3188 settext (not m_autonarrow
) text;
3189 G.postRedisplay "toggle auto narrowing";
3190 coe {< m_first
= 0; m_active
= 0; m_autonarrow
= not m_autonarrow
>}
3192 | @slash
when emptystr m_qsearch
&& not m_autonarrow
->
3194 G.postRedisplay "toggle auto narrowing";
3195 coe {< m_first
= 0; m_active
= 0; m_autonarrow
= true >}
3198 source#narrow m_qsearch
;
3200 then source#add_narrow_pattern m_qsearch
;
3201 G.postRedisplay "outline ctrl-n";
3202 coe {< m_first
= 0; m_active
= 0 >}
3205 let active = source#calcactive
(getanchor
()) in
3206 let first = firstof m_first
active in
3207 G.postRedisplay "outline ctrl-s";
3208 coe {< m_first
= first; m_active
= active >}
3211 G.postRedisplay "outline ctrl-u";
3212 if m_autonarrow
&& nonemptystr m_qsearch
3214 ignore
(source#renarrow
);
3215 settext m_autonarrow
E.s;
3216 coe {< m_first
= 0; m_active
= 0; m_qsearch
= E.s >}
3219 source#del_narrow_pattern
;
3220 let pattern = source#renarrow
in
3222 if emptystr
pattern then E.s else "Narrowed to " ^
pattern
3224 settext m_autonarrow
text;
3225 coe {< m_first
= 0; m_active
= 0; m_qsearch
= E.s >}
3229 let first = max
0 (m_active
- (fstate
.maxrows / 2)) in
3230 G.postRedisplay "outline ctrl-l";
3231 coe {< m_first
= first >}
3233 | @tab
when m_autonarrow
->
3234 if nonemptystr m_qsearch
3236 G.postRedisplay "outline list view tab";
3237 source#add_narrow_pattern m_qsearch
;
3239 coe {< m_qsearch
= E.s >}
3243 | @escape
when m_autonarrow
->
3244 if nonemptystr m_qsearch
3245 then source#add_narrow_pattern m_qsearch
;
3248 | @enter
| @kpenter
when m_autonarrow
->
3249 if nonemptystr m_qsearch
3250 then source#add_narrow_pattern m_qsearch
;
3253 | key when m_autonarrow
&& (not
(Wsi.isspecialkey
key)) ->
3254 let pattern = m_qsearch ^ toutf8
key in
3255 G.postRedisplay "outlinelistview autonarrow add";
3256 source#narrow
pattern;
3257 settext true pattern;
3258 coe {< m_first
= 0; m_active
= 0; m_qsearch
= pattern >}
3260 | key when m_autonarrow
&& key = @backspace
->
3261 if emptystr m_qsearch
3264 let pattern = withoutlastutf8 m_qsearch
in
3265 G.postRedisplay "outlinelistview autonarrow backspace";
3266 ignore
(source#renarrow
);
3267 source#narrow
pattern;
3268 settext true pattern;
3269 coe {< m_first
= 0; m_active
= 0; m_qsearch
= pattern >}
3271 | @up
| @kpup
when ctrl ->
3272 navscroll (max
0 (m_first
- 1))
3274 | @down
| @kpdown
when ctrl ->
3275 navscroll (min
(source#getitemcount
- 1) (m_first
+ 1))
3277 | @up
| @kpup
-> navigate ~
-1
3278 | @down
| @kpdown
-> navigate 1
3279 | @prior
| @kpprior
-> navigate ~
-(fstate
.maxrows)
3280 | @next | @kpnext
-> navigate fstate
.maxrows
3282 | @right
| @kpright
->
3286 G.postRedisplay "outline ctrl right";
3287 {< m_pan
= m_pan
+ 1 >}
3289 else self#updownlevel
1
3293 | @left | @kpleft
->
3297 G.postRedisplay "outline ctrl left";
3298 {< m_pan
= m_pan
- 1 >}
3300 else self#updownlevel ~
-1
3304 | @home
| @kphome
->
3305 G.postRedisplay "outline home";
3306 coe {< m_first
= 0; m_active
= 0 >}
3309 let active = source#getitemcount
- 1 in
3310 let first = max
0 (active - fstate
.maxrows) in
3311 G.postRedisplay "outline end";
3312 coe {< m_active
= active; m_first
= first >}
3314 | _ -> super#
key key mask
3317 let genhistoutlines () =
3319 |> List.sort
(fun (_, c1
, _, _, _, _) (_, c2
, _, _, _, _) ->
3320 compare c2
.lastvisit c1
.lastvisit
)
3322 (fun ((path
, c, _, _, _, origin
) as hist
) ->
3323 let path = if nonemptystr origin
then origin
else path in
3324 let base = mbtoutf8
@@ Filename.basename
path in
3325 (base ^
"\000" ^
c.title
, 1, Ohistory hist
)
3330 let gotohist (path, c, bookmarks
, x, anchor, origin
) =
3331 Config.save
leavebirdseye;
3332 state
.anchor <- anchor;
3333 state
.bookmarks
<- bookmarks
;
3334 state
.origin
<- origin
;
3337 let x0, y0, x1, y1 = conf
.trimfuzz
in
3338 wcmd "trimset %d %d %d %d %d" (btod conf
.trimmargins
) x0 y0 x1 y1;
3339 reshape ~firsttime
:true state
.winw state
.winh
;
3340 opendoc path origin
;
3344 let makecheckers () =
3345 (* Based on lablGL-1.04/LablGlut/examples/lablGL/checker.ml which had
3347 converted by Issac Trotts. July 25, 2002 *)
3348 let image = GlPix.create `ubyte ~format
:`luminance ~width
:2 ~height
:2 in
3349 Raw.sets_string
(GlPix.to_raw
image) ~
pos:0 "\255\200\200\255";
3350 let id = GlTex.gen_texture
() in
3351 GlTex.bind_texture ~target
:`texture_2d
id;
3352 GlPix.store
(`unpack_alignment
1);
3353 GlTex.image2d
image;
3354 List.iter
(GlTex.parameter ~target
:`texture_2d
)
3355 [ `mag_filter `nearest
; `min_filter `nearest
];
3359 let setcheckers enabled
=
3360 match state
.checkerstexid
with
3362 if enabled
then state
.checkerstexid
<- Some
(makecheckers ())
3364 | Some checkerstexid
->
3367 GlTex.delete_texture checkerstexid
;
3368 state
.checkerstexid
<- None
;
3372 let describe_location () =
3373 let fn = page_of_y state
.y in
3374 let ln = page_of_y
(state
.y + state
.winh
- hscrollh () - 1) in
3375 let maxy = state
.maxy - (if conf
.maxhfit
then state
.winh
else 0) in
3379 else (100. *. (float state
.y /. float maxy))
3383 Printf.sprintf
"page %d of %d [%.2f%%]"
3384 (fn+1) state
.pagecount
percent
3387 "pages %d-%d of %d [%.2f%%]"
3388 (fn+1) (ln+1) state
.pagecount
percent
3391 let setpresentationmode v
=
3392 let n = page_of_y state
.y in
3393 state
.anchor <- (n, 0.0, 1.0);
3394 conf
.presentation
<- v
;
3395 if conf
.fitmodel
= FitPage
3396 then reqlayout conf
.angle conf
.fitmodel
;
3400 let setbgcol (r
, g, b) =
3402 let r = r *. 255.0 |> truncate
3403 and g = g *. 255.0 |> truncate
3404 and b = b *. 255.0 |> truncate
in
3405 r lsl 16 |> (lor) (g lsl 8) |> (lor) b
3407 Wsi.setwinbgcol
col;
3411 let btos b = if b then "@Uradical" else E.s in
3412 let showextended = ref false in
3413 let leave mode
_ = state
.mode
<- mode
in
3416 val mutable m_l
= []
3417 val mutable m_a
= E.a
3418 val mutable m_prev_uioh
= nouioh
3419 val mutable m_prev_mode
= View
3421 inherit lvsourcebase
3423 method reset prev_mode prev_uioh
=
3424 m_a
<- Array.of_list
(List.rev m_l
);
3426 m_prev_mode
<- prev_mode
;
3427 m_prev_uioh
<- prev_uioh
;
3429 method int name get
set =
3431 (name
, `
int get
, 1, Action
(
3434 try set (int_of_string
s)
3436 state
.text <- Printf.sprintf
"bad integer `%s': %s"
3440 let te = name ^
": ", E.s, None
, intentry, ondone, true in
3441 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3445 method int_with_suffix name get
set =
3447 (name
, `intws get
, 1, Action
(
3450 try set (int_of_string_with_suffix
s)
3452 state
.text <- Printf.sprintf
"bad integer `%s': %s"
3457 name ^
": ", E.s, None
, intentry_with_suffix, ondone, true
3459 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3463 method bool ?
(offset
=1) ?
(btos=btos) name get
set =
3465 (name
, `
bool (btos, get
), offset
, Action
(
3472 method color name get
set =
3474 (name
, `
color get
, 1, Action
(
3476 let invalid = (nan
, nan
, nan
) in
3479 try color_of_string
s
3481 state
.text <- Printf.sprintf
"bad color `%s': %s"
3488 let te = name ^
": ", E.s, None
, textentry, ondone, true in
3489 state
.text <- color_to_string
(get
());
3490 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3494 method string name get
set =
3496 (name
, `
string get
, 1, Action
(
3498 let ondone s = set s in
3499 let te = name ^
": ", E.s, None
, textentry, ondone, true in
3500 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3504 method colorspace name get
set =
3506 (name
, `
string get
, 1, Action
(
3510 inherit lvsourcebase
3513 m_active
<- CSTE.to_int conf
.colorspace
;
3516 method getitemcount
=
3517 Array.length
CSTE.names
3520 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3521 ignore
(uioh
, first, pan
);
3522 if not cancel
then set active;
3524 method hasaction
_ = true
3528 let modehash = findkeyhash conf
"info" in
3529 coe (new listview ~zebra
:false ~helpmode
:false
3530 ~
source ~trusted
:true ~
modehash)
3533 method paxmark name get
set =
3535 (name
, `
string get
, 1, Action
(
3539 inherit lvsourcebase
3542 m_active
<- MTE.to_int conf
.paxmark
;
3545 method getitemcount
= Array.length
MTE.names
3546 method getitem
n = (MTE.names
.(n), 0)
3547 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3548 ignore
(uioh
, first, pan
);
3549 if not cancel
then set active;
3551 method hasaction
_ = true
3555 let modehash = findkeyhash conf
"info" in
3556 coe (new listview ~zebra
:false ~helpmode
:false
3557 ~
source ~trusted
:true ~
modehash)
3560 method fitmodel name get
set =
3562 (name
, `
string get
, 1, Action
(
3566 inherit lvsourcebase
3569 m_active
<- FMTE.to_int conf
.fitmodel
;
3572 method getitemcount
= Array.length
FMTE.names
3573 method getitem
n = (FMTE.names
.(n), 0)
3574 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3575 ignore
(uioh
, first, pan
);
3576 if not cancel
then set active;
3578 method hasaction
_ = true
3582 let modehash = findkeyhash conf
"info" in
3583 coe (new listview ~zebra
:false ~helpmode
:false
3584 ~
source ~trusted
:true ~
modehash)
3587 method caption
s offset
=
3588 m_l
<- (s, `empty
, offset
, Noaction
) :: m_l
3590 method caption2
s f offset
=
3591 m_l
<- (s, `
string f, offset
, Noaction
) :: m_l
3593 method getitemcount
= Array.length m_a
3596 let tostr = function
3597 | `
int f -> string_of_int
(f ())
3598 | `intws
f -> string_with_suffix_of_int
(f ())
3600 | `
color f -> color_to_string
(f ())
3601 | `
bool (btos, f) -> btos (f ())
3604 let name, t
, offset
, _ = m_a
.(n) in
3605 ((let s = tostr t
in
3607 then Printf.sprintf
"%s\t%s" name s
3611 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3616 match m_a
.(active) with
3617 | _, _, _, Action
f -> f uioh
3618 | _, _, _, Noaction
-> uioh
3629 method hasaction
n =
3631 | _, _, _, Action
_ -> true
3632 | _, _, _, Noaction
-> false
3634 initializer m_active
<- 1
3637 let rec fillsrc prevmode prevuioh
=
3638 let sep () = src#caption
E.s 0 in
3639 let colorp name get
set =
3641 (fun () -> color_to_string
(get
()))
3644 let c = color_of_string
v in
3647 state
.text <- Printf.sprintf
"bad color `%s': %s" v @@ exntos exn
3650 let oldmode = state
.mode
in
3651 let birdseye = isbirdseye state
.mode
in
3653 src#caption
(if birdseye then "Setup (Bird's eye)" else "Setup") 0;
3655 src#
bool "presentation mode"
3656 (fun () -> conf
.presentation
)
3657 (fun v -> setpresentationmode v);
3659 src#
bool "ignore case in searches"
3660 (fun () -> conf
.icase
)
3661 (fun v -> conf
.icase
<- v);
3664 (fun () -> conf
.preload)
3665 (fun v -> conf
.preload <- v);
3667 src#
bool "highlight links"
3668 (fun () -> conf
.hlinks
)
3669 (fun v -> conf
.hlinks
<- v);
3671 src#
bool "under info"
3672 (fun () -> conf
.underinfo
)
3673 (fun v -> conf
.underinfo
<- v);
3675 src#
bool "persistent bookmarks"
3676 (fun () -> conf
.savebmarks
)
3677 (fun v -> conf
.savebmarks
<- v);
3679 src#fitmodel
"fit model"
3680 (fun () -> FMTE.to_string conf
.fitmodel
)
3681 (fun v -> reqlayout conf
.angle
(FMTE.of_int
v));
3683 src#
bool "trim margins"
3684 (fun () -> conf
.trimmargins
)
3685 (fun v -> settrim v conf
.trimfuzz
; fillsrc prevmode prevuioh
);
3687 src#
bool "persistent location"
3688 (fun () -> conf
.jumpback
)
3689 (fun v -> conf
.jumpback
<- v);
3692 src#
int "inter-page space"
3693 (fun () -> conf
.interpagespace
)
3695 conf
.interpagespace
<- n;
3696 docolumns conf
.columns
;
3698 match state
.layout with
3703 state
.maxy <- calcheight
();
3704 let y = getpagey
pageno in
3705 gotoxy state
.x (y + py)
3709 (fun () -> conf
.pagebias
)
3710 (fun v -> conf
.pagebias
<- v);
3712 src#
int "scroll step"
3713 (fun () -> conf
.scrollstep
)
3714 (fun n -> conf
.scrollstep
<- n);
3716 src#
int "horizontal scroll step"
3717 (fun () -> conf
.hscrollstep
)
3718 (fun v -> conf
.hscrollstep
<- v);
3720 src#
int "auto scroll step"
3722 match state
.autoscroll
with
3724 | _ -> conf
.autoscrollstep
)
3726 let n = boundastep state
.winh
n in
3727 if state
.autoscroll
<> None
3728 then state
.autoscroll
<- Some
n;
3729 conf
.autoscrollstep
<- n);
3732 (fun () -> truncate
(conf
.zoom *. 100.))
3733 (fun v -> setzoom ((float v) /. 100.));
3736 (fun () -> conf
.angle
)
3737 (fun v -> reqlayout v conf
.fitmodel
);
3739 src#
int "scroll bar width"
3740 (fun () -> conf
.scrollbw
)
3743 reshape state
.winw state
.winh
;
3746 src#
int "scroll handle height"
3747 (fun () -> conf
.scrollh
)
3748 (fun v -> conf
.scrollh
<- v;);
3750 src#
int "thumbnail width"
3751 (fun () -> conf
.thumbw
)
3753 conf
.thumbw
<- min
4096 v;
3756 leavebirdseye beye
false;
3763 let mode = state
.mode in
3764 src#
string "columns"
3766 match conf
.columns
with
3768 | Cmulti
(multi
, _) -> multicolumns_to_string multi
3769 | Csplit
(count
, _) -> "-" ^ string_of_int count
3772 let n, a, b = multicolumns_of_string
v in
3773 setcolumns mode n a b);
3776 src#caption
"Pixmap cache" 0;
3777 src#int_with_suffix
"size (advisory)"
3778 (fun () -> conf
.memlimit
)
3779 (fun v -> conf
.memlimit
<- v);
3782 (fun () -> Printf.sprintf
"%s bytes, %d tiles"
3783 (string_with_suffix_of_int state
.memused
)
3784 (Hashtbl.length state
.tilemap
)) 1;
3787 src#caption
"Layout" 0;
3788 src#caption2
"Dimension"
3790 Printf.sprintf
"%dx%d (virtual %dx%d)"
3791 state
.winw state
.winh
3796 src#caption2
"Position" (fun () ->
3797 Printf.sprintf
"%dx%d" state
.x state
.y
3800 src#caption2
"Position" (fun () -> describe_location ()) 1
3804 src#
bool ~offset
:0 ~
btos:(fun v -> if v then "(on)" else "(off)")
3805 "Save these parameters as global defaults at exit"
3806 (fun () -> conf
.bedefault
)
3807 (fun v -> conf
.bedefault
<- v)
3811 let btos b = if b then "@Ulguillemet" else "@Urguillemet" in
3812 src#
bool ~offset
:0 ~
btos "Extended parameters"
3813 (fun () -> !showextended)
3814 (fun v -> showextended := v; fillsrc prevmode prevuioh
);
3818 (fun () -> conf
.checkers
)
3819 (fun v -> conf
.checkers
<- v; setcheckers v);
3820 src#
bool "update cursor"
3821 (fun () -> conf
.updatecurs
)
3822 (fun v -> conf
.updatecurs
<- v);
3823 src#
bool "scroll-bar on the left"
3824 (fun () -> conf
.leftscroll
)
3825 (fun v -> conf
.leftscroll
<- v);
3827 (fun () -> conf
.verbose
)
3828 (fun v -> conf
.verbose
<- v);
3829 src#
bool "invert colors"
3830 (fun () -> conf
.invert
)
3831 (fun v -> conf
.invert
<- v);
3833 (fun () -> conf
.maxhfit
)
3834 (fun v -> conf
.maxhfit
<- v);
3836 (fun () -> conf
.pax
!= None
)
3839 then conf
.pax
<- Some
(ref (now
(), 0, 0))
3840 else conf
.pax
<- None
);
3841 src#
string "uri launcher"
3842 (fun () -> conf
.urilauncher
)
3843 (fun v -> conf
.urilauncher
<- v);
3844 src#
string "path launcher"
3845 (fun () -> conf
.pathlauncher
)
3846 (fun v -> conf
.pathlauncher
<- v);
3847 src#
string "tile size"
3848 (fun () -> Printf.sprintf
"%dx%d" conf
.tilew conf
.tileh
)
3851 let w, h = Scanf.sscanf
v "%dx%d" (fun w h -> w, h) in
3852 conf
.tilew
<- max
64 w;
3853 conf
.tileh
<- max
64 h;
3856 state
.text <- Printf.sprintf
"bad tile size `%s': %s"
3859 src#
int "texture count"
3860 (fun () -> conf
.texcount
)
3863 then conf
.texcount
<- v
3864 else impmsg "failed to set texture count please retry later"
3866 src#
int "slice height"
3867 (fun () -> conf
.sliceheight
)
3869 conf
.sliceheight
<- v;
3870 wcmd "sliceh %d" conf
.sliceheight
;
3872 src#
int "anti-aliasing level"
3873 (fun () -> conf
.aalevel
)
3875 conf
.aalevel
<- bound
v 0 8;
3876 state
.anchor <- getanchor
();
3877 opendoc state
.path state
.password;
3879 src#
string "page scroll scaling factor"
3880 (fun () -> string_of_float conf
.pgscale)
3883 let s = float_of_string
v in
3886 state
.text <- Printf.sprintf
3887 "bad page scroll scaling factor `%s': %s" v @@ exntos exn
3890 src#
int "ui font size"
3891 (fun () -> fstate
.fontsize
)
3892 (fun v -> setfontsize (bound
v 5 100));
3893 src#
int "hint font size"
3894 (fun () -> conf
.hfsize
)
3895 (fun v -> conf
.hfsize
<- bound
v 5 100);
3896 colorp "background color"
3897 (fun () -> conf
.bgcolor
)
3898 (fun v -> conf
.bgcolor
<- v; setbgcol v);
3899 src#
bool "crop hack"
3900 (fun () -> conf
.crophack
)
3901 (fun v -> conf
.crophack
<- v);
3902 src#
string "trim fuzz"
3903 (fun () -> irect_to_string conf
.trimfuzz
)
3906 conf
.trimfuzz
<- irect_of_string
v;
3908 then settrim true conf
.trimfuzz
;
3910 state
.text <- Printf.sprintf
"bad irect `%s': %s" v @@ exntos exn
3912 src#
string "throttle"
3914 match conf
.maxwait
with
3915 | None
-> "show place holder if page is not ready"
3918 then "wait for page to fully render"
3920 "wait " ^ string_of_float
time
3921 ^
" seconds before showing placeholder"
3925 let f = float_of_string
v in
3927 then conf
.maxwait
<- None
3928 else conf
.maxwait
<- Some
f
3930 state
.text <- Printf.sprintf
"bad time `%s': %s" v @@ exntos exn
3932 src#
string "ghyll scroll"
3934 match conf
.ghyllscroll
with
3936 | Some nab
-> ghyllscroll_to_string nab
3939 try conf
.ghyllscroll
<- ghyllscroll_of_string
v
3942 state
.text <- Printf.sprintf
"bad ghyll `%s': %s" v msg
3944 state
.text <- Printf.sprintf
"bad ghyll `%s': %s" v @@ exntos exn
3946 src#
string "selection command"
3947 (fun () -> conf
.selcmd
)
3948 (fun v -> conf
.selcmd
<- v);
3949 src#
string "synctex command"
3950 (fun () -> conf
.stcmd
)
3951 (fun v -> conf
.stcmd
<- v);
3952 src#
string "pax command"
3953 (fun () -> conf
.paxcmd
)
3954 (fun v -> conf
.paxcmd
<- v);
3955 src#
string "ask password command"
3956 (fun () -> conf
.passcmd)
3957 (fun v -> conf
.passcmd <- v);
3958 src#
string "save path command"
3959 (fun () -> conf
.savecmd
)
3960 (fun v -> conf
.savecmd
<- v);
3961 src#colorspace
"color space"
3962 (fun () -> CSTE.to_string conf
.colorspace
)
3964 conf
.colorspace
<- CSTE.of_int
v;
3968 src#paxmark
"pax mark method"
3969 (fun () -> MTE.to_string conf
.paxmark
)
3970 (fun v -> conf
.paxmark
<- MTE.of_int
v);
3971 if bousable
() && !opengl_has_pbo
3974 (fun () -> conf
.usepbo
)
3975 (fun v -> conf
.usepbo
<- v);
3976 src#
bool "mouse wheel scrolls pages"
3977 (fun () -> conf
.wheelbypage
)
3978 (fun v -> conf
.wheelbypage
<- v);
3979 src#
bool "open remote links in a new instance"
3980 (fun () -> conf
.riani
)
3981 (fun v -> conf
.riani
<- v);
3982 src#
bool "edit annotations inline"
3983 (fun () -> conf
.annotinline
)
3984 (fun v -> conf
.annotinline
<- v);
3985 src#
bool "coarse positioning in presentation mode"
3986 (fun () -> conf
.coarseprespos
)
3987 (fun v -> conf
.coarseprespos
<- v);
3991 src#caption
"Document" 0;
3992 List.iter
(fun (_, s) -> src#caption
s 1) state
.docinfo
;
3993 src#caption2
"Pages"
3994 (fun () -> string_of_int state
.pagecount
) 1;
3995 src#caption2
"Dimensions"
3996 (fun () -> string_of_int
(List.length state
.pdims
)) 1;
4000 src#caption
"Trimmed margins" 0;
4001 src#caption2
"Dimensions"
4002 (fun () -> string_of_int
(List.length state
.pdims
)) 1;
4006 src#caption
"OpenGL" 0;
4007 src#caption
(Printf.sprintf
"Vendor\t%s" (GlMisc.get_string `vendor
)) 1;
4008 src#caption
(Printf.sprintf
"Renderer\t%s" (GlMisc.get_string `renderer
)) 1;
4011 src#caption
"Location" 0;
4012 if nonemptystr state
.origin
4013 then src#caption
("Orign\t" ^ mbtoutf8 state
.origin
) 1;
4014 src#caption
("Path\t" ^ mbtoutf8 state
.path) 1;
4016 src#reset prevmode prevuioh
;
4021 let prevmode = state
.mode
4022 and prevuioh
= state
.uioh in
4023 fillsrc prevmode prevuioh
;
4024 let source = (src :> lvsource
) in
4025 let modehash = findkeyhash conf
"info" in
4026 state
.uioh <- coe (object (self)
4027 inherit listview ~zebra
:false ~helpmode
:false
4028 ~
source ~trusted
:true ~
modehash as super
4029 val mutable m_prevmemused
= 0
4030 method! infochanged
= function
4032 if m_prevmemused
!= state
.memused
4034 m_prevmemused
<- state
.memused
;
4035 G.postRedisplay "memusedchanged";
4037 | Pdim
-> G.postRedisplay "pdimchanged"
4038 | Docinfo
-> fillsrc prevmode prevuioh
4040 method! key key mask
=
4041 if not
(Wsi.withctrl mask
)
4044 | @left | @kpleft
-> coe (self#updownlevel ~
-1)
4045 | @right
| @kpright
-> coe (self#updownlevel
1)
4046 | _ -> super#
key key mask
4047 else super#
key key mask
4049 G.postRedisplay "info";
4055 inherit lvsourcebase
4056 method getitemcount
= Array.length state
.help
4058 let s, l, _ = state
.help
.(n) in
4061 method exit ~
uioh ~cancel ~
active ~
first ~pan
=
4065 match state
.help
.(active) with
4066 | _, _, Action
f -> Some
(f uioh)
4067 | _, _, Noaction
-> Some
uioh
4076 method hasaction
n =
4077 match state
.help
.(n) with
4078 | _, _, Action
_ -> true
4079 | _, _, Noaction
-> false
4085 let modehash = findkeyhash conf
"help" in
4087 state
.uioh <- coe (new listview
4088 ~zebra
:false ~helpmode
:true
4089 ~
source ~trusted
:true ~
modehash);
4090 G.postRedisplay "help";
4096 inherit lvsourcebase
4097 val mutable m_items
= E.a
4099 method getitemcount
= 1 + Array.length m_items
4104 else m_items
.(n-1), 0
4106 method exit ~
uioh ~cancel ~
active ~
first ~pan
=
4111 then Buffer.clear state
.errmsgs
;
4118 method hasaction
n =
4122 state
.newerrmsgs
<- false;
4123 let l = Str.split newlinere
(Buffer.contents state
.errmsgs
) in
4124 m_items
<- Array.of_list
l
4133 let source = (msgsource :> lvsource
) in
4134 let modehash = findkeyhash conf
"listview" in
4135 state
.uioh <- coe (object
4136 inherit listview ~zebra
:false ~helpmode
:false
4137 ~
source ~trusted
:false ~
modehash as super
4140 then msgsource#reset
;
4143 G.postRedisplay "msgs";
4147 let editor = getenvwithdef
"EDITOR" E.s in
4151 let tmppath = Filename.temp_file
"llpp" "note" in
4154 let oc = open_out
tmppath in
4158 let execstr = editor ^
" " ^
tmppath in
4160 match spawn
execstr [] with
4161 | (exception exn
) ->
4162 impmsg "spawn(%S) failed: %s" execstr @@ exntos exn
;
4165 match Unix.waitpid
[] pid with
4166 | (exception exn
) ->
4167 impmsg "waitpid(%d) failed: %s" pid @@ exntos exn
;
4171 | Unix.WEXITED
0 -> filecontents
tmppath
4173 impmsg "editor process(%s) exited abnormally: %d" execstr n;
4175 | Unix.WSIGNALED
n ->
4176 impmsg "editor process(%s) was killed by signal %d" execstr n;
4178 | Unix.WSTOPPED
n ->
4179 impmsg "editor(%s) process was stopped by signal %d" execstr n;
4182 match Unix.unlink
tmppath with
4183 | (exception exn
) ->
4184 impmsg "failed to ulink %S: %s" tmppath @@ exntos exn
;
4189 let enterannotmode opaque slinkindex
=
4192 inherit lvsourcebase
4193 val mutable m_text
= E.s
4194 val mutable m_items
= E.a
4196 method getitemcount
= Array.length m_items
4199 let label, _func
= m_items
.(n) in
4202 method exit ~
uioh ~cancel ~
active ~
first ~pan
=
4203 ignore
(uioh, first, pan
);
4206 let _label, func
= m_items
.(active) in
4211 method hasaction
n = nonemptystr
@@ fst m_items
.(n)
4214 let rec split accu b i
=
4216 if p = String.length
s
4217 then (String.sub
s b (p-b), unit) :: accu
4219 if (i
> 70 && s.[p] = ' '
) || s.[p] = '
\r'
|| s.[p] = '
\n'
4221 let ss = if i
= 0 then E.s else String.sub
s b i
in
4222 split ((ss, unit)::accu) (p+1) 0
4227 wcmd "freepage %s" (~
> opaque);
4229 Hashtbl.fold (fun key opaque'
accu ->
4230 if opaque'
= opaque'
4231 then key :: accu else accu) state
.pagemap
[]
4233 List.iter
(Hashtbl.remove state
.pagemap
) keys;
4235 gotoxy state
.x state
.y
4238 delannot
opaque slinkindex
;
4241 let edit inline
() =
4246 modannot
opaque slinkindex
s;
4252 let mode = state
.mode in
4255 ("annotation: ", m_text
, None
, textentry, update, true),
4256 fun _ -> state
.mode <- mode);
4260 let s = getusertext m_text
in
4265 ( "[Copy]", fun () -> selstring m_text
)
4266 :: ("[Delete]", dele)
4267 :: ("[Edit]", edit conf
.annotinline
)
4269 :: split [] 0 0 |> List.rev
|> Array.of_list
4276 let s = getannotcontents
opaque slinkindex
in
4279 let source = (msgsource :> lvsource
) in
4280 let modehash = findkeyhash conf
"listview" in
4281 state
.uioh <- coe (object
4282 inherit listview ~zebra
:false ~helpmode
:false
4283 ~
source ~trusted
:false ~
modehash
4285 G.postRedisplay "enterannotmode";
4288 let gotounder under =
4289 let getpath filename
=
4291 if nonemptystr filename
4293 if Filename.is_relative filename
4295 let dir = Filename.dirname state
.path in
4297 if Filename.is_implicit
dir
4298 then Filename.concat
(Sys.getcwd
()) dir
4301 Filename.concat
dir filename
4305 if Sys.file_exists
path
4310 | Ulinkgoto
(pageno, top) ->
4315 if conf
.presentation
&& conf
.coarseprespos
4319 gotopage1 pageno top;
4322 | Ulinkuri
s -> gotouri
s
4324 | Uremote
(filename
, pageno) ->
4325 let path = getpath filename
in
4330 let command = Printf.sprintf
"%s -page %d %S" !selfexec pageno path in
4331 match spawn
command [] with
4333 | (exception exn
) ->
4334 dolog
"failed to execute `%s': %s" command @@ exntos exn
4336 let anchor = getanchor
() in
4337 let ranchor = state
.path, state
.password, anchor, state
.origin
in
4338 state
.origin
<- E.s;
4339 state
.anchor <- (pageno, 0.0, 0.0);
4340 state
.ranchors
<- ranchor :: state
.ranchors
;
4343 else impmsg "cannot find %s" filename
4345 | Uremotedest
(filename
, destname
) ->
4346 let path = getpath filename
in
4351 let command = !selfexec ^
" " ^
path ^
" -dest " ^ destname
in
4352 match spawn
command [] with
4353 | (exception exn
) ->
4354 dolog
"failed to execute `%s': %s" command @@ exntos exn
4357 let anchor = getanchor
() in
4358 let ranchor = state
.path, state
.password, anchor, state
.origin
in
4359 state
.origin
<- E.s;
4360 state
.nameddest
<- destname
;
4361 state
.ranchors
<- ranchor :: state
.ranchors
;
4364 else impmsg "cannot find %s" filename
4366 | Uunexpected
_ | Ulaunch
_ | Unamed
_ | Utext
_ | Unone
-> ()
4367 | Uannotation
(opaque, slinkindex
) -> enterannotmode opaque slinkindex
4370 let gotooutline (_, _, kind
) =
4374 let (pageno, y, _) = anchor in
4376 (if conf
.presentation
then (pageno, y, 1.0) else anchor)
4380 | Ouri
uri -> gotounder (Ulinkuri
uri)
4381 | Olaunch cmd
-> gotounder (Ulaunch cmd
)
4382 | Oremote remote
-> gotounder (Uremote remote
)
4383 | Ohistory hist
-> gotohist hist
4384 | Oremotedest remotedest
-> gotounder (Uremotedest remotedest
)
4387 class outlinesoucebase fetchoutlines
= object (self)
4388 inherit lvsourcebase
4389 val mutable m_items
= E.a
4390 val mutable m_minfo
= E.a
4391 val mutable m_orig_items
= E.a
4392 val mutable m_orig_minfo
= E.a
4393 val mutable m_narrow_patterns
= []
4394 val mutable m_gen
= -1
4396 method getitemcount
= Array.length m_items
4399 let s, n, _ = m_items
.(n) in
4402 method exit ~
(uioh:uioh) ~cancel ~
active ~
(first:int) ~pan
:
4404 ignore
(uioh, first);
4406 if m_narrow_patterns
= []
4407 then m_orig_items
, m_orig_minfo
4408 else m_items
, m_minfo
4415 gotooutline m_items
.(active);
4423 method hasaction
(_:int) = true
4426 if Array.length m_items
!= Array.length m_orig_items
4429 match m_narrow_patterns
with
4431 | many
-> String.concat
"@Uellipsis" (List.rev many
)
4433 "Narrowed to " ^
s ^
" (ctrl-u to restore)"
4437 match m_narrow_patterns
with
4440 | head
:: _ -> "@Uellipsis" ^ head
4442 method narrow
pattern =
4443 match Str.regexp_case_fold
pattern with
4444 | (exception _) -> ()
4446 let rec loop accu minfo n =
4449 m_items
<- Array.of_list
accu;
4450 m_minfo
<- Array.of_list
minfo;
4453 let (s, _, _) as o = m_items
.(n) in
4455 match Str.search_forward re
s 0 with
4456 | (exception Not_found
) -> accu, minfo
4457 | first -> o :: accu, (first, Str.match_end
()) :: minfo
4459 loop accu minfo (n-1)
4461 loop [] [] (Array.length m_items
- 1)
4463 method! getminfo
= m_minfo
4466 m_orig_items
<- fetchoutlines
();
4467 m_minfo
<- m_orig_minfo
;
4468 m_items
<- m_orig_items
4470 method add_narrow_pattern
pattern =
4471 m_narrow_patterns
<- pattern :: m_narrow_patterns
4473 method del_narrow_pattern
=
4474 match m_narrow_patterns
with
4475 | _ :: rest
-> m_narrow_patterns
<- rest
4480 match m_narrow_patterns
with
4481 | pattern :: [] -> self#narrow
pattern; pattern
4483 List.fold_left
(fun accu pattern ->
4484 self#narrow
pattern;
4485 pattern ^
"@Uellipsis" ^
accu) E.s list
4487 method calcactive
(_:anchor) = 0
4489 method reset
anchor items =
4490 if state
.gen
!= m_gen
4492 m_orig_items
<- items;
4494 m_narrow_patterns
<- [];
4496 m_orig_minfo
<- E.a;
4500 if items != m_orig_items
4502 m_orig_items
<- items;
4503 if m_narrow_patterns
== []
4504 then m_items
<- items;
4507 let active = self#calcactive
anchor in
4509 m_first
<- firstof m_first
active
4513 let outlinesource fetchoutlines
=
4515 inherit outlinesoucebase fetchoutlines
4516 method! calcactive
anchor =
4517 let rely = getanchory anchor in
4518 let rec loop n best bestd
=
4519 if n = Array.length m_items
4522 let _, _, kind
= m_items
.(n) in
4525 let orely = getanchory anchor in
4526 let d = abs
(orely - rely) in
4529 else loop (n+1) best bestd
4530 | Onone
| Oremote
_ | Olaunch
_
4531 | Oremotedest
_ | Ouri
_ | Ohistory
_ ->
4532 loop (n+1) best bestd
4538 let enteroutlinemode, enterbookmarkmode
, enterhistmode
=
4539 let mkselector sourcetype
=
4540 let fetchoutlines () =
4541 match sourcetype
with
4542 | `bookmarks
-> Array.of_list state
.bookmarks
4543 | `outlines
-> state
.outlines
4544 | `history
-> genhistoutlines ()
4547 if sourcetype
= `history
4548 then new outlinesoucebase
fetchoutlines
4549 else outlinesource fetchoutlines
4552 let outlines = fetchoutlines () in
4553 if Array.length
outlines = 0
4555 showtext ' ' errmsg
;
4559 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
4560 let anchor = getanchor
() in
4561 source#reset
anchor outlines;
4562 state
.text <- source#greetmsg
;
4564 coe (new outlinelistview ~zebra
:(sourcetype
=`history
) ~
source);
4565 G.postRedisplay "enter selector";
4568 let mkenter sourcetype errmsg
=
4569 let enter = mkselector sourcetype
in
4570 fun () -> enter errmsg
4572 (**)mkenter `
outlines "document has no outline"
4573 , mkenter `bookmarks
"document has no bookmarks (yet)"
4574 , mkenter `history
"history is empty"
4577 let quickbookmark ?title
() =
4578 match state
.layout with
4584 let tm = Unix.localtime
(now
()) in
4586 "Quick (page %d) (bookmarked at %02d/%02d/%d %02d:%02d)"
4590 (tm.Unix.tm_year
+ 1900)
4593 | Some
title -> title
4595 state
.bookmarks
<- (title, 0, Oanchor
(getanchor1
l)) :: state
.bookmarks
4598 let setautoscrollspeed step goingdown
=
4599 let incr = max
1 ((abs step
) / 2) in
4600 let incr = if goingdown
then incr else -incr in
4601 let astep = boundastep state
.winh
(step
+ incr) in
4602 state
.autoscroll
<- Some
astep;
4606 match conf
.columns
with
4608 | Csingle
_ | Cmulti
_ -> state
.x != 0 || conf
.zoom > 1.0
4611 let panbound x = bound
x (-state
.w) (wadjsb () + state
.winw
);;
4613 let existsinrow pageno (columns
, coverA
, coverB
) p =
4614 let last = ((pageno - coverA
) mod columns
) + columns
in
4615 let rec any = function
4618 if l.pageno = coverA
- 1 || l.pageno = state
.pagecount
- coverB
4622 then (if l.pageno = last then false else any rest
)
4630 match state
.layout with
4632 let pageno = page_of_y state
.y in
4633 gotoghyll (getpagey
(pageno+1))
4635 match conf
.columns
with
4637 if conf
.presentation
&& rest
== [] && l.pageh
> l.pagey + l.pagevh
4639 let y = clamp (pgscale state
.winh
) in
4642 let pageno = min
(l.pageno+1) (state
.pagecount
-1) in
4643 gotoghyll (getpagey
pageno)
4644 | Cmulti
((c, _, _) as cl
, _) ->
4645 if conf
.presentation
4646 && (existsinrow l.pageno cl
4647 (fun l -> l.pageh
> l.pagey + l.pagevh))
4649 let y = clamp (pgscale state
.winh
) in
4652 let pageno = min
(l.pageno+c) (state
.pagecount
-1) in
4653 gotoghyll (getpagey
pageno)
4655 if l.pageno < state
.pagecount
- 1 || l.pagecol
< n - 1
4657 let pagey, pageh
= getpageyh
l.pageno in
4658 let pagey = pagey + pageh
* l.pagecol
in
4659 let ips = if l.pagecol
= 0 then 0 else conf
.interpagespace
in
4660 gotoghyll (pagey + pageh
+ ips)
4664 match state
.layout with
4666 let pageno = page_of_y state
.y in
4667 gotoghyll (getpagey
(pageno-1))
4669 match conf
.columns
with
4671 if conf
.presentation
&& l.pagey != 0
4673 gotoghyll (clamp (pgscale ~
-(state
.winh
)))
4675 let pageno = max
0 (l.pageno-1) in
4676 gotoghyll (getpagey
pageno)
4677 | Cmulti
((c, _, coverB
) as cl
, _) ->
4678 if conf
.presentation
&&
4679 (existsinrow l.pageno cl
(fun l -> l.pagey != 0))
4681 gotoghyll (clamp (pgscale ~
-(state
.winh
)))
4684 if l.pageno = state
.pagecount
- coverB
4688 let pageno = max
0 (l.pageno-decr) in
4689 gotoghyll (getpagey
pageno)
4697 let pageno = max
0 (l.pageno-1) in
4698 let pagey, pageh
= getpageyh
pageno in
4701 let pagey, pageh
= getpageyh
l.pageno in
4702 pagey + pageh
* (l.pagecol
-1) - conf
.interpagespace
4708 if emptystr conf
.savecmd
4709 then error
"don't know where to save modified document"
4711 let savecmd = Str.global_replace percentsre state
.path conf
.savecmd in
4714 (fun s -> error
"failed to obtain path to the saved copy: %s" s)
4719 let tmp = path ^
".tmp" in
4721 Unix.rename
tmp path;
4724 let viewkeyboard key mask
=
4726 let mode = state
.mode in
4727 state
.mode <- Textentry
(te, fun _ -> state
.mode <- mode);
4730 G.postRedisplay "view:enttext"
4732 let ctrl = Wsi.withctrl mask
in
4733 let key = Wsi.keypadtodigitkey
key in
4738 if hasunsavedchanges
()
4742 if conf
.angle
mod 360 = 0 && not
(isbirdseye state
.mode)
4744 state
.mode <- LinkNav
(Ltgendir
0);
4745 gotoxy state
.x state
.y;
4747 else impmsg "keyboard link navigation does not work under rotation"
4750 begin match state
.mstate
with
4753 G.postRedisplay "kill rect";
4756 | Mscrolly
| Mscrollx
4759 begin match state
.mode with
4762 G.postRedisplay "esc leave linknav"
4766 match state
.ranchors
with
4768 | (path, password, anchor, origin
) :: rest
->
4769 state
.ranchors
<- rest
;
4770 state
.anchor <- anchor;
4771 state
.origin
<- origin
;
4772 state
.nameddest
<- E.s;
4773 opendoc path password
4778 gotoghyll (getnav ~
-1)
4789 Hashtbl.iter
(fun _ opaque ->
4791 Hashtbl.clear state
.prects
) state
.pagemap
;
4792 G.postRedisplay "dehighlight";
4794 | @slash
| @question
->
4795 let ondone isforw
s =
4796 cbput state
.hists
.pat
s;
4797 state
.searchpattern
<- s;
4800 let s = String.make
1 (Char.chr
key) in
4801 enttext (s, E.s, Some
(onhist state
.hists
.pat
),
4802 textentry, ondone (key = @slash
), true)
4804 | @plus
| @kpplus
| @equals
when ctrl ->
4805 let incr = if conf
.zoom +. 0.01 > 0.1 then 0.1 else 0.01 in
4806 pivotzoom (conf
.zoom +. incr)
4808 | @plus
| @kpplus
->
4811 try int_of_string
s with exn
->
4812 state
.text <- Printf.sprintf
"bad integer `%s': %s" s @@ exntos exn
;
4818 state
.text <- "page bias is now " ^ string_of_int
n;
4821 enttext ("page bias: ", E.s, None
, intentry, ondone, true)
4823 | @minus
| @kpminus
when ctrl ->
4824 let decr = if conf
.zoom -. 0.1 < 0.1 then 0.01 else 0.1 in
4825 pivotzoom (max
0.01 (conf
.zoom -. decr))
4827 | @minus
| @kpminus
->
4828 let ondone msg
= state
.text <- msg
in
4830 "option [acfhilpstvxACFPRSZTISM]: ", E.s, None
,
4831 optentry state
.mode, ondone, true
4836 then gotoxy 0 state
.y
4839 | (@1 | @2) when ctrl && conf
.fitmodel
!= FitPage
-> (* ctrl-1/2 *)
4841 match conf
.columns
with
4842 | Csingle
_ | Cmulti
_ -> 1
4843 | Csplit
(n, _) -> n
4845 let h = state
.winh
-
4846 conf
.interpagespace
lsl (if conf
.presentation
then 1 else 0)
4848 let zoom = zoomforh state
.winw
h (vscrollw ()) cols in
4849 if zoom > 0.0 && (key = @2 || zoom < 1.0)
4854 match conf
.fitmodel
with
4855 | FitWidth
-> FitProportional
4856 | FitProportional
-> FitPage
4857 | FitPage
-> FitWidth
4859 state
.text <- "fit model: " ^
FMTE.to_string
fm;
4860 reqlayout conf
.angle
fm
4862 | @4 when ctrl -> (* ctrl-4 *)
4863 let zoom = getmaxw
() /. float state
.winw
in
4864 if zoom > 0.0 then setzoom zoom
4872 | (48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57)
4873 when not
ctrl -> (* 0..9 *)
4876 try int_of_string
s with exn
->
4877 state
.text <- Printf.sprintf
"bad integer `%s': %s" s @@ exntos exn
;
4883 cbput state
.hists
.pag
(string_of_int
n);
4884 gotopage1 (n + conf
.pagebias
- 1) 0;
4887 let pageentry text key =
4888 match Char.unsafe_chr
key with
4889 | '
g'
-> TEdone
text
4890 | _ -> intentry text key
4892 let text = String.make
1 (Char.chr
key) in
4893 enttext (":", text, Some
(onhist state
.hists
.pag
),
4894 pageentry, ondone, true)
4897 conf
.scrollb
<- if conf
.scrollb
= 0 then (scrollbvv
lor scrollbhv
) else 0;
4898 reshape state
.winw state
.winh
;
4901 state
.bzoom
<- not state
.bzoom
;
4903 showtext ' '
("block zoom " ^
if state
.bzoom
then "on" else "off")
4906 conf
.hlinks
<- not conf
.hlinks
;
4907 state
.text <- "highlightlinks " ^
if conf
.hlinks
then "on" else "off";
4908 G.postRedisplay "toggle highlightlinks";
4911 if conf
.angle
mod 360 = 0
4913 state
.glinks
<- true;
4914 let mode = state
.mode in
4917 (":", E.s, None
, linknentry, linknact gotounder, false),
4919 state
.glinks
<- false;
4923 G.postRedisplay "view:linkent(F)"
4925 else impmsg "hint mode does not work under rotation"
4928 state
.glinks
<- true;
4929 let mode = state
.mode in
4930 state
.mode <- Textentry
(
4932 ":", E.s, None
, linknentry, linknact (fun under ->
4933 selstring (undertext under);
4937 state
.glinks
<- false;
4941 G.postRedisplay "view:linkent"
4944 begin match state
.autoscroll
with
4946 conf
.autoscrollstep
<- step
;
4947 state
.autoscroll
<- None
4949 if conf
.autoscrollstep
= 0
4950 then state
.autoscroll
<- Some
1
4951 else state
.autoscroll
<- Some conf
.autoscrollstep
4955 launchpath () (* XXX where do error messages go? *)
4958 setpresentationmode (not conf
.presentation
);
4959 showtext ' '
("presentation mode " ^
4960 if conf
.presentation
then "on" else "off");
4963 if List.mem
Wsi.Fullscreen state
.winstate
4964 then Wsi.reshape conf
.cwinw conf
.cwinh
4965 else Wsi.fullscreen
()
4968 search state
.searchpattern
false
4971 search state
.searchpattern
true
4974 begin match state
.layout with
4977 gotoghyll (getpagey
l.pageno)
4983 | @delete
| @kpdelete
-> (* delete *)
4987 showtext ' '
(describe_location ());
4990 begin match state
.layout with
4993 Wsi.reshape (l.pagew
+ vscrollw ()) l.pageh
;
4998 enterbookmarkmode
()
5006 | @e when Buffer.length state
.errmsgs
> 0 ->
5011 match state
.layout with
5016 (s, 0, Oanchor
(getanchor1
l)) :: state
.bookmarks
5019 enttext ("bookmark: ", E.s, None
, textentry, ondone, true)
5023 showtext ' '
"Quick bookmark added";
5026 begin match state
.layout with
5028 let rect = getpdimrect
l.pagedimno
in
5032 (truncate
(1.8 *. (rect.(1) -. rect.(0))),
5033 truncate
(1.2 *. (rect.(3) -. rect.(0))))
5035 (truncate
(rect.(1) -. rect.(0)),
5036 truncate
(rect.(3) -. rect.(0)))
5038 let w = truncate
((float w)*.conf
.zoom)
5039 and h = truncate
((float h)*.conf
.zoom) in
5042 state
.anchor <- getanchor
();
5043 Wsi.reshape (w + vscrollw ()) (h + conf
.interpagespace
)
5045 G.postRedisplay "z";
5050 | @x -> state
.roam
()
5053 reqlayout (conf
.angle
+
5054 (if key = @Gt
then 30 else -30)) conf
.fitmodel
5058 bound
(conf
.colorscale
+. (if key = 93 then 0.1 else -0.1)) 0.0 1.0
5060 G.postRedisplay "brightness";
5062 | @c when state
.mode = View
->
5067 let m = (wadjsb () + state
.winw
- state
.w) / 2 in
5068 gotoxy_and_clear_text m state
.y
5072 match state
.prevcolumns
with
5073 | None
-> (1, 0, 0), 1.0
5074 | Some
(columns
, z
) ->
5077 | Csplit
(c, _) -> -c, 0, 0
5078 | Cmulti
((c, a, b), _) -> c, a, b
5079 | Csingle
_ -> 1, 0, 0
5083 setcolumns View
c a b;
5086 | @down
| @up
when ctrl && Wsi.withshift mask
->
5087 let zoom, x = state
.prevzoom
in
5091 | @k
| @up
| @kpup
->
5092 begin match state
.autoscroll
with
5094 begin match state
.mode with
5095 | Birdseye beye
-> upbirdseye 1 beye
5100 then gotoxy_and_clear_text state
.x (clamp ~
-(state
.winh
/2))
5102 if not
(Wsi.withshift mask
) && conf
.presentation
5104 else gotoghyll1 true (clamp (-conf
.scrollstep
))
5108 setautoscrollspeed n false
5111 | @j
| @down
| @kpdown
->
5112 begin match state
.autoscroll
with
5114 begin match state
.mode with
5115 | Birdseye beye
-> downbirdseye 1 beye
5120 then gotoxy_and_clear_text state
.x (clamp (state
.winh
/2))
5122 if not
(Wsi.withshift mask
) && conf
.presentation
5124 else gotoghyll1 true (clamp (conf
.scrollstep
))
5128 setautoscrollspeed n true
5131 | @left | @right
| @kpleft
| @kpright
when not
(Wsi.withalt mask
) ->
5137 else conf
.hscrollstep
5139 let dx = if key = @left || key = @kpleft
then dx else -dx in
5140 gotoxy_and_clear_text (panbound (state
.x + dx)) state
.y
5143 G.postRedisplay "left/right"
5146 | @prior
| @kpprior
->
5150 match state
.layout with
5152 | l :: _ -> state
.y - l.pagey
5154 clamp (pgscale (-state
.winh
))
5158 | @next | @kpnext
->
5162 match List.rev state
.layout with
5164 | l :: _ -> getpagey
l.pageno
5166 clamp (pgscale state
.winh
)
5170 | @g | @home
| @kphome
->
5173 | @G
| @jend
| @kpend
->
5175 gotoghyll (clamp state
.maxy)
5177 | @right
| @kpright
when Wsi.withalt mask
->
5178 gotoghyll (getnav 1)
5179 | @left | @kpleft
when Wsi.withalt mask
->
5180 gotoghyll (getnav ~
-1)
5185 | @v when conf
.debug
->
5188 match getopaque l.pageno with
5191 let x0, y0, x1, y1 = pagebbox
opaque in
5192 let rect = (float x0, float y0,
5195 float x0, float y1) in
5197 let color = (0.0, 0.0, 1.0 /. (l.pageno mod 3 |> float), 0.5) in
5198 state
.rects
<- (l.pageno, color, rect) :: state
.rects
;
5200 G.postRedisplay "v";
5203 let mode = state
.mode in
5204 let cmd = ref E.s in
5205 let onleave = function
5206 | Cancel
-> state
.mode <- mode
5209 match getopaque l.pageno with
5210 | Some
opaque -> pipesel opaque !cmd
5211 | None
-> ()) state
.layout;
5215 cbput state
.hists
.sel
s;
5219 "| ", !cmd, Some
(onhist state
.hists
.sel
), textentry, ondone, true
5221 G.postRedisplay "|";
5222 state
.mode <- Textentry
(te, onleave);
5225 vlog "huh? %s" (Wsi.keyname
key)
5228 let linknavkeyboard key mask
linknav =
5229 let getpage pageno =
5230 let rec loop = function
5232 | l :: _ when l.pageno = pageno -> Some
l
5233 | _ :: rest
-> loop rest
5234 in loop state
.layout
5236 let doexact (pageno, n) =
5237 match getopaque pageno, getpage pageno with
5238 | Some
opaque, Some
l ->
5239 if key = @enter || key = @kpenter
5241 let under = getlink
opaque n in
5242 G.postRedisplay "link gotounder";
5249 Some
(findlink
opaque LDfirst
), -1
5252 Some
(findlink
opaque LDlast
), 1
5255 Some
(findlink
opaque (LDleft
n)), -1
5258 Some
(findlink
opaque (LDright
n)), 1
5261 Some
(findlink
opaque (LDup
n)), -1
5264 Some
(findlink
opaque (LDdown
n)), 1
5269 begin match findpwl
l.pageno dir with
5273 state
.mode <- LinkNav
(Ltgendir
dir);
5274 let y, h = getpageyh
pageno in
5277 then y + h - state
.winh
5282 begin match getopaque pageno, getpage pageno with
5283 | Some
opaque, Some
_ ->
5285 let ld = if dir > 0 then LDfirst
else LDlast
in
5288 begin match link with
5290 showlinktype (getlink
opaque m);
5291 state
.mode <- LinkNav
(Ltexact
(pageno, m));
5292 G.postRedisplay "linknav jpage";
5293 | Lnotfound
-> notfound dir
5299 begin match opt with
5300 | Some Lnotfound
-> pwl l dir;
5301 | Some
(Lfound
m) ->
5305 let _, y0, _, y1 = getlinkrect
opaque m in
5307 then gotopage1 l.pageno y0
5309 let d = fstate
.fontsize
+ 1 in
5310 if y1 - l.pagey > l.pagevh - d
5311 then gotopage1 l.pageno (y1 - state
.winh
- hscrollh () + d)
5312 else G.postRedisplay "linknav";
5314 showlinktype (getlink
opaque m);
5315 state
.mode <- LinkNav
(Ltexact
(l.pageno, m));
5318 | None
-> viewkeyboard key mask
5320 | _ -> viewkeyboard key mask
5325 G.postRedisplay "leave linknav"
5329 | Ltgendir
_ | Ltnotready
_ -> viewkeyboard key mask
5330 | Ltexact exact
-> doexact exact
5333 let keyboard key mask
=
5334 if (key = @g && Wsi.withctrl mask
) && not
(istextentry state
.mode)
5335 then wcmd "interrupt"
5336 else state
.uioh <- state
.uioh#
key key mask
5339 let birdseyekeyboard key mask
5340 ((oconf
, leftx
, pageno, hooverpageno
, anchor) as beye
) =
5342 match conf
.columns
with
5344 | Cmulti
((c, _, _), _) -> c
5345 | Csplit
_ -> failwith
"bird's eye split mode"
5347 let pgh layout = List.fold_left
5348 (fun m l -> max
l.pageh
m) state
.winh
layout in
5350 | @l when Wsi.withctrl mask
->
5351 let y, h = getpageyh
pageno in
5352 let top = (state
.winh
- h) / 2 in
5353 gotoxy state
.x (max
0 (y - top))
5354 | @enter | @kpenter
-> leavebirdseye beye
false
5355 | @escape
-> leavebirdseye beye
true
5356 | @up
-> upbirdseye incr beye
5357 | @down
-> downbirdseye incr beye
5358 | @left -> upbirdseye 1 beye
5359 | @right
-> downbirdseye 1 beye
5362 begin match state
.layout with
5366 state
.mode <- Birdseye
(
5367 oconf
, leftx
, l.pageno, hooverpageno
, anchor
5369 gotopage1 l.pageno 0;
5372 let layout = layout state
.x (state
.y-state
.winh
)
5374 (pgh state
.layout) in
5376 | [] -> gotoxy state
.x (clamp (-state
.winh
))
5378 state
.mode <- Birdseye
(
5379 oconf
, leftx
, l.pageno, hooverpageno
, anchor
5381 gotopage1 l.pageno 0
5384 | [] -> gotoxy state
.x (clamp (-state
.winh
))
5388 begin match List.rev state
.layout with
5390 let layout = layout state
.x
5391 (state
.y + (pgh state
.layout))
5392 state
.winw state
.winh
in
5393 begin match layout with
5395 let incr = l.pageh
- l.pagevh in
5400 oconf
, leftx
, state
.pagecount
- 1, hooverpageno
, anchor
5402 G.postRedisplay "birdseye pagedown";
5404 else gotoxy state
.x (clamp (incr + conf
.interpagespace
*2));
5408 Birdseye
(oconf
, leftx
, l.pageno, hooverpageno
, anchor);
5409 gotopage1 l.pageno 0;
5412 | [] -> gotoxy state
.x (clamp state
.winh
)
5416 state
.mode <- Birdseye
(oconf
, leftx
, 0, hooverpageno
, anchor);
5420 let pageno = state
.pagecount
- 1 in
5421 state
.mode <- Birdseye
(oconf
, leftx
, pageno, hooverpageno
, anchor);
5422 if not
(pagevisible state
.layout pageno)
5425 match List.rev state
.pdims
with
5427 | (_, _, h, _) :: _ -> h
5431 (max
0 (getpagey
pageno - (state
.winh
- h - conf
.interpagespace
)))
5432 else G.postRedisplay "birdseye end";
5434 | _ -> viewkeyboard key mask
5439 match state
.mode with
5440 | Textentry
_ -> scalecolor 0.4
5442 | View
-> scalecolor 1.0
5443 | Birdseye
(_, _, pageno, hooverpageno
, _) ->
5444 if l.pageno = hooverpageno
5447 if l.pageno = pageno
5449 let c = scalecolor 1.0 in
5451 GlDraw.line_width
3.0;
5452 let dispx = xadjsb () + l.pagedispx in
5454 (float (dispx-1)) (float (l.pagedispy-1))
5455 (float (dispx+l.pagevw+1))
5456 (float (l.pagedispy+l.pagevh+1))
5458 GlDraw.line_width
1.0;
5467 let postdrawpage l linkindexbase
=
5468 match getopaque l.pageno with
5470 if tileready l l.pagex
l.pagey
5472 let x = l.pagedispx - l.pagex
+ xadjsb ()
5473 and y = l.pagedispy - l.pagey in
5475 match conf
.columns
with
5476 | Csingle
_ | Cmulti
_ ->
5477 (if conf
.hlinks
then 1 else 0)
5479 && not
(isbirdseye state
.mode) then 2 else 0)
5483 match state
.mode with
5484 | Textentry
((_, s, _, _, _, _), _) when state
.glinks
-> s
5490 Hashtbl.find_all state
.prects
l.pageno |>
5491 List.iter
(fun vals
-> drawprect
opaque x y vals
);
5492 let n = postprocess
opaque hlmask x y (linkindexbase
, s, conf
.hfsize
) in
5494 then (state
.redisplay
<- true; 0)
5500 let scrollindicator () =
5501 let sbw, ph
, sh = state
.uioh#
scrollph in
5502 let sbh, pw, sw = state
.uioh#scrollpw
in
5507 else ((state
.winw
- sbw), state
.winw
, 0)
5510 GlDraw.color (0.64, 0.64, 0.64);
5511 filledrect (float x0) 0. (float x1) (float state
.winh
);
5513 (float hx0
) (float (state
.winh
- sbh))
5514 (float (hx0
+ wadjsb () + state
.winw
)) (float state
.winh
)
5516 GlDraw.color (0.0, 0.0, 0.0);
5518 filledrect (float x0) ph
(float x1) (ph
+. sh);
5519 let pw = pw +. float hx0
in
5520 filledrect pw (float (state
.winh
- sbh)) (pw +. sw) (float state
.winh
);
5524 match state
.mstate
with
5525 | Mnone
| Mscrolly
| Mscrollx
| Mpan
_ | Mzoom
_ | Mzoomrect
_ ->
5528 | Msel
((x0, y0), (x1, y1)) ->
5529 let identify opaque l px py = Some
(opaque, l.pageno, px, py) in
5530 let o0,n0
,px0
,py0
= onppundermouse identify x0 y0 (~
< E.s, -1, 0, 0) in
5531 let _o1,n1
,px1
,py1
= onppundermouse identify x1 y1 (~
< E.s, -1, 0, 0) in
5532 if n0
!= -1 && n0
= n1
then seltext
o0 (px0
, py0
, px1
, py1
);
5535 let showrects = function [] -> () | rects
->
5537 GlDraw.color (0.0, 0.0, 1.0) ~
alpha:0.5;
5538 GlFunc.blend_func ~
src:`src_alpha ~dst
:`one_minus_src_alpha
;
5540 (fun (pageno, c, (x0, y0, x1, y1, x2
, y2
, x3
, y3
)) ->
5542 if l.pageno = pageno
5544 let dx = float (l.pagedispx - l.pagex
) in
5545 let dy = float (l.pagedispy - l.pagey) in
5546 let r, g, b, alpha = c in
5547 GlDraw.color (r, g, b) ~
alpha;
5548 filledrect2 (x0+.dx) (y0+.dy)
5560 begin match conf
.columns
, state
.layout with
5561 | Csingle
_, _ :: _ ->
5562 GlDraw.color (scalecolor2 conf
.bgcolor
);
5564 List.fold_left
(fun y l ->
5567 let x1 = l.pagedispx + xadjsb () in
5568 let y1 = (l.pagedispy + l.pagevh) in
5569 filledrect (float x0) (float y0) (float x1) (float y1);
5570 let x0 = x1 + l.pagevw in
5571 let x1 = state
.winw
in
5572 filledrect1 (float x0) (float y0) (float x1) (float y1);
5576 and x1 = state
.winw
in
5578 and y1 = l.pagedispy in
5579 filledrect1 (float x0) (float y0) (float x1) (float y1);
5581 l.pagedispy + l.pagevh) 0 state
.layout
5584 and x1 = state
.winw
in
5586 and y1 = state
.winh
in
5587 filledrect1 (float x0) (float y0) (float x1) (float y1)
5588 | (Cmulti
_ | Csplit
_), _ | Csingle
_, [] ->
5589 GlClear.color (scalecolor2 conf
.bgcolor
);
5590 GlClear.clear
[`
color];
5592 List.iter
drawpage state
.layout;
5594 match state
.mode with
5595 | LinkNav
(Ltexact
(pageno, linkno
)) ->
5596 begin match getopaque pageno with
5598 let dx = xadjsb () in
5599 let x0, y0, x1, y1 = getlinkrect
opaque linkno
in
5600 let x0 = x0 + dx and x1 = x1 + dx in
5601 let color = (0.0, 0.0, 0.5, 0.5) in
5608 | None
-> state
.rects
5610 | LinkNav
(Ltgendir
_) | LinkNav
(Ltnotready
_)
5613 | View
-> state
.rects
5616 let rec postloop linkindexbase
= function
5618 let linkindexbase = linkindexbase + postdrawpage l linkindexbase in
5619 postloop linkindexbase rest
5623 postloop 0 state
.layout;
5625 begin match state
.mstate
with
5626 | Mzoomrect
((x0, y0), (x1, y1)) ->
5628 GlDraw.color (0.3, 0.3, 0.3) ~
alpha:0.5;
5629 GlFunc.blend_func ~
src:`src_alpha ~dst
:`one_minus_src_alpha
;
5630 filledrect (float x0) (float y0) (float x1) (float y1);
5634 | Mscrolly
| Mscrollx
5643 let zoomrect x y x1 y1 =
5646 and y0 = min
y y1 in
5647 let zoom = (float state
.w) /. float (x1 - x0) in
5650 let adjw = wadjsb () + state
.winw
in
5652 then (adjw - state
.w) / 2
5655 match conf
.fitmodel
with
5656 | FitWidth
| FitProportional
-> simple ()
5658 match conf
.columns
with
5660 onppundermouse (fun _ l _ _ -> Some
l.pagedispx) x0 y0 x0
5661 | Cmulti
_ | Csingle
_ -> simple ()
5663 gotoxy ((state
.x + margin) - x0) (state
.y + y0);
5664 state
.anchor <- getanchor
();
5669 let annot inline
x y =
5670 match unproject x y with
5671 | Some
(opaque, n, ux
, uy
) ->
5673 addannot
opaque ux uy
text;
5674 wcmd "freepage %s" (~
> opaque);
5675 Hashtbl.remove state
.pagemap
(n, state
.gen
);
5677 gotoxy state
.x state
.y
5681 let ondone s = add s in
5682 let mode = state
.mode in
5683 state
.mode <- Textentry
(
5684 ("annotation: ", E.s, None
, textentry, ondone, true),
5685 fun _ -> state
.mode <- mode);
5688 G.postRedisplay "annot"
5690 add @@ getusertext E.s
5695 let g opaque l px py =
5696 match rectofblock
opaque px py with
5698 let x0 = a.(0) -. 20. in
5699 let x1 = a.(1) +. 20. in
5700 let y0 = a.(2) -. 20. in
5701 let zoom = (float state
.w) /. (x1 -. x0) in
5702 let pagey = getpagey
l.pageno in
5703 let margin = (state
.w - l.pagew
)/2 in
5704 let nx = -truncate
x0 - margin in
5705 gotoxy_and_clear_text nx (pagey + truncate
y0);
5706 state
.anchor <- getanchor
();
5711 match conf
.columns
with
5713 impmsg "block zooming does not work properly in split columns mode"
5714 | Cmulti
_ | Csingle
_ -> onppundermouse g x y ()
5718 let winw = wadjsb () + state
.winw - 1 in
5719 let s = float x /. float winw in
5720 let destx = truncate
(float (state
.w + winw) *. s) in
5721 gotoxy_and_clear_text (winw - destx) state
.y;
5722 state
.mstate
<- Mscrollx
;
5726 let s = float y /. float state
.winh
in
5727 let desty = truncate
(float (state
.maxy - state
.winh
) *. s) in
5728 gotoxy_and_clear_text state
.x desty;
5729 state
.mstate
<- Mscrolly
;
5732 let viewmulticlick clicks
x y mask
=
5733 let g opaque l px py =
5741 if markunder
opaque px py mark
5745 match getopaque l.pageno with
5747 | Some
opaque -> pipesel opaque cmd
5749 state
.roam
<- (fun () -> dopipe conf
.paxcmd
);
5750 if not
(Wsi.withctrl mask
) then dopipe conf
.selcmd
;
5755 G.postRedisplay "viewmulticlick";
5756 onppundermouse g x y (fun () -> impmsg "nothing to select") ();
5760 match conf
.columns
with
5762 | Csingle
_ | Cmulti
_ -> conf
.angle
mod 360 = 0
5765 let viewmouse button down
x y mask
=
5767 | n when (n == 4 || n == 5) && not down
->
5768 if Wsi.withctrl mask
5770 match state
.mstate
with
5771 | Mzoom
(oldn
, i
) ->
5779 if conf
.zoom +. 0.01 > 0.1 then 0.1 else 0.01
5781 if conf
.zoom -. 0.1 < 0.1 then -0.01 else -0.1
5783 let zoom = conf
.zoom -. incr in
5784 pivotzoom ~
x ~
y zoom;
5785 state
.mstate
<- Mzoom
(n, 0);
5787 state
.mstate
<- Mzoom
(n, i
+1);
5789 else state
.mstate
<- Mzoom
(n, 0)
5793 | Mscrolly
| Mscrollx
5795 | Mnone
-> state
.mstate
<- Mzoom
(n, 0)
5798 match state
.autoscroll
with
5799 | Some step
-> setautoscrollspeed step
(n=4)
5801 if conf
.wheelbypage
|| conf
.presentation
5810 then -conf
.scrollstep
5811 else conf
.scrollstep
5813 let incr = incr * 2 in
5814 let y = clamp incr in
5815 gotoxy_and_clear_text state
.x y
5818 | n when (n = 6 || n = 7) && not down
&& canpan () ->
5820 panbound (state
.x + (if n = 7 then -2 else 2) * conf
.hscrollstep
) in
5821 gotoxy_and_clear_text x state
.y
5823 | 1 when Wsi.withshift mask
->
5824 state
.mstate
<- Mnone
;
5827 match unproject x y with
5829 | Some
(_, pageno, ux
, uy
) ->
5830 let cmd = Printf.sprintf
5832 conf
.stcmd state
.path pageno ux uy
5834 match spawn
cmd [] with
5835 | (exception exn
) ->
5836 impmsg "execution of synctex command(%S) failed: %S"
5837 conf
.stcmd
@@ exntos exn
5841 | 1 when Wsi.withctrl mask
->
5844 Wsi.setcursor
Wsi.CURSOR_FLEUR
;
5845 state
.mstate
<- Mpan
(x, y)
5848 state
.mstate
<- Mnone
5853 if Wsi.withshift mask
5855 annot conf
.annotinline
x y;
5856 G.postRedisplay "addannot"
5860 Wsi.setcursor
Wsi.CURSOR_CYCLE
;
5861 state
.mstate
<- Mzoomrect
(p, p)
5864 match state
.mstate
with
5865 | Mzoomrect
((x0, y0), _) ->
5866 if abs
(x-x0) > 10 && abs
(y - y0) > 10
5867 then zoomrect x0 y0 x y
5870 G.postRedisplay "kill accidental zoom rect";
5874 | Mscrolly
| Mscrollx
5880 | 1 when vscrollhit x ->
5883 let _, position, sh = state
.uioh#
scrollph in
5884 if y > truncate
position && y < truncate
(position +. sh)
5885 then state
.mstate
<- Mscrolly
5888 state
.mstate
<- Mnone
5890 | 1 when y > state
.winh
- hscrollh () ->
5893 let _, position, sw = state
.uioh#scrollpw
in
5894 if x > truncate
position && x < truncate
(position +. sw)
5895 then state
.mstate
<- Mscrollx
5898 state
.mstate
<- Mnone
5900 | 1 when state
.bzoom
-> if not down
then zoomblock x y
5903 let dest = if down
then getunder x y else Unone
in
5904 begin match dest with
5907 | Uremote
_ | Uremotedest
_
5908 | Uunexpected
_ | Ulaunch
_ | Unamed
_ ->
5911 | Unone
when down
->
5912 Wsi.setcursor
Wsi.CURSOR_FLEUR
;
5913 state
.mstate
<- Mpan
(x, y);
5915 | Uannotation
(opaque, slinkindex
) -> enterannotmode opaque slinkindex
5917 | Unone
| Utext
_ ->
5922 state
.mstate
<- Msel
((x, y), (x, y));
5923 G.postRedisplay "mouse select";
5927 match state
.mstate
with
5930 | Mzoom
_ | Mscrollx
| Mscrolly
->
5931 state
.mstate
<- Mnone
5933 | Mzoomrect
((x0, y0), _) ->
5937 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
5938 state
.mstate
<- Mnone
5940 | Msel
((x0, y0), (x1, y1)) ->
5941 let rec loop = function
5945 let a0 = l.pagedispy in
5946 let a1 = a0 + l.pagevh in
5947 let b0 = l.pagedispx in
5948 let b1 = b0 + l.pagevw in
5949 ((y0 >= a0 && y0 <= a1) || (y1 >= a0 && y1 <= a1))
5950 && ((x0 >= b0 && x0 <= b1) || (x1 >= b0 && x1 <= b1))
5954 match getopaque l.pageno with
5957 match Unix.pipe
() with
5958 | (exception exn
) ->
5959 impmsg "cannot create sel pipe: %s" @@
5963 Ne.clo fd
(fun msg
->
5964 dolog
"%s close failed: %s" what msg
)
5967 try spawn
cmd [r, 0; w, -1]
5969 dolog
"cannot execute %S: %s"
5976 G.postRedisplay "copysel";
5978 else clo "Msel pipe/w" w;
5979 clo "Msel pipe/r" r;
5981 dosel conf
.selcmd
();
5982 state
.roam
<- dosel conf
.paxcmd
;
5994 let birdseyemouse button down
x y mask
5995 (conf
, leftx
, _, hooverpageno
, anchor) =
5998 let rec loop = function
6001 if y > l.pagedispy && y < l.pagedispy + l.pagevh
6002 && x > l.pagedispx && x < l.pagedispx + l.pagevw
6004 leavebirdseye (conf
, leftx
, l.pageno, hooverpageno
, anchor) false;
6010 | _ -> viewmouse button down
x y mask
6016 method key key mask
=
6017 begin match state
.mode with
6018 | Textentry
textentry -> textentrykeyboard key mask
textentry
6019 | Birdseye
birdseye -> birdseyekeyboard key mask
birdseye
6020 | View
-> viewkeyboard key mask
6021 | LinkNav
linknav -> linknavkeyboard key mask
linknav
6025 method button button bstate
x y mask
=
6026 begin match state
.mode with
6028 | View
-> viewmouse button bstate
x y mask
6029 | Birdseye beye
-> birdseyemouse button bstate
x y mask beye
6034 method multiclick clicks
x y mask
=
6035 begin match state
.mode with
6037 | View
-> viewmulticlick clicks
x y mask
6044 begin match state
.mode with
6046 | View
| Birdseye
_ | LinkNav
_ ->
6047 match state
.mstate
with
6048 | Mzoom
_ | Mnone
-> ()
6053 state
.mstate
<- Mpan
(x, y);
6054 let x = if canpan () then panbound (state
.x + dx) else state
.x in
6056 gotoxy_and_clear_text x y
6059 state
.mstate
<- Msel
(a, (x, y));
6060 G.postRedisplay "motion select";
6063 let y = min state
.winh
(max
0 y) in
6067 let x = min state
.winw (max
0 x) in
6070 | Mzoomrect
(p0
, _) ->
6071 state
.mstate
<- Mzoomrect
(p0
, (x, y));
6072 G.postRedisplay "motion zoomrect";
6076 method pmotion
x y =
6077 begin match state
.mode with
6078 | Birdseye
(conf
, leftx
, pageno, hooverpageno
, anchor) ->
6079 let rec loop = function
6081 if hooverpageno
!= -1
6083 state
.mode <- Birdseye
(conf
, leftx
, pageno, -1, anchor);
6084 G.postRedisplay "pmotion birdseye no hoover";
6087 if y > l.pagedispy && y < l.pagedispy + l.pagevh
6088 && x > l.pagedispx && x < l.pagedispx + l.pagevw
6090 state
.mode <- Birdseye
(conf
, leftx
, pageno, l.pageno, anchor);
6091 G.postRedisplay "pmotion birdseye hoover";
6101 match state
.mstate
with
6102 | Mpan
_ | Msel
_ | Mzoom
_ | Mscrolly
| Mscrollx
| Mzoomrect
_ -> ()
6110 let past, _, _ = !r in
6112 let delta = now -. past in
6115 else r := (now, x, y)
6119 method infochanged
_ = ()
6122 let maxy = state
.maxy - (if conf
.maxhfit
then state
.winh
else 0) in
6125 then 0.0, float state
.winh
6126 else scrollph state
.y maxy
6131 let winw = wadjsb () + state
.winw in
6132 let fwinw = float winw in
6134 let sw = fwinw /. float state
.w in
6135 let sw = fwinw *. sw in
6136 max
sw (float conf
.scrollh
)
6139 let maxx = state
.w + winw in
6140 let x = winw - state
.x in
6141 let percent = float x /. float maxx in
6142 (fwinw -. sw) *. percent
6144 hscrollh (), position, sw
6148 match state
.mode with
6149 | LinkNav
_ -> "links"
6150 | Textentry
_ -> "textentry"
6151 | Birdseye
_ -> "birdseye"
6154 findkeyhash conf
modename
6156 method eformsgs
= true
6157 method alwaysscrolly
= false
6160 let addrect pageno r g b a x0 y0 x1 y1 =
6161 Hashtbl.add state
.prects
pageno [|r; g; b; a; x0; y0; x1; y1|];
6165 let cl = splitatspace cmds
in
6167 try Scanf.sscanf
s fmt
f
6169 adderrfmt "remote exec"
6170 "error processing '%S': %s\n" cmds
@@ exntos exn
6172 let rectx s pageno (r, g, b, a) x0 y0 x1 y1 =
6173 vlog "%s page %d color (%f %f %f %f) x0,y0,x1,y1 = %f %f %f %f"
6174 s pageno r g b a x0 y0 x1 y1;
6178 let _,w1,h1
,_ = getpagedim
pageno in
6179 let sw = float w1 /. float w
6180 and sh = float h1
/. float h in
6184 and y1s
= y1 *. sh in
6185 let rect = (x0s,y0s
,x1s
,y0s
,x1s
,y1s
,x0s,y1s
) in
6186 let color = (r, g, b, a) in
6187 if conf
.verbose
then debugrect rect;
6188 state
.rects <- (pageno, color, rect) :: state
.rects;
6193 | "reload", "" -> reload ()
6195 scan args
"%u %f %f"
6197 let cmd, _ = state
.geomcmds
in
6199 then gotopagexy !wtmode pageno x y
6202 gotopagexy !wtmode pageno x y;
6205 state
.reprf
<- f state
.reprf
6207 | "goto1", args
-> scan args
"%u %f" gotopage
6210 (fun filename
pageno -> gotounder (Uremote
(filename
, pageno)))
6213 (fun filename
dest -> gotounder (Uremotedest
(filename
, dest)))
6215 scan args
"%u %u %f %f %f %f"
6216 (fun pageno c x0 y0 x1 y1 ->
6217 let color = (0.0, 0.0, 1.0 /. float c, 0.5) in
6218 rectx "rect" pageno color x0 y0 x1 y1;
6221 scan args
"%u %f %f %f %f %f %f %f %f"
6222 (fun pageno r g b alpha x0 y0 x1 y1 ->
6223 addrect pageno r g b alpha x0 y0 x1 y1;
6224 G.postRedisplay "prect"
6227 scan args
"%u %f %f"
6230 match getopaque pageno with
6231 | Some
opaque -> opaque
6234 pgoto optopaque pageno x y;
6235 let rec fixx = function
6238 if l.pageno = pageno
6239 then gotoxy (state
.x - l.pagedispx) state
.y
6244 match conf
.columns
with
6245 | Csingle
_ | Csplit
_ -> 1
6246 | Cmulti
((n, _, _), _) -> n
6248 layout 0 state
.y (state
.winw * mult) state
.winh
6252 | "activatewin", "" -> Wsi.activatewin
()
6253 | "quit", "" -> raise Quit
6256 let l = Config.keys_of_string
keys in
6257 List.iter
(fun (k
, m) -> keyboard k
m) l
6259 adderrfmt "error processing keys" "`%S': %s\n" cmds
@@ exntos exn
6261 | "clearrects", "" ->
6262 Hashtbl.clear state
.prects
;
6263 G.postRedisplay "clearrects"
6265 adderrfmt "remote command"
6266 "error processing remote command: %S\n" cmds
;
6270 let scratch = Bytes.create
80 in
6271 let buf = Buffer.create
80 in
6273 match tempfailureretry
(Unix.read fd
scratch 0) 80 with
6274 | (exception Unix.Unix_error
(Unix.EAGAIN
, _, _)) -> None
6277 if Buffer.length
buf > 0
6279 let s = Buffer.contents
buf in
6287 match Bytes.index_from
scratch ppos '
\n'
with
6288 | pos -> if pos >= n then -1 else pos
6289 | (exception Not_found
) -> -1
6293 Buffer.add_subbytes
buf scratch ppos
(nlpos-ppos
);
6294 let s = Buffer.contents
buf in
6300 Buffer.add_subbytes
buf scratch ppos
(n-ppos
);
6306 let remoteopen path =
6307 try Some
(Unix.openfile
path [Unix.O_NONBLOCK
; Unix.O_RDONLY
] 0o0)
6309 adderrfmt "remoteopen" "error opening %S: %s" path @@ exntos exn
;
6314 let gcconfig = ref E.s in
6315 let trimcachepath = ref E.s in
6316 let rcmdpath = ref E.s in
6317 let pageno = ref None
in
6318 let rootwid = ref 0 in
6319 let openlast = ref false in
6320 let nofc = ref false in
6321 let doreap = ref false in
6322 selfexec := Sys.executable_name
;
6325 [("-p", Arg.String
(fun s -> state
.password <- s),
6326 "<password> Set password");
6330 Config.fontpath
:= s;
6331 selfexec := !selfexec ^
" -f " ^
Filename.quote
s;
6333 "<path> Set path to the user interface font");
6337 selfexec := !selfexec ^
" -c " ^
Filename.quote
s;
6338 Config.confpath
:= s),
6339 "<path> Set path to the configuration file");
6341 ("-last", Arg.Set
openlast, " Open last document");
6343 ("-page", Arg.Int
(fun pageno1
-> pageno := Some
(pageno1
-1)),
6344 "<page-number> Jump to page");
6346 ("-tcf", Arg.String
(fun s -> trimcachepath := s),
6347 "<path> Set path to the trim cache file");
6349 ("-dest", Arg.String
(fun s -> state
.nameddest
<- s),
6350 "<named-destination> Set named destination");
6352 ("-wtmode", Arg.Set
wtmode, " Operate in wt mode");
6353 ("-cxack", Arg.Set
cxack, " Cut corners");
6355 ("-remote", Arg.String
(fun s -> rcmdpath := s),
6356 "<path> Set path to the remote commands source");
6358 ("-origin", Arg.String
(fun s -> state
.origin
<- s),
6359 "<original-path> Set original path");
6361 ("-gc", Arg.Set_string
gcconfig,
6362 "<script-path> Collect garbage with the help of a script");
6364 ("-nofc", Arg.Set
nofc, " Do not use fontconfig");
6366 ("-v", Arg.Unit
(fun () ->
6368 "%s\nconfiguration path: %s\n"
6372 exit
0), " Print version and exit");
6374 ("-embed", Arg.Set_int
rootwid,
6375 "<window-id> Embed into window")
6378 (fun s -> state
.path <- s)
6379 ("Usage: " ^
Sys.argv
.(0) ^
" [options] some.pdf\nOptions:")
6382 then selfexec := !selfexec ^
" -wtmode";
6384 let histmode = emptystr state
.path && not
!openlast in
6386 if not
(Config.load !openlast)
6387 then dolog
"failed to load configuration";
6389 begin match !pageno with
6390 | Some
pageno -> state
.anchor <- (pageno, 0.0, 0.0)
6394 if nonemptystr
!gcconfig
6397 match Unix.socketpair
Unix.PF_UNIX
Unix.SOCK_STREAM
0 with
6398 | (exception exn
) -> error
"socketpair for gc failed: %s" @@ exntos exn
6401 match spawn
!gcconfig [(c, 0); (c, 1); (s, -1)] with
6402 | (exception exn
) -> error
"failed to execute gc script: %s" @@ exntos exn
6404 Ne.clo c @@ (fun s -> error
"failed to close gc fd %s" s);
6409 let wsfd, winw, winh
= Wsi.init
(object (self)
6410 val mutable m_clicks
= 0
6411 val mutable m_click_x
= 0
6412 val mutable m_click_y
= 0
6413 val mutable m_lastclicktime
= infinity
6415 method private cleanup =
6416 state
.roam
<- noroam
;
6417 Hashtbl.iter
(fun _ opaque -> clearmark
opaque) state
.pagemap
6418 method expose
= G.postRedisplay "expose"
6422 | Wsi.Unobscured
-> "unobscured"
6423 | Wsi.PartiallyObscured
-> "partiallyobscured"
6424 | Wsi.FullyObscured
-> "fullyobscured"
6426 vlog "visibility change %s" name
6427 method display = display ()
6428 method map mapped
= vlog "mapped %b" mapped
6429 method reshape w h =
6432 method mouse
b d x y m =
6433 if d && canselect ()
6435 (* http://blogs.msdn.com/b/oldnewthing/archive/2004/10/18/243925.aspx *)
6441 if abs
x - m_click_x
> 10
6442 || abs
y - m_click_y
> 10
6443 || abs_float
(t -. m_lastclicktime
) > 0.3
6445 m_clicks
<- m_clicks
+ 1;
6446 m_lastclicktime
<- t;
6450 G.postRedisplay "cleanup";
6451 state
.uioh <- state
.uioh#button
b d x y m;
6453 else state
.uioh <- state
.uioh#multiclick m_clicks
x y m
6458 m_lastclicktime
<- infinity
;
6459 state
.uioh <- state
.uioh#button
b d x y m
6463 state
.uioh <- state
.uioh#button
b d x y m
6466 state
.mpos
<- (x, y);
6467 state
.uioh <- state
.uioh#motion
x y
6468 method pmotion
x y =
6469 state
.mpos
<- (x, y);
6470 state
.uioh <- state
.uioh#pmotion
x y
6472 let mascm = m land (
6473 Wsi.altmask
+ Wsi.shiftmask
+ Wsi.ctrlmask
+ Wsi.metamask
6476 let x = state
.x and y = state
.y in
6478 if x != state
.x || y != state
.y then self#
cleanup
6480 match state
.keystate
with
6482 let km = k
, mascm in
6485 let modehash = state
.uioh#
modehash in
6486 try Hashtbl.find modehash km
6488 try Hashtbl.find (findkeyhash conf
"global") km
6489 with Not_found
-> KMinsrt
(k
, m)
6491 | KMinsrt
(k
, m) -> keyboard k
m
6492 | KMinsrl
l -> List.iter
(fun (k
, m) -> keyboard k
m) l
6493 | KMmulti
(l, r) -> state
.keystate
<- KSinto
(l, r)
6495 | KSinto
((k'
, m'
) :: [], insrt
) when k'
=k
&& m'
land mascm = m'
->
6496 List.iter
(fun (k
, m) -> keyboard k
m) insrt
;
6497 state
.keystate
<- KSnone
6498 | KSinto
((k'
, m'
) :: keys, insrt
) when k'
=k
&& m'
land mascm = m'
->
6499 state
.keystate
<- KSinto
(keys, insrt
)
6500 | KSinto
_ -> state
.keystate
<- KSnone
6503 state
.mpos
<- (x, y);
6504 state
.uioh <- state
.uioh#pmotion
x y
6505 method leave = state
.mpos
<- (-1, -1)
6506 method winstate wsl
= state
.winstate
<- wsl
6507 method quit
= raise Quit
6508 end) !rootwid conf
.cwinw conf
.cwinh platform
in
6510 setbgcol conf
.bgcolor
;
6514 List.exists
GlMisc.check_extension
6515 [ "GL_ARB_texture_rectangle"
6516 ; "GL_EXT_texture_recangle"
6517 ; "GL_NV_texture_rectangle" ]
6519 then (dolog
"OpenGL does not suppport rectangular textures"; exit
1);
6522 let r = GlMisc.get_string `renderer
in
6523 let p = "Mesa DRI Intel(" in
6524 let l = String.length
p in
6525 String.length
r > l && String.sub
r 0 l = p
6528 defconf
.sliceheight
<- 1024;
6529 defconf
.texcount
<- 32;
6530 defconf
.usepbo
<- true;
6534 match Unix.socketpair
Unix.PF_UNIX
Unix.SOCK_STREAM
0 with
6535 | (exception exn
) ->
6536 dolog
"socketpair failed: %s" @@ exntos exn
;
6544 setcheckers conf
.checkers
;
6546 opengl_has_pbo := GlMisc.check_extension
"GL_ARB_pixel_buffer_object";
6549 conf
.angle
, conf
.fitmodel
, (conf
.trimmargins
, conf
.trimfuzz
),
6550 conf
.texcount
, conf
.sliceheight
, conf
.mustoresize
, conf
.colorspace
,
6551 !Config.fontpath
, !trimcachepath,
6555 List.iter
GlArray.enable
[`texture_coord
; `vertex
];
6557 reshape ~firsttime
:true winw winh
;
6561 Wsi.settitle
"llpp (history)";
6565 state
.text <- "Opening " ^
(mbtoutf8 state
.path);
6566 opendoc state
.path state
.password;
6570 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
6571 Sys.set_signal
Sys.sighup
(Sys.Signal_handle
(fun _ -> reload ()));
6574 match Unix.waitpid
[Unix.WNOHANG
] ~
-1 with
6575 | (exception (Unix.Unix_error
(Unix.ECHILD
, _, _))) -> ()
6576 | (exception exn
) -> dolog
"Unix.waitpid: %s" @@ exntos exn
6578 | _pid
, _status
-> reap ()
6580 Sys.set_signal
Sys.sigchld
(Sys.Signal_handle
(fun _ -> doreap := true));
6584 if nonemptystr
!rcmdpath
6585 then remoteopen !rcmdpath
6590 let rec loop deadline
=
6596 let r = [state
.ss; state
.wsfd] in
6600 | Some fd
-> fd
:: r
6604 state
.redisplay
<- false;
6611 if deadline
= infinity
6613 else max
0.0 (deadline
-. now)
6618 try Unix.select
r [] [] timeout
6619 with Unix.Unix_error
(Unix.EINTR
, _, _) -> [], [], []
6625 if state
.ghyll
== noghyll
6627 match state
.autoscroll
with
6628 | Some step
when step
!= 0 ->
6629 let y = state
.y + step
in
6630 let fy = if conf
.maxhfit
then state
.winh
else 0 in
6633 then state
.maxy - fy
6634 else if y >= state
.maxy - fy then 0 else y
6636 if state
.mode = View
6637 then gotoxy_and_clear_text state
.x y
6638 else gotoxy state
.x y;
6641 else deadline
+. 0.01
6646 let rec checkfds = function
6648 | fd
:: rest
when fd
= state
.ss ->
6649 let cmd = rcmd state
.ss in
6653 | fd
:: rest
when fd
= state
.wsfd ->
6657 | fd
:: rest
when Some fd
= !optrfd ->
6658 begin match remote fd
with
6659 | None
-> optrfd := remoteopen !rcmdpath;
6660 | opt -> optrfd := opt
6665 dolog
"select returned unknown descriptor";
6671 if deadline
= infinity
6675 match state
.autoscroll
with
6676 | Some step
when step
!= 0 -> deadline1
6677 | _ -> if state
.ghyll
== noghyll
then infinity
else deadline1
6685 Config.save leavebirdseye;
6686 if hasunsavedchanges
()