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
.y) (state
.winh
- hscrollh ()))
2079 ?
(x=vw/2) ?
(y=vh
/2) zoom =
2080 let w = float state
.w /. zoom in
2081 let hw = w /. 2.0 in
2082 let ratio = float vh
/. float vw in
2083 let hh = hw *. ratio in
2084 let x0 = float x -. hw in
2085 let y0 = float y -. hh in
2086 gotoxy (state
.x - truncate
x0) (state
.y + truncate
y0);
2090 let pivotzoom ?
vw ?vh ?
x ?
y zoom =
2091 if nogeomcmds state
.geomcmds
then pivotzoom ?
vw ?vh ?
x ?
y zoom
2094 let setcolumns mode columns coverA coverB
=
2095 state
.prevcolumns
<- Some
(conf
.columns
, conf
.zoom);
2099 then impmsg "split mode doesn't work in bird's eye"
2101 conf
.columns
<- Csplit
(-columns
, E.a);
2109 conf
.columns
<- Csingle
E.a;
2114 conf
.columns
<- Cmulti
((columns
, coverA
, coverB
), E.a);
2118 reshape state
.winw state
.winh
;
2121 let resetmstate () =
2122 state
.mstate
<- Mnone
;
2123 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
2126 let enterbirdseye () =
2127 let zoom = float conf
.thumbw
/. float state
.winw
in
2128 let birdseyepageno =
2129 let cy = state
.winh
/ 2 in
2133 let rec fold best
= function
2136 let d = cy - (l.pagedispy + l.pagevh/2)
2137 and dbest
= cy - (best
.pagedispy + best
.pagevh/2) in
2138 if abs
d < abs dbest
2145 state
.mode
<- Birdseye
(
2146 { conf
with zoom = conf
.zoom }, state
.x, birdseyepageno, -1, getanchor
()
2150 conf
.presentation
<- false;
2151 conf
.interpagespace
<- 10;
2152 conf
.hlinks
<- false;
2153 conf
.fitmodel
<- FitPage
;
2155 conf
.maxwait
<- None
;
2157 match conf
.beyecolumns
with
2160 Cmulti
((c, 0, 0), E.a)
2161 | None
-> Csingle
E.a
2165 state
.text <- Printf.sprintf
"birds eye mode on (zoom %3.1f%%)"
2170 reshape state
.winw state
.winh
;
2173 let leavebirdseye (c, leftx
, pageno, _, anchor) goback
=
2175 conf
.zoom <- c.zoom;
2176 conf
.presentation
<- c.presentation
;
2177 conf
.interpagespace
<- c.interpagespace
;
2178 conf
.maxwait
<- c.maxwait
;
2179 conf
.hlinks
<- c.hlinks
;
2180 conf
.fitmodel
<- c.fitmodel
;
2181 conf
.beyecolumns
<- (
2182 match conf
.columns
with
2183 | Cmulti
((c, _, _), _) -> Some
c
2185 | Csplit
_ -> failwith
"leaving bird's eye split mode"
2188 match c.columns
with
2189 | Cmulti
(c, _) -> Cmulti
(c, E.a)
2190 | Csingle
_ -> Csingle
E.a
2191 | Csplit
(c, _) -> Csplit
(c, E.a)
2195 state
.text <- Printf.sprintf
"birds eye mode off (zoom %3.1f%%)"
2198 reshape state
.winw state
.winh
;
2199 state
.anchor <- if goback
then anchor else (pageno, 0.0, 1.0);
2203 let togglebirdseye () =
2204 match state
.mode
with
2205 | Birdseye vals
-> leavebirdseye vals
true
2206 | View
-> enterbirdseye ()
2211 let upbirdseye incr
(conf
, leftx
, pageno, hooverpageno
, anchor) =
2212 let pageno = max
0 (pageno - incr
) in
2213 let rec loop = function
2214 | [] -> gotopage1 pageno 0
2215 | l :: _ when l.pageno = pageno ->
2216 if l.pagedispy >= 0 && l.pagey = 0
2217 then G.postRedisplay "upbirdseye"
2218 else gotopage1 pageno 0
2219 | _ :: rest
-> loop rest
2223 state
.mode
<- Birdseye
(conf
, leftx
, pageno, hooverpageno
, anchor)
2226 let downbirdseye incr
(conf
, leftx
, pageno, hooverpageno
, anchor) =
2227 let pageno = min
(state
.pagecount
- 1) (pageno + incr
) in
2228 state
.mode
<- Birdseye
(conf
, leftx
, pageno, hooverpageno
, anchor);
2229 let rec loop = function
2231 let y, h = getpageyh
pageno in
2232 let dy = (y - state
.y) - (state
.winh
- h - conf
.interpagespace
) in
2233 gotoxy state
.x (clamp dy)
2234 | l :: _ when l.pageno = pageno ->
2235 if l.pagevh != l.pageh
2236 then gotoxy state
.x (clamp (l.pageh
- l.pagevh + conf
.interpagespace
))
2237 else G.postRedisplay "downbirdseye"
2238 | _ :: rest
-> loop rest
2244 let optentry mode
_ key =
2245 let btos b = if b then "on" else "off" in
2246 if key >= 32 && key < 127
2248 let c = Char.chr
key in
2252 try conf
.scrollstep
<- int_of_string
s with exn
->
2253 state
.text <- Printf.sprintf
"bad integer `%s': %s" s @@ exntos exn
2255 TEswitch
("scroll step: ", E.s, None
, intentry, ondone, true)
2260 conf
.autoscrollstep
<- boundastep state
.winh
(int_of_string
s);
2261 if state
.autoscroll
<> None
2262 then state
.autoscroll
<- Some conf
.autoscrollstep
2264 state
.text <- Printf.sprintf
"bad integer `%s': %s" s @@ exntos exn
2266 TEswitch
("auto scroll step: ", E.s, None
, intentry, ondone, true)
2271 let n, a, b = multicolumns_of_string
s in
2272 setcolumns mode
n a b;
2274 state
.text <- Printf.sprintf
"bad columns `%s': %s" s @@ exntos exn
2276 TEswitch
("columns: ", E.s, None
, textentry, ondone, true)
2281 let zoom = float (int_of_string
s) /. 100.0 in
2284 state
.text <- Printf.sprintf
"bad integer `%s': %s" s @@ exntos exn
2286 TEswitch
("zoom: ", E.s, None
, intentry, ondone, true)
2291 conf
.thumbw
<- bound
(int_of_string
s) 2 4096;
2293 Printf.sprintf
"thumbnail width is set to %d" conf
.thumbw
;
2294 begin match mode
with
2296 leavebirdseye beye
false;
2303 state
.text <- Printf.sprintf
"bad integer `%s': %s" s @@ exntos exn
2305 TEswitch
("thumbnail width: ", E.s, None
, intentry, ondone, true)
2309 match int_of_string
s with
2310 | angle
-> reqlayout angle conf
.fitmodel
2313 Printf.sprintf
"bad integer `%s': %s" s @@ exntos exn
2315 TEswitch
("rotation: ", E.s, None
, intentry, ondone, true)
2318 conf
.icase
<- not conf
.icase
;
2319 TEdone
("case insensitive search " ^
(btos conf
.icase
))
2322 conf
.preload <- not conf
.preload;
2323 gotoxy state
.x state
.y;
2324 TEdone
("preload " ^
(btos conf
.preload))
2327 conf
.verbose
<- not conf
.verbose
;
2328 TEdone
("verbose " ^
(btos conf
.verbose
))
2331 conf
.debug
<- not conf
.debug
;
2332 TEdone
("debug " ^
(btos conf
.debug
))
2335 conf
.maxhfit
<- not conf
.maxhfit
;
2336 state
.maxy
<- calcheight
();
2337 TEdone
("maxhfit " ^
(btos conf
.maxhfit
))
2340 conf
.crophack
<- not conf
.crophack
;
2341 TEdone
("crophack " ^
btos conf
.crophack
)
2345 match conf
.maxwait
with
2347 conf
.maxwait
<- Some infinity
;
2348 "always wait for page to complete"
2350 conf
.maxwait
<- None
;
2351 "show placeholder if page is not ready"
2356 conf
.underinfo
<- not conf
.underinfo
;
2357 TEdone
("underinfo " ^
btos conf
.underinfo
)
2360 conf
.savebmarks
<- not conf
.savebmarks
;
2361 TEdone
("persistent bookmarks " ^
btos conf
.savebmarks
)
2367 match state
.layout with
2372 conf
.interpagespace
<- int_of_string
s;
2373 docolumns conf
.columns
;
2374 state
.maxy
<- calcheight
();
2375 let y = getpagey
pageno in
2376 gotoxy state
.x (y + py)
2378 state
.text <- Printf.sprintf
"bad integer `%s': %s" s @@ exntos exn
2380 TEswitch
("vertical margin: ", E.s, None
, intentry, ondone, true)
2384 match conf
.fitmodel
with
2385 | FitProportional
-> FitWidth
2386 | FitWidth
| FitPage
-> FitProportional
2388 reqlayout conf
.angle
fm;
2389 TEdone
("proportional display " ^
btos (fm == FitProportional
))
2392 settrim (not conf
.trimmargins
) conf
.trimfuzz
;
2393 TEdone
("trim margins " ^
btos conf
.trimmargins
)
2396 conf
.invert
<- not conf
.invert
;
2397 TEdone
("invert colors " ^
btos conf
.invert
)
2401 cbput state
.hists
.sel
s;
2404 TEswitch
("selection command: ", E.s, Some
(onhist state
.hists
.sel
),
2405 textentry, ondone, true)
2409 then conf
.pax
<- Some
(ref (0.0, 0, 0))
2410 else conf
.pax
<- None
;
2411 TEdone
("PAX " ^
btos (conf
.pax
!= None
))
2414 state
.text <- Printf.sprintf
"bad option %d `%c'" key c;
2420 class type lvsource
= object
2421 method getitemcount
: int
2422 method getitem
: int -> (string * int)
2423 method hasaction
: int -> bool
2431 method getactive
: int
2432 method getfirst
: int
2434 method getminfo
: (int * int) array
2437 class virtual lvsourcebase
= object
2438 val mutable m_active
= 0
2439 val mutable m_first
= 0
2440 val mutable m_pan
= 0
2441 method getactive
= m_active
2442 method getfirst
= m_first
2443 method getpan
= m_pan
2444 method getminfo
: (int * int) array
= E.a
2447 let textentrykeyboard
2448 key _mask
((c, text, opthist
, onkey
, ondone, cancelonempty
), onleave
) =
2450 let key = Wsi.keypadtodigitkey
key in
2452 state
.mode
<- Textentry
(te
, onleave
);
2454 G.postRedisplay "textentrykeyboard enttext";
2456 let histaction cmd
=
2459 | Some
(action, _) ->
2460 state
.mode
<- Textentry
(
2461 (c, action cmd
, opthist
, onkey
, ondone, cancelonempty
), onleave
2463 G.postRedisplay "textentry histaction"
2467 if emptystr
text && cancelonempty
2470 G.postRedisplay "textentrykeyboard after cancel";
2473 let s = withoutlastutf8
text in
2474 enttext (c, s, opthist
, onkey
, ondone, cancelonempty
)
2476 | @enter
| @kpenter
->
2479 G.postRedisplay "textentrykeyboard after confirm"
2481 | @up
| @kpup
-> histaction HCprev
2482 | @down
| @kpdown
-> histaction HCnext
2483 | @home
| @kphome
-> histaction HCfirst
2484 | @jend
| @kpend
-> histaction HClast
2489 begin match opthist
with
2491 | Some
(_, onhistcancel
) -> onhistcancel
()
2495 G.postRedisplay "textentrykeyboard after cancel2"
2498 enttext (c, E.s, opthist
, onkey
, ondone, cancelonempty
)
2501 | @delete
| @kpdelete
-> ()
2503 | _ when key != 0 && not
(Wsi.isspecialkey
key) ->
2504 begin match onkey
text key with
2508 G.postRedisplay "textentrykeyboard after confirm2";
2511 enttext (c, text, opthist
, onkey
, ondone, cancelonempty
);
2515 G.postRedisplay "textentrykeyboard after cancel3"
2518 state
.mode
<- Textentry
(te
, onleave
);
2519 G.postRedisplay "textentrykeyboard switch";
2523 vlog "unhandled key %s" (Wsi.keyname
key)
2526 let firstof first active
=
2527 if first
> active
|| abs
(first
- active
) > fstate
.maxrows
- 1
2528 then max
0 (active
- (fstate
.maxrows
/2))
2532 let calcfirst first active
=
2535 let rows = active
- first
in
2536 if rows > fstate
.maxrows
then active
- fstate
.maxrows
else first
2540 let scrollph y maxy
=
2541 let sh = float (maxy
+ state
.winh
) /. float state
.winh
in
2542 let sh = float state
.winh
/. sh in
2543 let sh = max
sh (float conf
.scrollh
) in
2545 let percent = float y /. float maxy
in
2546 let position = (float state
.winh
-. sh) *. percent in
2549 if position +. sh > float state
.winh
2550 then float state
.winh
-. sh
2556 let adderrmsg src msg
=
2557 Buffer.add_string state
.errmsgs msg
;
2558 state
.newerrmsgs
<- true;
2562 let adderrfmt src fmt
=
2563 Format.ksprintf
(fun s -> adderrmsg src
s) fmt
;
2566 let coe s = (s :> uioh
);;
2568 class listview ~zebra ~helpmode ~
(source
:lvsource
) ~trusted ~modehash
=
2570 val m_pan
= source#getpan
2571 val m_first
= source#getfirst
2572 val m_active
= source#getactive
2574 val m_prev_uioh
= state
.uioh
2576 method private elemunder
y =
2580 let n = y / (fstate
.fontsize
+1) in
2581 if m_first
+ n < source#getitemcount
2583 if source#hasaction
(m_first
+ n)
2584 then Some
(m_first
+ n)
2591 GlFunc.blend_func ~src
:`src_alpha ~dst
:`one_minus_src_alpha
;
2592 GlDraw.color (0., 0., 0.) ~alpha
:0.85;
2593 filledrect 0. 0. (float state
.winw
) (float state
.winh
);
2594 GlDraw.color (1., 1., 1.);
2595 Gl.enable `texture_2d
;
2596 let fs = fstate
.fontsize
in
2598 let hw = (wadjsb () + xadjsb () + state
.winw
)/3 in
2599 let ww = fstate
.wwidth
in
2600 let tabw = 17.0*.ww in
2601 let itemcount = source#getitemcount
in
2602 let minfo = source#getminfo
in
2606 then float (state
.winw
- 1)
2607 else float (state
.winw
- conf
.scrollbw
- 1)
2609 let xadj = xadjsb () in
2611 if (row - m_first
) > fstate
.maxrows
2614 if row >= 0 && row < itemcount
2616 let (s, level
) = source#getitem
row in
2617 let y = (row - m_first
) * nfs in
2619 (if conf
.leftscroll
then float xadj else 5.0)
2620 +. (float (level
+ m_pan
)) *. ww in
2623 (let c = if row land 1 = 0 then 1.0 else 0.92 in (c,c,c));
2627 Gl.disable `texture_2d
;
2628 let alpha = if source#hasaction
row then 0.9 else 0.3 in
2629 GlDraw.color (1., 1., 1.) ~
alpha;
2630 linerect (float xadj +. x0 +. 1.)
2631 (float (y + 1)) (x1) (float (y + fs + 3));
2632 Gl.enable `texture_2d
;
2635 if zebra
&& row land 1 = 1
2639 GlDraw.color (c,c,c);
2640 let drawtabularstring s =
2642 let x'
= truncate
(x0 +. x) in
2643 let pos = nindex
s '
\000'
in
2645 then drawstring1 fs x'
(y+nfs) s
2647 let s1 = String.sub
s 0 pos
2648 and s2
= String.sub
s (pos+1) (String.length
s - pos - 1) in
2653 let s'
= withoutlastutf8
s in
2654 let s = s' ^
"@Uellipsis" in
2655 let w = measurestr
fs s in
2656 if float x'
+. w +. ww < float (hw + x'
)
2661 if float x'
+. ww +. measurestr
fs s1 > float (hw + x'
)
2665 ignore
(drawstring1 fs x'
(y+nfs) s1);
2666 drawstring1 fs (hw + x'
) (y+nfs) s2
2670 let x = if helpmode
&& row > 0 then x +. ww else x in
2671 let tabpos = nindex
s '
\t'
in
2674 let len = String.length
s - tabpos - 1 in
2675 let s1 = String.sub
s 0 tabpos
2676 and s2
= String.sub
s (tabpos + 1) len in
2677 let nx = drawstr x s1 in
2679 let x = x +. (max
tabw sw) in
2682 let len = String.length
s - 2 in
2683 if len > 0 && s.[0] = '
\xc2'
&& s.[1] = '
\xb7'
2685 let s = String.sub
s 2 len in
2686 let x = if not helpmode
then x +. ww else x in
2687 GlDraw.color (1.2, 1.2, 1.2);
2688 let vinc = drawstring1 (fs+fs/4)
2689 (truncate
(x -. ww)) (y+nfs) s in
2690 GlDraw.color (1., 1., 1.);
2691 vinc +. (float fs *. 0.8)
2697 ignore
(drawtabularstring s);
2703 GlDraw.color (1.0, 1.0, 1.0) ~
alpha:0.5;
2704 let xadj = float (xadjsb () + 5) in
2706 if (row - m_first
) > fstate
.maxrows
2709 if row >= 0 && row < itemcount
2711 let (s, level
) = source#getitem
row in
2712 let pos0 = nindex
s '
\000'
in
2713 let y = (row - m_first
) * nfs in
2714 let x = float (level
+ m_pan
) *. ww in
2715 let (first
, last
) = minfo.(row) in
2717 if pos0 > 0 && first
> pos0
2718 then String.sub
s (pos0+1) (first
-pos0-1)
2719 else String.sub
s 0 first
2721 let suffix = String.sub
s first
(last
- first
) in
2722 let w1 = measurestr fstate
.fontsize
prefix in
2723 let w2 = measurestr fstate
.fontsize
suffix in
2724 let x = x +. if conf
.leftscroll
then xadj else 5.0 in
2725 let x = if pos0 > 0 && first
> pos0 then x +. float hw else x in
2727 and y0 = float (y+2) in
2729 and y1 = float (y+fs+3) in
2730 filledrect x0 y0 x1 y1;
2735 Gl.disable `texture_2d
;
2736 if Array.length
minfo > 0 then loop m_first
;
2739 method updownlevel incr
=
2740 let len = source#getitemcount
in
2742 if m_active
>= 0 && m_active
< len
2743 then snd
(source#getitem m_active
)
2747 if i
= len then i
-1 else if i
= -1 then 0 else
2748 let _, l = source#getitem i
in
2749 if l != curlevel then i
else flow (i
+incr
)
2751 let active = flow m_active
in
2752 let first = calcfirst m_first
active in
2753 G.postRedisplay "outline updownlevel";
2754 {< m_active
= active; m_first
= first >}
2756 method private key1
key mask
=
2757 let set1 active first qsearch
=
2758 coe {< m_active
= active; m_first
= first; m_qsearch
= qsearch
>}
2760 let search active pattern incr
=
2761 let active = if active = -1 then m_first
else active in
2764 if n >= 0 && n < source#getitemcount
2766 let s, _ = source#getitem
n in
2767 match Str.search_forward re
s 0 with
2768 | (exception Not_found
) -> loop (n + incr
)
2775 let qpat = Str.quote pattern
in
2776 match Str.regexp_case_fold
qpat with
2779 adderrfmt "listview key1" "regexp_case_fold for `%S' failed: %S\n"
2780 qpat @@ Printexc.to_string exn
;
2783 let itemcount = source#getitemcount
in
2784 let find start incr
=
2786 if i
= -1 || i
= itemcount
2789 if source#hasaction i
2791 else find (i
+ incr
)
2796 let set active first =
2797 let first = bound
first 0 (itemcount - fstate
.maxrows
) in
2799 coe {< m_active
= active; m_first
= first; m_qsearch
= E.s >}
2802 let isvisible first n = n >= first && n - first <= fstate
.maxrows
in
2804 let incr1 = if incr
> 0 then 1 else -1 in
2805 if isvisible m_first m_active
2808 let next = m_active
+ incr
in
2810 if next < 0 || next >= itemcount
2812 else find next incr1
2814 if abs
(m_active
- next) > fstate
.maxrows
2820 let first = m_first
+ incr
in
2821 let first = bound
first 0 (itemcount - fstate
.maxrows
) in
2823 let next = m_active
+ incr
in
2824 let next = bound
next 0 (itemcount - 1) in
2831 if isvisible first next
2838 let first = min
next m_first
in
2840 if abs
(next - first) > fstate
.maxrows
2846 let first = m_first
+ incr
in
2847 let first = bound
first 0 (itemcount - 1) in
2849 let next = m_active
+ incr
in
2850 let next = bound
next 0 (itemcount - 1) in
2851 let next = find next incr1 in
2853 if next = -1 || abs
(m_active
- first) > fstate
.maxrows
2855 let active = if m_active
= -1 then next else m_active
in
2860 if isvisible first active
2866 G.postRedisplay "listview navigate";
2870 | (@r
|@s) when Wsi.withctrl mask
->
2871 let incr = if key = @r
then -1 else 1 in
2873 match search (m_active
+ incr) m_qsearch
incr with
2875 state
.text <- m_qsearch ^
" [not found]";
2878 state
.text <- m_qsearch
;
2879 active, firstof m_first
active
2881 G.postRedisplay "listview ctrl-r/s";
2882 set1 active first m_qsearch
;
2884 | @insert
when Wsi.withctrl mask
->
2885 if m_active
>= 0 && m_active
< source#getitemcount
2887 let s, _ = source#getitem m_active
in
2893 if emptystr m_qsearch
2896 let qsearch = withoutlastutf8 m_qsearch
in
2900 G.postRedisplay "listview empty qsearch";
2901 set1 m_active m_first
E.s;
2905 match search m_active
qsearch ~
-1 with
2907 state
.text <- qsearch ^
" [not found]";
2910 state
.text <- qsearch;
2911 active, firstof m_first
active
2913 G.postRedisplay "listview backspace qsearch";
2914 set1 active first qsearch
2917 | key when (key != 0 && not
(Wsi.isspecialkey
key)) ->
2918 let pattern = m_qsearch ^ toutf8
key in
2920 match search m_active
pattern 1 with
2922 state
.text <- pattern ^
" [not found]";
2925 state
.text <- pattern;
2926 active, firstof m_first
active
2928 G.postRedisplay "listview qsearch add";
2929 set1 active first pattern;
2933 if emptystr m_qsearch
2935 G.postRedisplay "list view escape";
2936 let mx, my
= state
.mpos
in
2940 source#exit ~uioh
:(coe self
)
2941 ~cancel
:true ~
active:m_active ~
first:m_first ~pan
:m_pan
2943 | None
-> m_prev_uioh
2948 G.postRedisplay "list view kill qsearch";
2949 coe {< m_qsearch
= E.s >}
2952 | @enter
| @kpenter
->
2954 let self = {< m_qsearch
= E.s >} in
2956 G.postRedisplay "listview enter";
2957 if m_active
>= 0 && m_active
< source#getitemcount
2959 source#exit ~uioh
:(coe self) ~cancel
:false
2960 ~
active:m_active ~
first:m_first ~pan
:m_pan
;
2963 source#exit ~uioh
:(coe self) ~cancel
:true
2964 ~
active:m_active ~
first:m_first ~pan
:m_pan
;
2967 begin match opt with
2968 | None
-> m_prev_uioh
2972 | @delete
| @kpdelete
->
2975 | @up
| @kpup
-> navigate ~
-1
2976 | @down
| @kpdown
-> navigate 1
2977 | @prior
| @kpprior
-> navigate ~
-(fstate
.maxrows
)
2978 | @next | @kpnext
-> navigate fstate
.maxrows
2980 | @right
| @kpright
->
2982 G.postRedisplay "listview right";
2983 coe {< m_pan
= m_pan
- 1 >}
2985 | @left | @kpleft
->
2987 G.postRedisplay "listview left";
2988 coe {< m_pan
= m_pan
+ 1 >}
2990 | @home
| @kphome
->
2991 let active = find 0 1 in
2992 G.postRedisplay "listview home";
2996 let first = max
0 (itemcount - fstate
.maxrows
) in
2997 let active = find (itemcount - 1) ~
-1 in
2998 G.postRedisplay "listview end";
3001 | key when (key = 0 || Wsi.isspecialkey
key) ->
3005 dolog
"listview unknown key %#x" key; coe self
3007 method key key mask
=
3008 match state
.mode
with
3009 | Textentry te
-> textentrykeyboard key mask te
; coe self
3012 | LinkNav
_ -> self#key1
key mask
3014 method button button down
x y _ =
3017 | 1 when vscrollhit x ->
3018 G.postRedisplay "listview scroll";
3021 let _, position, sh = self#
scrollph in
3022 if y > truncate
position && y < truncate
(position +. sh)
3024 state
.mstate
<- Mscrolly
;
3028 let s = float (max
0 (y - conf
.scrollh
)) /. float state
.winh
in
3029 let first = truncate
(s *. float source#getitemcount
) in
3030 let first = min source#getitemcount
first in
3031 Some
(coe {< m_first
= first; m_active
= first >})
3033 state
.mstate
<- Mnone
;
3037 begin match self#elemunder
y with
3039 G.postRedisplay "listview click";
3040 source#exit ~uioh
:(coe {< m_active
= n >})
3041 ~cancel
:false ~
active:n ~
first:m_first ~pan
:m_pan
3045 | n when (n == 4 || n == 5) && not down
->
3046 let len = source#getitemcount
in
3048 if n = 5 && m_first
+ fstate
.maxrows
>= len
3052 let first = m_first
+ (if n == 4 then -1 else 1) in
3053 bound
first 0 (len - 1)
3055 G.postRedisplay "listview wheel";
3056 Some
(coe {< m_first
= first >})
3057 | n when (n = 6 || n = 7) && not down
->
3058 let inc = if n = 7 then -1 else 1 in
3059 G.postRedisplay "listview hwheel";
3060 Some
(coe {< m_pan
= m_pan
+ inc >})
3065 | None
-> m_prev_uioh
3068 method multiclick
_ x y = self#button
1 true x y
3071 match state
.mstate
with
3073 let s = float (max
0 (y - conf
.scrollh
)) /. float state
.winh
in
3074 let first = truncate
(s *. float source#getitemcount
) in
3075 let first = min source#getitemcount
first in
3076 G.postRedisplay "listview motion";
3077 coe {< m_first
= first; m_active
= first >}
3085 method pmotion
x y =
3086 if x < state
.winw
- conf
.scrollbw
3089 match self#elemunder
y with
3090 | None
-> Wsi.setcursor
Wsi.CURSOR_INHERIT
; m_active
3091 | Some
n -> Wsi.setcursor
Wsi.CURSOR_INFO
; n
3095 then (G.postRedisplay "listview pmotion"; {< m_active
= n >})
3100 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
3104 method infochanged
_ = ()
3106 method scrollpw
= (0, 0.0, 0.0)
3108 let nfs = fstate
.fontsize
+ 1 in
3109 let y = m_first
* nfs in
3110 let itemcount = source#getitemcount
in
3111 let maxi = max
0 (itemcount - fstate
.maxrows
) in
3112 let maxy = maxi * nfs in
3113 let p, h = scrollph y maxy in
3116 method modehash
= modehash
3117 method eformsgs
= false
3118 method alwaysscrolly
= true
3121 class outlinelistview ~zebra ~source
=
3122 let settext autonarrow
s =
3125 let ss = source#statestr
in
3129 else "{" ^
ss ^
"} [" ^
s ^
"]"
3130 else state
.text <- s
3136 ~source
:(source
:> lvsource
)
3138 ~modehash
:(findkeyhash conf
"outline")
3141 val m_autonarrow
= false
3143 method! key key mask
=
3145 if emptystr state
.text
3147 else fstate
.maxrows - 2
3149 let calcfirst first active =
3152 let rows = active - first in
3153 if rows > maxrows then active - maxrows else first
3157 let active = m_active
+ incr in
3158 let active = bound
active 0 (source#getitemcount
- 1) in
3159 let first = calcfirst m_first
active in
3160 G.postRedisplay "outline navigate";
3161 coe {< m_active
= active; m_first
= first >}
3163 let navscroll first =
3165 let dist = m_active
- first in
3171 else first + maxrows
3174 G.postRedisplay "outline navscroll";
3175 coe {< m_first
= first; m_active
= active >}
3177 let ctrl = Wsi.withctrl mask
in
3182 then (source#denarrow
; E.s)
3184 let pattern = source#renarrow
in
3185 if nonemptystr m_qsearch
3186 then (source#narrow m_qsearch
; m_qsearch
)
3190 settext (not m_autonarrow
) text;
3191 G.postRedisplay "toggle auto narrowing";
3192 coe {< m_first
= 0; m_active
= 0; m_autonarrow
= not m_autonarrow
>}
3194 | @slash
when emptystr m_qsearch
&& not m_autonarrow
->
3196 G.postRedisplay "toggle auto narrowing";
3197 coe {< m_first
= 0; m_active
= 0; m_autonarrow
= true >}
3200 source#narrow m_qsearch
;
3202 then source#add_narrow_pattern m_qsearch
;
3203 G.postRedisplay "outline ctrl-n";
3204 coe {< m_first
= 0; m_active
= 0 >}
3207 let active = source#calcactive
(getanchor
()) in
3208 let first = firstof m_first
active in
3209 G.postRedisplay "outline ctrl-s";
3210 coe {< m_first
= first; m_active
= active >}
3213 G.postRedisplay "outline ctrl-u";
3214 if m_autonarrow
&& nonemptystr m_qsearch
3216 ignore
(source#renarrow
);
3217 settext m_autonarrow
E.s;
3218 coe {< m_first
= 0; m_active
= 0; m_qsearch
= E.s >}
3221 source#del_narrow_pattern
;
3222 let pattern = source#renarrow
in
3224 if emptystr
pattern then E.s else "Narrowed to " ^
pattern
3226 settext m_autonarrow
text;
3227 coe {< m_first
= 0; m_active
= 0; m_qsearch
= E.s >}
3231 let first = max
0 (m_active
- (fstate
.maxrows / 2)) in
3232 G.postRedisplay "outline ctrl-l";
3233 coe {< m_first
= first >}
3235 | @tab
when m_autonarrow
->
3236 if nonemptystr m_qsearch
3238 G.postRedisplay "outline list view tab";
3239 source#add_narrow_pattern m_qsearch
;
3241 coe {< m_qsearch
= E.s >}
3245 | @escape
when m_autonarrow
->
3246 if nonemptystr m_qsearch
3247 then source#add_narrow_pattern m_qsearch
;
3250 | @enter
| @kpenter
when m_autonarrow
->
3251 if nonemptystr m_qsearch
3252 then source#add_narrow_pattern m_qsearch
;
3255 | key when m_autonarrow
&& (not
(Wsi.isspecialkey
key)) ->
3256 let pattern = m_qsearch ^ toutf8
key in
3257 G.postRedisplay "outlinelistview autonarrow add";
3258 source#narrow
pattern;
3259 settext true pattern;
3260 coe {< m_first
= 0; m_active
= 0; m_qsearch
= pattern >}
3262 | key when m_autonarrow
&& key = @backspace
->
3263 if emptystr m_qsearch
3266 let pattern = withoutlastutf8 m_qsearch
in
3267 G.postRedisplay "outlinelistview autonarrow backspace";
3268 ignore
(source#renarrow
);
3269 source#narrow
pattern;
3270 settext true pattern;
3271 coe {< m_first
= 0; m_active
= 0; m_qsearch
= pattern >}
3273 | @up
| @kpup
when ctrl ->
3274 navscroll (max
0 (m_first
- 1))
3276 | @down
| @kpdown
when ctrl ->
3277 navscroll (min
(source#getitemcount
- 1) (m_first
+ 1))
3279 | @up
| @kpup
-> navigate ~
-1
3280 | @down
| @kpdown
-> navigate 1
3281 | @prior
| @kpprior
-> navigate ~
-(fstate
.maxrows)
3282 | @next | @kpnext
-> navigate fstate
.maxrows
3284 | @right
| @kpright
->
3288 G.postRedisplay "outline ctrl right";
3289 {< m_pan
= m_pan
+ 1 >}
3291 else self#updownlevel
1
3295 | @left | @kpleft
->
3299 G.postRedisplay "outline ctrl left";
3300 {< m_pan
= m_pan
- 1 >}
3302 else self#updownlevel ~
-1
3306 | @home
| @kphome
->
3307 G.postRedisplay "outline home";
3308 coe {< m_first
= 0; m_active
= 0 >}
3311 let active = source#getitemcount
- 1 in
3312 let first = max
0 (active - fstate
.maxrows) in
3313 G.postRedisplay "outline end";
3314 coe {< m_active
= active; m_first
= first >}
3316 | _ -> super#
key key mask
3319 let genhistoutlines () =
3321 |> List.sort
(fun (_, c1
, _, _, _, _) (_, c2
, _, _, _, _) ->
3322 compare c2
.lastvisit c1
.lastvisit
)
3324 (fun ((path
, c, _, _, _, origin
) as hist
) ->
3325 let path = if nonemptystr origin
then origin
else path in
3326 let base = mbtoutf8
@@ Filename.basename
path in
3327 (base ^
"\000" ^
c.title
, 1, Ohistory hist
)
3332 let gotohist (path, c, bookmarks
, x, anchor, origin
) =
3333 Config.save
leavebirdseye;
3334 state
.anchor <- anchor;
3335 state
.bookmarks
<- bookmarks
;
3336 state
.origin
<- origin
;
3339 let x0, y0, x1, y1 = conf
.trimfuzz
in
3340 wcmd "trimset %d %d %d %d %d" (btod conf
.trimmargins
) x0 y0 x1 y1;
3341 reshape ~firsttime
:true state
.winw state
.winh
;
3342 opendoc path origin
;
3346 let makecheckers () =
3347 (* Based on lablGL-1.04/LablGlut/examples/lablGL/checker.ml which had
3349 converted by Issac Trotts. July 25, 2002 *)
3350 let image = GlPix.create `ubyte ~format
:`luminance ~width
:2 ~height
:2 in
3351 Raw.sets_string
(GlPix.to_raw
image) ~
pos:0 "\255\200\200\255";
3352 let id = GlTex.gen_texture
() in
3353 GlTex.bind_texture ~target
:`texture_2d
id;
3354 GlPix.store
(`unpack_alignment
1);
3355 GlTex.image2d
image;
3356 List.iter
(GlTex.parameter ~target
:`texture_2d
)
3357 [ `mag_filter `nearest
; `min_filter `nearest
];
3361 let setcheckers enabled
=
3362 match state
.checkerstexid
with
3364 if enabled
then state
.checkerstexid
<- Some
(makecheckers ())
3366 | Some checkerstexid
->
3369 GlTex.delete_texture checkerstexid
;
3370 state
.checkerstexid
<- None
;
3374 let describe_location () =
3375 let fn = page_of_y state
.y in
3376 let ln = page_of_y
(state
.y + state
.winh
- hscrollh () - 1) in
3377 let maxy = state
.maxy - (if conf
.maxhfit
then state
.winh
else 0) in
3381 else (100. *. (float state
.y /. float maxy))
3385 Printf.sprintf
"page %d of %d [%.2f%%]"
3386 (fn+1) state
.pagecount
percent
3389 "pages %d-%d of %d [%.2f%%]"
3390 (fn+1) (ln+1) state
.pagecount
percent
3393 let setpresentationmode v
=
3394 let n = page_of_y state
.y in
3395 state
.anchor <- (n, 0.0, 1.0);
3396 conf
.presentation
<- v
;
3397 if conf
.fitmodel
= FitPage
3398 then reqlayout conf
.angle conf
.fitmodel
;
3402 let setbgcol (r
, g, b) =
3404 let r = r *. 255.0 |> truncate
3405 and g = g *. 255.0 |> truncate
3406 and b = b *. 255.0 |> truncate
in
3407 r lsl 16 |> (lor) (g lsl 8) |> (lor) b
3409 Wsi.setwinbgcol
col;
3413 let btos b = if b then "@Uradical" else E.s in
3414 let showextended = ref false in
3415 let leave mode
_ = state
.mode
<- mode
in
3418 val mutable m_l
= []
3419 val mutable m_a
= E.a
3420 val mutable m_prev_uioh
= nouioh
3421 val mutable m_prev_mode
= View
3423 inherit lvsourcebase
3425 method reset prev_mode prev_uioh
=
3426 m_a
<- Array.of_list
(List.rev m_l
);
3428 m_prev_mode
<- prev_mode
;
3429 m_prev_uioh
<- prev_uioh
;
3431 method int name get
set =
3433 (name
, `
int get
, 1, Action
(
3436 try set (int_of_string
s)
3438 state
.text <- Printf.sprintf
"bad integer `%s': %s"
3442 let te = name ^
": ", E.s, None
, intentry, ondone, true in
3443 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3447 method int_with_suffix name get
set =
3449 (name
, `intws get
, 1, Action
(
3452 try set (int_of_string_with_suffix
s)
3454 state
.text <- Printf.sprintf
"bad integer `%s': %s"
3459 name ^
": ", E.s, None
, intentry_with_suffix, ondone, true
3461 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3465 method bool ?
(offset
=1) ?
(btos=btos) name get
set =
3467 (name
, `
bool (btos, get
), offset
, Action
(
3474 method color name get
set =
3476 (name
, `
color get
, 1, Action
(
3478 let invalid = (nan
, nan
, nan
) in
3481 try color_of_string
s
3483 state
.text <- Printf.sprintf
"bad color `%s': %s"
3490 let te = name ^
": ", E.s, None
, textentry, ondone, true in
3491 state
.text <- color_to_string
(get
());
3492 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3496 method string name get
set =
3498 (name
, `
string get
, 1, Action
(
3500 let ondone s = set s in
3501 let te = name ^
": ", E.s, None
, textentry, ondone, true in
3502 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3506 method colorspace name get
set =
3508 (name
, `
string get
, 1, Action
(
3512 inherit lvsourcebase
3515 m_active
<- CSTE.to_int conf
.colorspace
;
3518 method getitemcount
=
3519 Array.length
CSTE.names
3522 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3523 ignore
(uioh
, first, pan
);
3524 if not cancel
then set active;
3526 method hasaction
_ = true
3530 let modehash = findkeyhash conf
"info" in
3531 coe (new listview ~zebra
:false ~helpmode
:false
3532 ~
source ~trusted
:true ~
modehash)
3535 method paxmark name get
set =
3537 (name
, `
string get
, 1, Action
(
3541 inherit lvsourcebase
3544 m_active
<- MTE.to_int conf
.paxmark
;
3547 method getitemcount
= Array.length
MTE.names
3548 method getitem
n = (MTE.names
.(n), 0)
3549 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3550 ignore
(uioh
, first, pan
);
3551 if not cancel
then set active;
3553 method hasaction
_ = true
3557 let modehash = findkeyhash conf
"info" in
3558 coe (new listview ~zebra
:false ~helpmode
:false
3559 ~
source ~trusted
:true ~
modehash)
3562 method fitmodel name get
set =
3564 (name
, `
string get
, 1, Action
(
3568 inherit lvsourcebase
3571 m_active
<- FMTE.to_int conf
.fitmodel
;
3574 method getitemcount
= Array.length
FMTE.names
3575 method getitem
n = (FMTE.names
.(n), 0)
3576 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3577 ignore
(uioh
, first, pan
);
3578 if not cancel
then set active;
3580 method hasaction
_ = true
3584 let modehash = findkeyhash conf
"info" in
3585 coe (new listview ~zebra
:false ~helpmode
:false
3586 ~
source ~trusted
:true ~
modehash)
3589 method caption
s offset
=
3590 m_l
<- (s, `empty
, offset
, Noaction
) :: m_l
3592 method caption2
s f offset
=
3593 m_l
<- (s, `
string f, offset
, Noaction
) :: m_l
3595 method getitemcount
= Array.length m_a
3598 let tostr = function
3599 | `
int f -> string_of_int
(f ())
3600 | `intws
f -> string_with_suffix_of_int
(f ())
3602 | `
color f -> color_to_string
(f ())
3603 | `
bool (btos, f) -> btos (f ())
3606 let name, t
, offset
, _ = m_a
.(n) in
3607 ((let s = tostr t
in
3609 then Printf.sprintf
"%s\t%s" name s
3613 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3618 match m_a
.(active) with
3619 | _, _, _, Action
f -> f uioh
3620 | _, _, _, Noaction
-> uioh
3631 method hasaction
n =
3633 | _, _, _, Action
_ -> true
3634 | _, _, _, Noaction
-> false
3636 initializer m_active
<- 1
3639 let rec fillsrc prevmode prevuioh
=
3640 let sep () = src#caption
E.s 0 in
3641 let colorp name get
set =
3643 (fun () -> color_to_string
(get
()))
3646 let c = color_of_string
v in
3649 state
.text <- Printf.sprintf
"bad color `%s': %s" v @@ exntos exn
3652 let oldmode = state
.mode
in
3653 let birdseye = isbirdseye state
.mode
in
3655 src#caption
(if birdseye then "Setup (Bird's eye)" else "Setup") 0;
3657 src#
bool "presentation mode"
3658 (fun () -> conf
.presentation
)
3659 (fun v -> setpresentationmode v);
3661 src#
bool "ignore case in searches"
3662 (fun () -> conf
.icase
)
3663 (fun v -> conf
.icase
<- v);
3666 (fun () -> conf
.preload)
3667 (fun v -> conf
.preload <- v);
3669 src#
bool "highlight links"
3670 (fun () -> conf
.hlinks
)
3671 (fun v -> conf
.hlinks
<- v);
3673 src#
bool "under info"
3674 (fun () -> conf
.underinfo
)
3675 (fun v -> conf
.underinfo
<- v);
3677 src#
bool "persistent bookmarks"
3678 (fun () -> conf
.savebmarks
)
3679 (fun v -> conf
.savebmarks
<- v);
3681 src#fitmodel
"fit model"
3682 (fun () -> FMTE.to_string conf
.fitmodel
)
3683 (fun v -> reqlayout conf
.angle
(FMTE.of_int
v));
3685 src#
bool "trim margins"
3686 (fun () -> conf
.trimmargins
)
3687 (fun v -> settrim v conf
.trimfuzz
; fillsrc prevmode prevuioh
);
3689 src#
bool "persistent location"
3690 (fun () -> conf
.jumpback
)
3691 (fun v -> conf
.jumpback
<- v);
3694 src#
int "inter-page space"
3695 (fun () -> conf
.interpagespace
)
3697 conf
.interpagespace
<- n;
3698 docolumns conf
.columns
;
3700 match state
.layout with
3705 state
.maxy <- calcheight
();
3706 let y = getpagey
pageno in
3707 gotoxy state
.x (y + py)
3711 (fun () -> conf
.pagebias
)
3712 (fun v -> conf
.pagebias
<- v);
3714 src#
int "scroll step"
3715 (fun () -> conf
.scrollstep
)
3716 (fun n -> conf
.scrollstep
<- n);
3718 src#
int "horizontal scroll step"
3719 (fun () -> conf
.hscrollstep
)
3720 (fun v -> conf
.hscrollstep
<- v);
3722 src#
int "auto scroll step"
3724 match state
.autoscroll
with
3726 | _ -> conf
.autoscrollstep
)
3728 let n = boundastep state
.winh
n in
3729 if state
.autoscroll
<> None
3730 then state
.autoscroll
<- Some
n;
3731 conf
.autoscrollstep
<- n);
3734 (fun () -> truncate
(conf
.zoom *. 100.))
3735 (fun v -> setzoom ((float v) /. 100.));
3738 (fun () -> conf
.angle
)
3739 (fun v -> reqlayout v conf
.fitmodel
);
3741 src#
int "scroll bar width"
3742 (fun () -> conf
.scrollbw
)
3745 reshape state
.winw state
.winh
;
3748 src#
int "scroll handle height"
3749 (fun () -> conf
.scrollh
)
3750 (fun v -> conf
.scrollh
<- v;);
3752 src#
int "thumbnail width"
3753 (fun () -> conf
.thumbw
)
3755 conf
.thumbw
<- min
4096 v;
3758 leavebirdseye beye
false;
3765 let mode = state
.mode in
3766 src#
string "columns"
3768 match conf
.columns
with
3770 | Cmulti
(multi
, _) -> multicolumns_to_string multi
3771 | Csplit
(count
, _) -> "-" ^ string_of_int count
3774 let n, a, b = multicolumns_of_string
v in
3775 setcolumns mode n a b);
3778 src#caption
"Pixmap cache" 0;
3779 src#int_with_suffix
"size (advisory)"
3780 (fun () -> conf
.memlimit
)
3781 (fun v -> conf
.memlimit
<- v);
3784 (fun () -> Printf.sprintf
"%s bytes, %d tiles"
3785 (string_with_suffix_of_int state
.memused
)
3786 (Hashtbl.length state
.tilemap
)) 1;
3789 src#caption
"Layout" 0;
3790 src#caption2
"Dimension"
3792 Printf.sprintf
"%dx%d (virtual %dx%d)"
3793 state
.winw state
.winh
3798 src#caption2
"Position" (fun () ->
3799 Printf.sprintf
"%dx%d" state
.x state
.y
3802 src#caption2
"Position" (fun () -> describe_location ()) 1
3806 src#
bool ~offset
:0 ~
btos:(fun v -> if v then "(on)" else "(off)")
3807 "Save these parameters as global defaults at exit"
3808 (fun () -> conf
.bedefault
)
3809 (fun v -> conf
.bedefault
<- v)
3813 let btos b = if b then "@Ulguillemet" else "@Urguillemet" in
3814 src#
bool ~offset
:0 ~
btos "Extended parameters"
3815 (fun () -> !showextended)
3816 (fun v -> showextended := v; fillsrc prevmode prevuioh
);
3820 (fun () -> conf
.checkers
)
3821 (fun v -> conf
.checkers
<- v; setcheckers v);
3822 src#
bool "update cursor"
3823 (fun () -> conf
.updatecurs
)
3824 (fun v -> conf
.updatecurs
<- v);
3825 src#
bool "scroll-bar on the left"
3826 (fun () -> conf
.leftscroll
)
3827 (fun v -> conf
.leftscroll
<- v);
3829 (fun () -> conf
.verbose
)
3830 (fun v -> conf
.verbose
<- v);
3831 src#
bool "invert colors"
3832 (fun () -> conf
.invert
)
3833 (fun v -> conf
.invert
<- v);
3835 (fun () -> conf
.maxhfit
)
3836 (fun v -> conf
.maxhfit
<- v);
3838 (fun () -> conf
.pax
!= None
)
3841 then conf
.pax
<- Some
(ref (now
(), 0, 0))
3842 else conf
.pax
<- None
);
3843 src#
string "uri launcher"
3844 (fun () -> conf
.urilauncher
)
3845 (fun v -> conf
.urilauncher
<- v);
3846 src#
string "path launcher"
3847 (fun () -> conf
.pathlauncher
)
3848 (fun v -> conf
.pathlauncher
<- v);
3849 src#
string "tile size"
3850 (fun () -> Printf.sprintf
"%dx%d" conf
.tilew conf
.tileh
)
3853 let w, h = Scanf.sscanf
v "%dx%d" (fun w h -> w, h) in
3854 conf
.tilew
<- max
64 w;
3855 conf
.tileh
<- max
64 h;
3858 state
.text <- Printf.sprintf
"bad tile size `%s': %s"
3861 src#
int "texture count"
3862 (fun () -> conf
.texcount
)
3865 then conf
.texcount
<- v
3866 else impmsg "failed to set texture count please retry later"
3868 src#
int "slice height"
3869 (fun () -> conf
.sliceheight
)
3871 conf
.sliceheight
<- v;
3872 wcmd "sliceh %d" conf
.sliceheight
;
3874 src#
int "anti-aliasing level"
3875 (fun () -> conf
.aalevel
)
3877 conf
.aalevel
<- bound
v 0 8;
3878 state
.anchor <- getanchor
();
3879 opendoc state
.path state
.password;
3881 src#
string "page scroll scaling factor"
3882 (fun () -> string_of_float conf
.pgscale)
3885 let s = float_of_string
v in
3888 state
.text <- Printf.sprintf
3889 "bad page scroll scaling factor `%s': %s" v @@ exntos exn
3892 src#
int "ui font size"
3893 (fun () -> fstate
.fontsize
)
3894 (fun v -> setfontsize (bound
v 5 100));
3895 src#
int "hint font size"
3896 (fun () -> conf
.hfsize
)
3897 (fun v -> conf
.hfsize
<- bound
v 5 100);
3898 colorp "background color"
3899 (fun () -> conf
.bgcolor
)
3900 (fun v -> conf
.bgcolor
<- v; setbgcol v);
3901 src#
bool "crop hack"
3902 (fun () -> conf
.crophack
)
3903 (fun v -> conf
.crophack
<- v);
3904 src#
string "trim fuzz"
3905 (fun () -> irect_to_string conf
.trimfuzz
)
3908 conf
.trimfuzz
<- irect_of_string
v;
3910 then settrim true conf
.trimfuzz
;
3912 state
.text <- Printf.sprintf
"bad irect `%s': %s" v @@ exntos exn
3914 src#
string "throttle"
3916 match conf
.maxwait
with
3917 | None
-> "show place holder if page is not ready"
3920 then "wait for page to fully render"
3922 "wait " ^ string_of_float
time
3923 ^
" seconds before showing placeholder"
3927 let f = float_of_string
v in
3929 then conf
.maxwait
<- None
3930 else conf
.maxwait
<- Some
f
3932 state
.text <- Printf.sprintf
"bad time `%s': %s" v @@ exntos exn
3934 src#
string "ghyll scroll"
3936 match conf
.ghyllscroll
with
3938 | Some nab
-> ghyllscroll_to_string nab
3941 try conf
.ghyllscroll
<- ghyllscroll_of_string
v
3944 state
.text <- Printf.sprintf
"bad ghyll `%s': %s" v msg
3946 state
.text <- Printf.sprintf
"bad ghyll `%s': %s" v @@ exntos exn
3948 src#
string "selection command"
3949 (fun () -> conf
.selcmd
)
3950 (fun v -> conf
.selcmd
<- v);
3951 src#
string "synctex command"
3952 (fun () -> conf
.stcmd
)
3953 (fun v -> conf
.stcmd
<- v);
3954 src#
string "pax command"
3955 (fun () -> conf
.paxcmd
)
3956 (fun v -> conf
.paxcmd
<- v);
3957 src#
string "ask password command"
3958 (fun () -> conf
.passcmd)
3959 (fun v -> conf
.passcmd <- v);
3960 src#
string "save path command"
3961 (fun () -> conf
.savecmd
)
3962 (fun v -> conf
.savecmd
<- v);
3963 src#colorspace
"color space"
3964 (fun () -> CSTE.to_string conf
.colorspace
)
3966 conf
.colorspace
<- CSTE.of_int
v;
3970 src#paxmark
"pax mark method"
3971 (fun () -> MTE.to_string conf
.paxmark
)
3972 (fun v -> conf
.paxmark
<- MTE.of_int
v);
3973 if bousable
() && !opengl_has_pbo
3976 (fun () -> conf
.usepbo
)
3977 (fun v -> conf
.usepbo
<- v);
3978 src#
bool "mouse wheel scrolls pages"
3979 (fun () -> conf
.wheelbypage
)
3980 (fun v -> conf
.wheelbypage
<- v);
3981 src#
bool "open remote links in a new instance"
3982 (fun () -> conf
.riani
)
3983 (fun v -> conf
.riani
<- v);
3984 src#
bool "edit annotations inline"
3985 (fun () -> conf
.annotinline
)
3986 (fun v -> conf
.annotinline
<- v);
3987 src#
bool "coarse positioning in presentation mode"
3988 (fun () -> conf
.coarseprespos
)
3989 (fun v -> conf
.coarseprespos
<- v);
3993 src#caption
"Document" 0;
3994 List.iter
(fun (_, s) -> src#caption
s 1) state
.docinfo
;
3995 src#caption2
"Pages"
3996 (fun () -> string_of_int state
.pagecount
) 1;
3997 src#caption2
"Dimensions"
3998 (fun () -> string_of_int
(List.length state
.pdims
)) 1;
4002 src#caption
"Trimmed margins" 0;
4003 src#caption2
"Dimensions"
4004 (fun () -> string_of_int
(List.length state
.pdims
)) 1;
4008 src#caption
"OpenGL" 0;
4009 src#caption
(Printf.sprintf
"Vendor\t%s" (GlMisc.get_string `vendor
)) 1;
4010 src#caption
(Printf.sprintf
"Renderer\t%s" (GlMisc.get_string `renderer
)) 1;
4013 src#caption
"Location" 0;
4014 if nonemptystr state
.origin
4015 then src#caption
("Orign\t" ^ mbtoutf8 state
.origin
) 1;
4016 src#caption
("Path\t" ^ mbtoutf8 state
.path) 1;
4018 src#reset prevmode prevuioh
;
4023 let prevmode = state
.mode
4024 and prevuioh
= state
.uioh in
4025 fillsrc prevmode prevuioh
;
4026 let source = (src :> lvsource
) in
4027 let modehash = findkeyhash conf
"info" in
4028 state
.uioh <- coe (object (self)
4029 inherit listview ~zebra
:false ~helpmode
:false
4030 ~
source ~trusted
:true ~
modehash as super
4031 val mutable m_prevmemused
= 0
4032 method! infochanged
= function
4034 if m_prevmemused
!= state
.memused
4036 m_prevmemused
<- state
.memused
;
4037 G.postRedisplay "memusedchanged";
4039 | Pdim
-> G.postRedisplay "pdimchanged"
4040 | Docinfo
-> fillsrc prevmode prevuioh
4042 method! key key mask
=
4043 if not
(Wsi.withctrl mask
)
4046 | @left | @kpleft
-> coe (self#updownlevel ~
-1)
4047 | @right
| @kpright
-> coe (self#updownlevel
1)
4048 | _ -> super#
key key mask
4049 else super#
key key mask
4051 G.postRedisplay "info";
4057 inherit lvsourcebase
4058 method getitemcount
= Array.length state
.help
4060 let s, l, _ = state
.help
.(n) in
4063 method exit ~
uioh ~cancel ~
active ~
first ~pan
=
4067 match state
.help
.(active) with
4068 | _, _, Action
f -> Some
(f uioh)
4069 | _, _, Noaction
-> Some
uioh
4078 method hasaction
n =
4079 match state
.help
.(n) with
4080 | _, _, Action
_ -> true
4081 | _, _, Noaction
-> false
4087 let modehash = findkeyhash conf
"help" in
4089 state
.uioh <- coe (new listview
4090 ~zebra
:false ~helpmode
:true
4091 ~
source ~trusted
:true ~
modehash);
4092 G.postRedisplay "help";
4098 inherit lvsourcebase
4099 val mutable m_items
= E.a
4101 method getitemcount
= 1 + Array.length m_items
4106 else m_items
.(n-1), 0
4108 method exit ~
uioh ~cancel ~
active ~
first ~pan
=
4113 then Buffer.clear state
.errmsgs
;
4120 method hasaction
n =
4124 state
.newerrmsgs
<- false;
4125 let l = Str.split newlinere
(Buffer.contents state
.errmsgs
) in
4126 m_items
<- Array.of_list
l
4135 let source = (msgsource :> lvsource
) in
4136 let modehash = findkeyhash conf
"listview" in
4137 state
.uioh <- coe (object
4138 inherit listview ~zebra
:false ~helpmode
:false
4139 ~
source ~trusted
:false ~
modehash as super
4142 then msgsource#reset
;
4145 G.postRedisplay "msgs";
4149 let editor = getenvwithdef
"EDITOR" E.s in
4153 let tmppath = Filename.temp_file
"llpp" "note" in
4156 let oc = open_out
tmppath in
4160 let execstr = editor ^
" " ^
tmppath in
4162 match spawn
execstr [] with
4163 | (exception exn
) ->
4164 impmsg "spawn(%S) failed: %s" execstr @@ exntos exn
;
4167 match Unix.waitpid
[] pid with
4168 | (exception exn
) ->
4169 impmsg "waitpid(%d) failed: %s" pid @@ exntos exn
;
4173 | Unix.WEXITED
0 -> filecontents
tmppath
4175 impmsg "editor process(%s) exited abnormally: %d" execstr n;
4177 | Unix.WSIGNALED
n ->
4178 impmsg "editor process(%s) was killed by signal %d" execstr n;
4180 | Unix.WSTOPPED
n ->
4181 impmsg "editor(%s) process was stopped by signal %d" execstr n;
4184 match Unix.unlink
tmppath with
4185 | (exception exn
) ->
4186 impmsg "failed to ulink %S: %s" tmppath @@ exntos exn
;
4191 let enterannotmode opaque slinkindex
=
4194 inherit lvsourcebase
4195 val mutable m_text
= E.s
4196 val mutable m_items
= E.a
4198 method getitemcount
= Array.length m_items
4201 let label, _func
= m_items
.(n) in
4204 method exit ~
uioh ~cancel ~
active ~
first ~pan
=
4205 ignore
(uioh, first, pan
);
4208 let _label, func
= m_items
.(active) in
4213 method hasaction
n = nonemptystr
@@ fst m_items
.(n)
4216 let rec split accu b i
=
4218 if p = String.length
s
4219 then (String.sub
s b (p-b), unit) :: accu
4221 if (i
> 70 && s.[p] = ' '
) || s.[p] = '
\r'
|| s.[p] = '
\n'
4223 let ss = if i
= 0 then E.s else String.sub
s b i
in
4224 split ((ss, unit)::accu) (p+1) 0
4229 wcmd "freepage %s" (~
> opaque);
4231 Hashtbl.fold (fun key opaque'
accu ->
4232 if opaque'
= opaque'
4233 then key :: accu else accu) state
.pagemap
[]
4235 List.iter
(Hashtbl.remove state
.pagemap
) keys;
4237 gotoxy state
.x state
.y
4240 delannot
opaque slinkindex
;
4243 let edit inline
() =
4248 modannot
opaque slinkindex
s;
4254 let mode = state
.mode in
4257 ("annotation: ", m_text
, None
, textentry, update, true),
4258 fun _ -> state
.mode <- mode);
4262 let s = getusertext m_text
in
4267 ( "[Copy]", fun () -> selstring m_text
)
4268 :: ("[Delete]", dele)
4269 :: ("[Edit]", edit conf
.annotinline
)
4271 :: split [] 0 0 |> List.rev
|> Array.of_list
4278 let s = getannotcontents
opaque slinkindex
in
4281 let source = (msgsource :> lvsource
) in
4282 let modehash = findkeyhash conf
"listview" in
4283 state
.uioh <- coe (object
4284 inherit listview ~zebra
:false ~helpmode
:false
4285 ~
source ~trusted
:false ~
modehash
4287 G.postRedisplay "enterannotmode";
4290 let gotounder under =
4291 let getpath filename
=
4293 if nonemptystr filename
4295 if Filename.is_relative filename
4297 let dir = Filename.dirname state
.path in
4299 if Filename.is_implicit
dir
4300 then Filename.concat
(Sys.getcwd
()) dir
4303 Filename.concat
dir filename
4307 if Sys.file_exists
path
4312 | Ulinkgoto
(pageno, top) ->
4317 if conf
.presentation
&& conf
.coarseprespos
4321 gotopage1 pageno top;
4324 | Ulinkuri
s -> gotouri
s
4326 | Uremote
(filename
, pageno) ->
4327 let path = getpath filename
in
4332 let command = Printf.sprintf
"%s -page %d %S" !selfexec pageno path in
4333 match spawn
command [] with
4335 | (exception exn
) ->
4336 dolog
"failed to execute `%s': %s" command @@ exntos exn
4338 let anchor = getanchor
() in
4339 let ranchor = state
.path, state
.password, anchor, state
.origin
in
4340 state
.origin
<- E.s;
4341 state
.anchor <- (pageno, 0.0, 0.0);
4342 state
.ranchors
<- ranchor :: state
.ranchors
;
4345 else impmsg "cannot find %s" filename
4347 | Uremotedest
(filename
, destname
) ->
4348 let path = getpath filename
in
4353 let command = !selfexec ^
" " ^
path ^
" -dest " ^ destname
in
4354 match spawn
command [] with
4355 | (exception exn
) ->
4356 dolog
"failed to execute `%s': %s" command @@ exntos exn
4359 let anchor = getanchor
() in
4360 let ranchor = state
.path, state
.password, anchor, state
.origin
in
4361 state
.origin
<- E.s;
4362 state
.nameddest
<- destname
;
4363 state
.ranchors
<- ranchor :: state
.ranchors
;
4366 else impmsg "cannot find %s" filename
4368 | Uunexpected
_ | Ulaunch
_ | Unamed
_ | Utext
_ | Unone
-> ()
4369 | Uannotation
(opaque, slinkindex
) -> enterannotmode opaque slinkindex
4372 let gotooutline (_, _, kind
) =
4376 let (pageno, y, _) = anchor in
4378 (if conf
.presentation
then (pageno, y, 1.0) else anchor)
4382 | Ouri
uri -> gotounder (Ulinkuri
uri)
4383 | Olaunch cmd
-> gotounder (Ulaunch cmd
)
4384 | Oremote remote
-> gotounder (Uremote remote
)
4385 | Ohistory hist
-> gotohist hist
4386 | Oremotedest remotedest
-> gotounder (Uremotedest remotedest
)
4389 class outlinesoucebase fetchoutlines
= object (self)
4390 inherit lvsourcebase
4391 val mutable m_items
= E.a
4392 val mutable m_minfo
= E.a
4393 val mutable m_orig_items
= E.a
4394 val mutable m_orig_minfo
= E.a
4395 val mutable m_narrow_patterns
= []
4396 val mutable m_gen
= -1
4398 method getitemcount
= Array.length m_items
4401 let s, n, _ = m_items
.(n) in
4404 method exit ~
(uioh:uioh) ~cancel ~
active ~
(first:int) ~pan
:
4406 ignore
(uioh, first);
4408 if m_narrow_patterns
= []
4409 then m_orig_items
, m_orig_minfo
4410 else m_items
, m_minfo
4417 gotooutline m_items
.(active);
4425 method hasaction
(_:int) = true
4428 if Array.length m_items
!= Array.length m_orig_items
4431 match m_narrow_patterns
with
4433 | many
-> String.concat
"@Uellipsis" (List.rev many
)
4435 "Narrowed to " ^
s ^
" (ctrl-u to restore)"
4439 match m_narrow_patterns
with
4442 | head
:: _ -> "@Uellipsis" ^ head
4444 method narrow
pattern =
4445 match Str.regexp_case_fold
pattern with
4446 | (exception _) -> ()
4448 let rec loop accu minfo n =
4451 m_items
<- Array.of_list
accu;
4452 m_minfo
<- Array.of_list
minfo;
4455 let (s, _, _) as o = m_items
.(n) in
4457 match Str.search_forward re
s 0 with
4458 | (exception Not_found
) -> accu, minfo
4459 | first -> o :: accu, (first, Str.match_end
()) :: minfo
4461 loop accu minfo (n-1)
4463 loop [] [] (Array.length m_items
- 1)
4465 method! getminfo
= m_minfo
4468 m_orig_items
<- fetchoutlines
();
4469 m_minfo
<- m_orig_minfo
;
4470 m_items
<- m_orig_items
4472 method add_narrow_pattern
pattern =
4473 m_narrow_patterns
<- pattern :: m_narrow_patterns
4475 method del_narrow_pattern
=
4476 match m_narrow_patterns
with
4477 | _ :: rest
-> m_narrow_patterns
<- rest
4482 match m_narrow_patterns
with
4483 | pattern :: [] -> self#narrow
pattern; pattern
4485 List.fold_left
(fun accu pattern ->
4486 self#narrow
pattern;
4487 pattern ^
"@Uellipsis" ^
accu) E.s list
4489 method calcactive
(_:anchor) = 0
4491 method reset
anchor items =
4492 if state
.gen
!= m_gen
4494 m_orig_items
<- items;
4496 m_narrow_patterns
<- [];
4498 m_orig_minfo
<- E.a;
4502 if items != m_orig_items
4504 m_orig_items
<- items;
4505 if m_narrow_patterns
== []
4506 then m_items
<- items;
4509 let active = self#calcactive
anchor in
4511 m_first
<- firstof m_first
active
4515 let outlinesource fetchoutlines
=
4517 inherit outlinesoucebase fetchoutlines
4518 method! calcactive
anchor =
4519 let rely = getanchory anchor in
4520 let rec loop n best bestd
=
4521 if n = Array.length m_items
4524 let _, _, kind
= m_items
.(n) in
4527 let orely = getanchory anchor in
4528 let d = abs
(orely - rely) in
4531 else loop (n+1) best bestd
4532 | Onone
| Oremote
_ | Olaunch
_
4533 | Oremotedest
_ | Ouri
_ | Ohistory
_ ->
4534 loop (n+1) best bestd
4540 let enteroutlinemode, enterbookmarkmode
, enterhistmode
=
4541 let mkselector sourcetype
=
4542 let fetchoutlines () =
4543 match sourcetype
with
4544 | `bookmarks
-> Array.of_list state
.bookmarks
4545 | `outlines
-> state
.outlines
4546 | `history
-> genhistoutlines ()
4549 if sourcetype
= `history
4550 then new outlinesoucebase
fetchoutlines
4551 else outlinesource fetchoutlines
4554 let outlines = fetchoutlines () in
4555 if Array.length
outlines = 0
4557 showtext ' ' errmsg
;
4561 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
4562 let anchor = getanchor
() in
4563 source#reset
anchor outlines;
4564 state
.text <- source#greetmsg
;
4566 coe (new outlinelistview ~zebra
:(sourcetype
=`history
) ~
source);
4567 G.postRedisplay "enter selector";
4570 let mkenter sourcetype errmsg
=
4571 let enter = mkselector sourcetype
in
4572 fun () -> enter errmsg
4574 (**)mkenter `
outlines "document has no outline"
4575 , mkenter `bookmarks
"document has no bookmarks (yet)"
4576 , mkenter `history
"history is empty"
4579 let quickbookmark ?title
() =
4580 match state
.layout with
4586 let tm = Unix.localtime
(now
()) in
4588 "Quick (page %d) (bookmarked at %02d/%02d/%d %02d:%02d)"
4592 (tm.Unix.tm_year
+ 1900)
4595 | Some
title -> title
4597 state
.bookmarks
<- (title, 0, Oanchor
(getanchor1
l)) :: state
.bookmarks
4600 let setautoscrollspeed step goingdown
=
4601 let incr = max
1 ((abs step
) / 2) in
4602 let incr = if goingdown
then incr else -incr in
4603 let astep = boundastep state
.winh
(step
+ incr) in
4604 state
.autoscroll
<- Some
astep;
4608 match conf
.columns
with
4610 | Csingle
_ | Cmulti
_ -> state
.x != 0 || conf
.zoom > 1.0
4613 let panbound x = bound
x (-state
.w) (wadjsb () + state
.winw
);;
4615 let existsinrow pageno (columns
, coverA
, coverB
) p =
4616 let last = ((pageno - coverA
) mod columns
) + columns
in
4617 let rec any = function
4620 if l.pageno = coverA
- 1 || l.pageno = state
.pagecount
- coverB
4624 then (if l.pageno = last then false else any rest
)
4632 match state
.layout with
4634 let pageno = page_of_y state
.y in
4635 gotoghyll (getpagey
(pageno+1))
4637 match conf
.columns
with
4639 if conf
.presentation
&& rest
== [] && l.pageh
> l.pagey + l.pagevh
4641 let y = clamp (pgscale state
.winh
) in
4644 let pageno = min
(l.pageno+1) (state
.pagecount
-1) in
4645 gotoghyll (getpagey
pageno)
4646 | Cmulti
((c, _, _) as cl
, _) ->
4647 if conf
.presentation
4648 && (existsinrow l.pageno cl
4649 (fun l -> l.pageh
> l.pagey + l.pagevh))
4651 let y = clamp (pgscale state
.winh
) in
4654 let pageno = min
(l.pageno+c) (state
.pagecount
-1) in
4655 gotoghyll (getpagey
pageno)
4657 if l.pageno < state
.pagecount
- 1 || l.pagecol
< n - 1
4659 let pagey, pageh
= getpageyh
l.pageno in
4660 let pagey = pagey + pageh
* l.pagecol
in
4661 let ips = if l.pagecol
= 0 then 0 else conf
.interpagespace
in
4662 gotoghyll (pagey + pageh
+ ips)
4666 match state
.layout with
4668 let pageno = page_of_y state
.y in
4669 gotoghyll (getpagey
(pageno-1))
4671 match conf
.columns
with
4673 if conf
.presentation
&& l.pagey != 0
4675 gotoghyll (clamp (pgscale ~
-(state
.winh
)))
4677 let pageno = max
0 (l.pageno-1) in
4678 gotoghyll (getpagey
pageno)
4679 | Cmulti
((c, _, coverB
) as cl
, _) ->
4680 if conf
.presentation
&&
4681 (existsinrow l.pageno cl
(fun l -> l.pagey != 0))
4683 gotoghyll (clamp (pgscale ~
-(state
.winh
)))
4686 if l.pageno = state
.pagecount
- coverB
4690 let pageno = max
0 (l.pageno-decr) in
4691 gotoghyll (getpagey
pageno)
4699 let pageno = max
0 (l.pageno-1) in
4700 let pagey, pageh
= getpageyh
pageno in
4703 let pagey, pageh
= getpageyh
l.pageno in
4704 pagey + pageh
* (l.pagecol
-1) - conf
.interpagespace
4710 if emptystr conf
.savecmd
4711 then error
"don't know where to save modified document"
4713 let savecmd = Str.global_replace percentsre state
.path conf
.savecmd in
4716 (fun s -> error
"failed to obtain path to the saved copy: %s" s)
4721 let tmp = path ^
".tmp" in
4723 Unix.rename
tmp path;
4726 let viewkeyboard key mask
=
4728 let mode = state
.mode in
4729 state
.mode <- Textentry
(te, fun _ -> state
.mode <- mode);
4732 G.postRedisplay "view:enttext"
4734 let ctrl = Wsi.withctrl mask
in
4735 let key = Wsi.keypadtodigitkey
key in
4740 if hasunsavedchanges
()
4744 if conf
.angle
mod 360 = 0 && not
(isbirdseye state
.mode)
4746 state
.mode <- LinkNav
(Ltgendir
0);
4747 gotoxy state
.x state
.y;
4749 else impmsg "keyboard link navigation does not work under rotation"
4752 begin match state
.mstate
with
4755 G.postRedisplay "kill rect";
4758 | Mscrolly
| Mscrollx
4761 begin match state
.mode with
4764 G.postRedisplay "esc leave linknav"
4768 match state
.ranchors
with
4770 | (path, password, anchor, origin
) :: rest
->
4771 state
.ranchors
<- rest
;
4772 state
.anchor <- anchor;
4773 state
.origin
<- origin
;
4774 state
.nameddest
<- E.s;
4775 opendoc path password
4780 gotoghyll (getnav ~
-1)
4791 Hashtbl.iter
(fun _ opaque ->
4793 Hashtbl.clear state
.prects
) state
.pagemap
;
4794 G.postRedisplay "dehighlight";
4796 | @slash
| @question
->
4797 let ondone isforw
s =
4798 cbput state
.hists
.pat
s;
4799 state
.searchpattern
<- s;
4802 let s = String.make
1 (Char.chr
key) in
4803 enttext (s, E.s, Some
(onhist state
.hists
.pat
),
4804 textentry, ondone (key = @slash
), true)
4806 | @plus
| @kpplus
| @equals
when ctrl ->
4807 let incr = if conf
.zoom +. 0.01 > 0.1 then 0.1 else 0.01 in
4808 pivotzoom (conf
.zoom +. incr)
4810 | @plus
| @kpplus
->
4813 try int_of_string
s with exn
->
4814 state
.text <- Printf.sprintf
"bad integer `%s': %s" s @@ exntos exn
;
4820 state
.text <- "page bias is now " ^ string_of_int
n;
4823 enttext ("page bias: ", E.s, None
, intentry, ondone, true)
4825 | @minus
| @kpminus
when ctrl ->
4826 let decr = if conf
.zoom -. 0.1 < 0.1 then 0.01 else 0.1 in
4827 pivotzoom (max
0.01 (conf
.zoom -. decr))
4829 | @minus
| @kpminus
->
4830 let ondone msg
= state
.text <- msg
in
4832 "option [acfhilpstvxACFPRSZTISM]: ", E.s, None
,
4833 optentry state
.mode, ondone, true
4838 then gotoxy 0 state
.y
4841 | (@1 | @2) when ctrl && conf
.fitmodel
!= FitPage
-> (* ctrl-1/2 *)
4843 match conf
.columns
with
4844 | Csingle
_ | Cmulti
_ -> 1
4845 | Csplit
(n, _) -> n
4847 let h = state
.winh
-
4848 conf
.interpagespace
lsl (if conf
.presentation
then 1 else 0)
4850 let zoom = zoomforh state
.winw
h (vscrollw ()) cols in
4851 if zoom > 0.0 && (key = @2 || zoom < 1.0)
4856 match conf
.fitmodel
with
4857 | FitWidth
-> FitProportional
4858 | FitProportional
-> FitPage
4859 | FitPage
-> FitWidth
4861 state
.text <- "fit model: " ^
FMTE.to_string
fm;
4862 reqlayout conf
.angle
fm
4864 | @4 when ctrl -> (* ctrl-4 *)
4865 let zoom = getmaxw
() /. float state
.winw
in
4866 if zoom > 0.0 then setzoom zoom
4874 | (48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57)
4875 when not
ctrl -> (* 0..9 *)
4878 try int_of_string
s with exn
->
4879 state
.text <- Printf.sprintf
"bad integer `%s': %s" s @@ exntos exn
;
4885 cbput state
.hists
.pag
(string_of_int
n);
4886 gotopage1 (n + conf
.pagebias
- 1) 0;
4889 let pageentry text key =
4890 match Char.unsafe_chr
key with
4891 | '
g'
-> TEdone
text
4892 | _ -> intentry text key
4894 let text = String.make
1 (Char.chr
key) in
4895 enttext (":", text, Some
(onhist state
.hists
.pag
),
4896 pageentry, ondone, true)
4899 conf
.scrollb
<- if conf
.scrollb
= 0 then (scrollbvv
lor scrollbhv
) else 0;
4900 reshape state
.winw state
.winh
;
4903 state
.bzoom
<- not state
.bzoom
;
4905 showtext ' '
("block zoom " ^
if state
.bzoom
then "on" else "off")
4908 conf
.hlinks
<- not conf
.hlinks
;
4909 state
.text <- "highlightlinks " ^
if conf
.hlinks
then "on" else "off";
4910 G.postRedisplay "toggle highlightlinks";
4913 if conf
.angle
mod 360 = 0
4915 state
.glinks
<- true;
4916 let mode = state
.mode in
4919 (":", E.s, None
, linknentry, linknact gotounder, false),
4921 state
.glinks
<- false;
4925 G.postRedisplay "view:linkent(F)"
4927 else impmsg "hint mode does not work under rotation"
4930 state
.glinks
<- true;
4931 let mode = state
.mode in
4932 state
.mode <- Textentry
(
4934 ":", E.s, None
, linknentry, linknact (fun under ->
4935 selstring (undertext under);
4939 state
.glinks
<- false;
4943 G.postRedisplay "view:linkent"
4946 begin match state
.autoscroll
with
4948 conf
.autoscrollstep
<- step
;
4949 state
.autoscroll
<- None
4951 if conf
.autoscrollstep
= 0
4952 then state
.autoscroll
<- Some
1
4953 else state
.autoscroll
<- Some conf
.autoscrollstep
4957 launchpath () (* XXX where do error messages go? *)
4960 setpresentationmode (not conf
.presentation
);
4961 showtext ' '
("presentation mode " ^
4962 if conf
.presentation
then "on" else "off");
4965 if List.mem
Wsi.Fullscreen state
.winstate
4966 then Wsi.reshape conf
.cwinw conf
.cwinh
4967 else Wsi.fullscreen
()
4970 search state
.searchpattern
false
4973 search state
.searchpattern
true
4976 begin match state
.layout with
4979 gotoghyll (getpagey
l.pageno)
4985 | @delete
| @kpdelete
-> (* delete *)
4989 showtext ' '
(describe_location ());
4992 begin match state
.layout with
4995 Wsi.reshape (l.pagew
+ vscrollw ()) l.pageh
;
5000 enterbookmarkmode
()
5008 | @e when Buffer.length state
.errmsgs
> 0 ->
5013 match state
.layout with
5018 (s, 0, Oanchor
(getanchor1
l)) :: state
.bookmarks
5021 enttext ("bookmark: ", E.s, None
, textentry, ondone, true)
5025 showtext ' '
"Quick bookmark added";
5028 begin match state
.layout with
5030 let rect = getpdimrect
l.pagedimno
in
5034 (truncate
(1.8 *. (rect.(1) -. rect.(0))),
5035 truncate
(1.2 *. (rect.(3) -. rect.(0))))
5037 (truncate
(rect.(1) -. rect.(0)),
5038 truncate
(rect.(3) -. rect.(0)))
5040 let w = truncate
((float w)*.conf
.zoom)
5041 and h = truncate
((float h)*.conf
.zoom) in
5044 state
.anchor <- getanchor
();
5045 Wsi.reshape (w + vscrollw ()) (h + conf
.interpagespace
)
5047 G.postRedisplay "z";
5052 | @x -> state
.roam
()
5055 reqlayout (conf
.angle
+
5056 (if key = @Gt
then 30 else -30)) conf
.fitmodel
5060 bound
(conf
.colorscale
+. (if key = 93 then 0.1 else -0.1)) 0.0 1.0
5062 G.postRedisplay "brightness";
5064 | @c when state
.mode = View
->
5069 let m = (wadjsb () + state
.winw
- state
.w) / 2 in
5070 gotoxy_and_clear_text m state
.y
5074 match state
.prevcolumns
with
5075 | None
-> (1, 0, 0), 1.0
5076 | Some
(columns
, z
) ->
5079 | Csplit
(c, _) -> -c, 0, 0
5080 | Cmulti
((c, a, b), _) -> c, a, b
5081 | Csingle
_ -> 1, 0, 0
5085 setcolumns View
c a b;
5088 | @down
| @up
when ctrl && Wsi.withshift mask
->
5089 let zoom, x = state
.prevzoom
in
5093 | @k
| @up
| @kpup
->
5094 begin match state
.autoscroll
with
5096 begin match state
.mode with
5097 | Birdseye beye
-> upbirdseye 1 beye
5102 then gotoxy_and_clear_text state
.x (clamp ~
-(state
.winh
/2))
5104 if not
(Wsi.withshift mask
) && conf
.presentation
5106 else gotoghyll1 true (clamp (-conf
.scrollstep
))
5110 setautoscrollspeed n false
5113 | @j
| @down
| @kpdown
->
5114 begin match state
.autoscroll
with
5116 begin match state
.mode with
5117 | Birdseye beye
-> downbirdseye 1 beye
5122 then gotoxy_and_clear_text state
.x (clamp (state
.winh
/2))
5124 if not
(Wsi.withshift mask
) && conf
.presentation
5126 else gotoghyll1 true (clamp (conf
.scrollstep
))
5130 setautoscrollspeed n true
5133 | @left | @right
| @kpleft
| @kpright
when not
(Wsi.withalt mask
) ->
5139 else conf
.hscrollstep
5141 let dx = if key = @left || key = @kpleft
then dx else -dx in
5142 gotoxy_and_clear_text (panbound (state
.x + dx)) state
.y
5145 G.postRedisplay "left/right"
5148 | @prior
| @kpprior
->
5152 match state
.layout with
5154 | l :: _ -> state
.y - l.pagey
5156 clamp (pgscale (-state
.winh
))
5160 | @next | @kpnext
->
5164 match List.rev state
.layout with
5166 | l :: _ -> getpagey
l.pageno
5168 clamp (pgscale state
.winh
)
5172 | @g | @home
| @kphome
->
5175 | @G
| @jend
| @kpend
->
5177 gotoghyll (clamp state
.maxy)
5179 | @right
| @kpright
when Wsi.withalt mask
->
5180 gotoghyll (getnav 1)
5181 | @left | @kpleft
when Wsi.withalt mask
->
5182 gotoghyll (getnav ~
-1)
5187 | @v when conf
.debug
->
5190 match getopaque l.pageno with
5193 let x0, y0, x1, y1 = pagebbox
opaque in
5194 let rect = (float x0, float y0,
5197 float x0, float y1) in
5199 let color = (0.0, 0.0, 1.0 /. (l.pageno mod 3 |> float), 0.5) in
5200 state
.rects
<- (l.pageno, color, rect) :: state
.rects
;
5202 G.postRedisplay "v";
5205 let mode = state
.mode in
5206 let cmd = ref E.s in
5207 let onleave = function
5208 | Cancel
-> state
.mode <- mode
5211 match getopaque l.pageno with
5212 | Some
opaque -> pipesel opaque !cmd
5213 | None
-> ()) state
.layout;
5217 cbput state
.hists
.sel
s;
5221 "| ", !cmd, Some
(onhist state
.hists
.sel
), textentry, ondone, true
5223 G.postRedisplay "|";
5224 state
.mode <- Textentry
(te, onleave);
5227 vlog "huh? %s" (Wsi.keyname
key)
5230 let linknavkeyboard key mask
linknav =
5231 let getpage pageno =
5232 let rec loop = function
5234 | l :: _ when l.pageno = pageno -> Some
l
5235 | _ :: rest
-> loop rest
5236 in loop state
.layout
5238 let doexact (pageno, n) =
5239 match getopaque pageno, getpage pageno with
5240 | Some
opaque, Some
l ->
5241 if key = @enter || key = @kpenter
5243 let under = getlink
opaque n in
5244 G.postRedisplay "link gotounder";
5251 Some
(findlink
opaque LDfirst
), -1
5254 Some
(findlink
opaque LDlast
), 1
5257 Some
(findlink
opaque (LDleft
n)), -1
5260 Some
(findlink
opaque (LDright
n)), 1
5263 Some
(findlink
opaque (LDup
n)), -1
5266 Some
(findlink
opaque (LDdown
n)), 1
5271 begin match findpwl
l.pageno dir with
5275 state
.mode <- LinkNav
(Ltgendir
dir);
5276 let y, h = getpageyh
pageno in
5279 then y + h - state
.winh
5284 begin match getopaque pageno, getpage pageno with
5285 | Some
opaque, Some
_ ->
5287 let ld = if dir > 0 then LDfirst
else LDlast
in
5290 begin match link with
5292 showlinktype (getlink
opaque m);
5293 state
.mode <- LinkNav
(Ltexact
(pageno, m));
5294 G.postRedisplay "linknav jpage";
5295 | Lnotfound
-> notfound dir
5301 begin match opt with
5302 | Some Lnotfound
-> pwl l dir;
5303 | Some
(Lfound
m) ->
5307 let _, y0, _, y1 = getlinkrect
opaque m in
5309 then gotopage1 l.pageno y0
5311 let d = fstate
.fontsize
+ 1 in
5312 if y1 - l.pagey > l.pagevh - d
5313 then gotopage1 l.pageno (y1 - state
.winh
- hscrollh () + d)
5314 else G.postRedisplay "linknav";
5316 showlinktype (getlink
opaque m);
5317 state
.mode <- LinkNav
(Ltexact
(l.pageno, m));
5320 | None
-> viewkeyboard key mask
5322 | _ -> viewkeyboard key mask
5327 G.postRedisplay "leave linknav"
5331 | Ltgendir
_ | Ltnotready
_ -> viewkeyboard key mask
5332 | Ltexact exact
-> doexact exact
5335 let keyboard key mask
=
5336 if (key = @g && Wsi.withctrl mask
) && not
(istextentry state
.mode)
5337 then wcmd "interrupt"
5338 else state
.uioh <- state
.uioh#
key key mask
5341 let birdseyekeyboard key mask
5342 ((oconf
, leftx
, pageno, hooverpageno
, anchor) as beye
) =
5344 match conf
.columns
with
5346 | Cmulti
((c, _, _), _) -> c
5347 | Csplit
_ -> failwith
"bird's eye split mode"
5349 let pgh layout = List.fold_left
5350 (fun m l -> max
l.pageh
m) state
.winh
layout in
5352 | @l when Wsi.withctrl mask
->
5353 let y, h = getpageyh
pageno in
5354 let top = (state
.winh
- h) / 2 in
5355 gotoxy state
.x (max
0 (y - top))
5356 | @enter | @kpenter
-> leavebirdseye beye
false
5357 | @escape
-> leavebirdseye beye
true
5358 | @up
-> upbirdseye incr beye
5359 | @down
-> downbirdseye incr beye
5360 | @left -> upbirdseye 1 beye
5361 | @right
-> downbirdseye 1 beye
5364 begin match state
.layout with
5368 state
.mode <- Birdseye
(
5369 oconf
, leftx
, l.pageno, hooverpageno
, anchor
5371 gotopage1 l.pageno 0;
5374 let layout = layout state
.x (state
.y-state
.winh
)
5376 (pgh state
.layout) in
5378 | [] -> gotoxy state
.x (clamp (-state
.winh
))
5380 state
.mode <- Birdseye
(
5381 oconf
, leftx
, l.pageno, hooverpageno
, anchor
5383 gotopage1 l.pageno 0
5386 | [] -> gotoxy state
.x (clamp (-state
.winh
))
5390 begin match List.rev state
.layout with
5392 let layout = layout state
.x
5393 (state
.y + (pgh state
.layout))
5394 state
.winw state
.winh
in
5395 begin match layout with
5397 let incr = l.pageh
- l.pagevh in
5402 oconf
, leftx
, state
.pagecount
- 1, hooverpageno
, anchor
5404 G.postRedisplay "birdseye pagedown";
5406 else gotoxy state
.x (clamp (incr + conf
.interpagespace
*2));
5410 Birdseye
(oconf
, leftx
, l.pageno, hooverpageno
, anchor);
5411 gotopage1 l.pageno 0;
5414 | [] -> gotoxy state
.x (clamp state
.winh
)
5418 state
.mode <- Birdseye
(oconf
, leftx
, 0, hooverpageno
, anchor);
5422 let pageno = state
.pagecount
- 1 in
5423 state
.mode <- Birdseye
(oconf
, leftx
, pageno, hooverpageno
, anchor);
5424 if not
(pagevisible state
.layout pageno)
5427 match List.rev state
.pdims
with
5429 | (_, _, h, _) :: _ -> h
5433 (max
0 (getpagey
pageno - (state
.winh
- h - conf
.interpagespace
)))
5434 else G.postRedisplay "birdseye end";
5436 | _ -> viewkeyboard key mask
5441 match state
.mode with
5442 | Textentry
_ -> scalecolor 0.4
5444 | View
-> scalecolor 1.0
5445 | Birdseye
(_, _, pageno, hooverpageno
, _) ->
5446 if l.pageno = hooverpageno
5449 if l.pageno = pageno
5451 let c = scalecolor 1.0 in
5453 GlDraw.line_width
3.0;
5454 let dispx = xadjsb () + l.pagedispx in
5456 (float (dispx-1)) (float (l.pagedispy-1))
5457 (float (dispx+l.pagevw+1))
5458 (float (l.pagedispy+l.pagevh+1))
5460 GlDraw.line_width
1.0;
5469 let postdrawpage l linkindexbase
=
5470 match getopaque l.pageno with
5472 if tileready l l.pagex
l.pagey
5474 let x = l.pagedispx - l.pagex
+ xadjsb ()
5475 and y = l.pagedispy - l.pagey in
5477 match conf
.columns
with
5478 | Csingle
_ | Cmulti
_ ->
5479 (if conf
.hlinks
then 1 else 0)
5481 && not
(isbirdseye state
.mode) then 2 else 0)
5485 match state
.mode with
5486 | Textentry
((_, s, _, _, _, _), _) when state
.glinks
-> s
5492 Hashtbl.find_all state
.prects
l.pageno |>
5493 List.iter
(fun vals
-> drawprect
opaque x y vals
);
5494 let n = postprocess
opaque hlmask x y (linkindexbase
, s, conf
.hfsize
) in
5496 then (state
.redisplay
<- true; 0)
5502 let scrollindicator () =
5503 let sbw, ph
, sh = state
.uioh#
scrollph in
5504 let sbh, pw, sw = state
.uioh#scrollpw
in
5509 else ((state
.winw
- sbw), state
.winw
, 0)
5512 GlDraw.color (0.64, 0.64, 0.64);
5513 filledrect (float x0) 0. (float x1) (float state
.winh
);
5515 (float hx0
) (float (state
.winh
- sbh))
5516 (float (hx0
+ wadjsb () + state
.winw
)) (float state
.winh
)
5518 GlDraw.color (0.0, 0.0, 0.0);
5520 filledrect (float x0) ph
(float x1) (ph
+. sh);
5521 let pw = pw +. float hx0
in
5522 filledrect pw (float (state
.winh
- sbh)) (pw +. sw) (float state
.winh
);
5526 match state
.mstate
with
5527 | Mnone
| Mscrolly
| Mscrollx
| Mpan
_ | Mzoom
_ | Mzoomrect
_ ->
5530 | Msel
((x0, y0), (x1, y1)) ->
5531 let identify opaque l px py = Some
(opaque, l.pageno, px, py) in
5532 let o0,n0
,px0
,py0
= onppundermouse identify x0 y0 (~
< E.s, -1, 0, 0) in
5533 let _o1,n1
,px1
,py1
= onppundermouse identify x1 y1 (~
< E.s, -1, 0, 0) in
5534 if n0
!= -1 && n0
= n1
then seltext
o0 (px0
, py0
, px1
, py1
);
5537 let showrects = function [] -> () | rects
->
5539 GlDraw.color (0.0, 0.0, 1.0) ~
alpha:0.5;
5540 GlFunc.blend_func ~
src:`src_alpha ~dst
:`one_minus_src_alpha
;
5542 (fun (pageno, c, (x0, y0, x1, y1, x2
, y2
, x3
, y3
)) ->
5544 if l.pageno = pageno
5546 let dx = float (l.pagedispx - l.pagex
) in
5547 let dy = float (l.pagedispy - l.pagey) in
5548 let r, g, b, alpha = c in
5549 GlDraw.color (r, g, b) ~
alpha;
5550 filledrect2 (x0+.dx) (y0+.dy)
5562 begin match conf
.columns
, state
.layout with
5563 | Csingle
_, _ :: _ ->
5564 GlDraw.color (scalecolor2 conf
.bgcolor
);
5566 List.fold_left
(fun y l ->
5569 let x1 = l.pagedispx + xadjsb () in
5570 let y1 = (l.pagedispy + l.pagevh) in
5571 filledrect (float x0) (float y0) (float x1) (float y1);
5572 let x0 = x1 + l.pagevw in
5573 let x1 = state
.winw
in
5574 filledrect1 (float x0) (float y0) (float x1) (float y1);
5578 and x1 = state
.winw
in
5580 and y1 = l.pagedispy in
5581 filledrect1 (float x0) (float y0) (float x1) (float y1);
5583 l.pagedispy + l.pagevh) 0 state
.layout
5586 and x1 = state
.winw
in
5588 and y1 = state
.winh
in
5589 filledrect1 (float x0) (float y0) (float x1) (float y1)
5590 | (Cmulti
_ | Csplit
_), _ | Csingle
_, [] ->
5591 GlClear.color (scalecolor2 conf
.bgcolor
);
5592 GlClear.clear
[`
color];
5594 List.iter
drawpage state
.layout;
5596 match state
.mode with
5597 | LinkNav
(Ltexact
(pageno, linkno
)) ->
5598 begin match getopaque pageno with
5600 let dx = xadjsb () in
5601 let x0, y0, x1, y1 = getlinkrect
opaque linkno
in
5602 let x0 = x0 + dx and x1 = x1 + dx in
5603 let color = (0.0, 0.0, 0.5, 0.5) in
5610 | None
-> state
.rects
5612 | LinkNav
(Ltgendir
_) | LinkNav
(Ltnotready
_)
5615 | View
-> state
.rects
5618 let rec postloop linkindexbase
= function
5620 let linkindexbase = linkindexbase + postdrawpage l linkindexbase in
5621 postloop linkindexbase rest
5625 postloop 0 state
.layout;
5627 begin match state
.mstate
with
5628 | Mzoomrect
((x0, y0), (x1, y1)) ->
5630 GlDraw.color (0.3, 0.3, 0.3) ~
alpha:0.5;
5631 GlFunc.blend_func ~
src:`src_alpha ~dst
:`one_minus_src_alpha
;
5632 filledrect (float x0) (float y0) (float x1) (float y1);
5636 | Mscrolly
| Mscrollx
5645 let zoomrect x y x1 y1 =
5648 and y0 = min
y y1 in
5649 let zoom = (float state
.w) /. float (x1 - x0) in
5652 let adjw = wadjsb () + state
.winw
in
5654 then (adjw - state
.w) / 2
5657 match conf
.fitmodel
with
5658 | FitWidth
| FitProportional
-> simple ()
5660 match conf
.columns
with
5662 onppundermouse (fun _ l _ _ -> Some
l.pagedispx) x0 y0 x0
5663 | Cmulti
_ | Csingle
_ -> simple ()
5665 gotoxy ((state
.x + margin) - x0) (state
.y + y0);
5666 state
.anchor <- getanchor
();
5671 let annot inline
x y =
5672 match unproject x y with
5673 | Some
(opaque, n, ux
, uy
) ->
5675 addannot
opaque ux uy
text;
5676 wcmd "freepage %s" (~
> opaque);
5677 Hashtbl.remove state
.pagemap
(n, state
.gen
);
5679 gotoxy state
.x state
.y
5683 let ondone s = add s in
5684 let mode = state
.mode in
5685 state
.mode <- Textentry
(
5686 ("annotation: ", E.s, None
, textentry, ondone, true),
5687 fun _ -> state
.mode <- mode);
5690 G.postRedisplay "annot"
5692 add @@ getusertext E.s
5697 let g opaque l px py =
5698 match rectofblock
opaque px py with
5700 let x0 = a.(0) -. 20. in
5701 let x1 = a.(1) +. 20. in
5702 let y0 = a.(2) -. 20. in
5703 let zoom = (float state
.w) /. (x1 -. x0) in
5704 let pagey = getpagey
l.pageno in
5705 let margin = (state
.w - l.pagew
)/2 in
5706 let nx = -truncate
x0 - margin in
5707 gotoxy_and_clear_text nx (pagey + truncate
y0);
5708 state
.anchor <- getanchor
();
5713 match conf
.columns
with
5715 impmsg "block zooming does not work properly in split columns mode"
5716 | Cmulti
_ | Csingle
_ -> onppundermouse g x y ()
5720 let winw = wadjsb () + state
.winw - 1 in
5721 let s = float x /. float winw in
5722 let destx = truncate
(float (state
.w + winw) *. s) in
5723 gotoxy_and_clear_text (winw - destx) state
.y;
5724 state
.mstate
<- Mscrollx
;
5728 let s = float y /. float state
.winh
in
5729 let desty = truncate
(float (state
.maxy - state
.winh
) *. s) in
5730 gotoxy_and_clear_text state
.x desty;
5731 state
.mstate
<- Mscrolly
;
5734 let viewmulticlick clicks
x y mask
=
5735 let g opaque l px py =
5743 if markunder
opaque px py mark
5747 match getopaque l.pageno with
5749 | Some
opaque -> pipesel opaque cmd
5751 state
.roam
<- (fun () -> dopipe conf
.paxcmd
);
5752 if not
(Wsi.withctrl mask
) then dopipe conf
.selcmd
;
5757 G.postRedisplay "viewmulticlick";
5758 onppundermouse g x y (fun () -> impmsg "nothing to select") ();
5762 match conf
.columns
with
5764 | Csingle
_ | Cmulti
_ -> conf
.angle
mod 360 = 0
5767 let viewmouse button down
x y mask
=
5769 | n when (n == 4 || n == 5) && not down
->
5770 if Wsi.withctrl mask
5772 match state
.mstate
with
5773 | Mzoom
(oldn
, i
) ->
5781 if conf
.zoom +. 0.01 > 0.1 then 0.1 else 0.01
5783 if conf
.zoom -. 0.1 < 0.1 then -0.01 else -0.1
5785 let zoom = conf
.zoom -. incr in
5786 pivotzoom ~
x ~
y zoom;
5787 state
.mstate
<- Mzoom
(n, 0);
5789 state
.mstate
<- Mzoom
(n, i
+1);
5791 else state
.mstate
<- Mzoom
(n, 0)
5795 | Mscrolly
| Mscrollx
5797 | Mnone
-> state
.mstate
<- Mzoom
(n, 0)
5800 match state
.autoscroll
with
5801 | Some step
-> setautoscrollspeed step
(n=4)
5803 if conf
.wheelbypage
|| conf
.presentation
5812 then -conf
.scrollstep
5813 else conf
.scrollstep
5815 let incr = incr * 2 in
5816 let y = clamp incr in
5817 gotoxy_and_clear_text state
.x y
5820 | n when (n = 6 || n = 7) && not down
&& canpan () ->
5822 panbound (state
.x + (if n = 7 then -2 else 2) * conf
.hscrollstep
) in
5823 gotoxy_and_clear_text x state
.y
5825 | 1 when Wsi.withshift mask
->
5826 state
.mstate
<- Mnone
;
5829 match unproject x y with
5831 | Some
(_, pageno, ux
, uy
) ->
5832 let cmd = Printf.sprintf
5834 conf
.stcmd state
.path pageno ux uy
5836 match spawn
cmd [] with
5837 | (exception exn
) ->
5838 impmsg "execution of synctex command(%S) failed: %S"
5839 conf
.stcmd
@@ exntos exn
5843 | 1 when Wsi.withctrl mask
->
5846 Wsi.setcursor
Wsi.CURSOR_FLEUR
;
5847 state
.mstate
<- Mpan
(x, y)
5850 state
.mstate
<- Mnone
5855 if Wsi.withshift mask
5857 annot conf
.annotinline
x y;
5858 G.postRedisplay "addannot"
5862 Wsi.setcursor
Wsi.CURSOR_CYCLE
;
5863 state
.mstate
<- Mzoomrect
(p, p)
5866 match state
.mstate
with
5867 | Mzoomrect
((x0, y0), _) ->
5868 if abs
(x-x0) > 10 && abs
(y - y0) > 10
5869 then zoomrect x0 y0 x y
5872 G.postRedisplay "kill accidental zoom rect";
5876 | Mscrolly
| Mscrollx
5882 | 1 when vscrollhit x ->
5885 let _, position, sh = state
.uioh#
scrollph in
5886 if y > truncate
position && y < truncate
(position +. sh)
5887 then state
.mstate
<- Mscrolly
5890 state
.mstate
<- Mnone
5892 | 1 when y > state
.winh
- hscrollh () ->
5895 let _, position, sw = state
.uioh#scrollpw
in
5896 if x > truncate
position && x < truncate
(position +. sw)
5897 then state
.mstate
<- Mscrollx
5900 state
.mstate
<- Mnone
5902 | 1 when state
.bzoom
-> if not down
then zoomblock x y
5905 let dest = if down
then getunder x y else Unone
in
5906 begin match dest with
5909 | Uremote
_ | Uremotedest
_
5910 | Uunexpected
_ | Ulaunch
_ | Unamed
_ ->
5913 | Unone
when down
->
5914 Wsi.setcursor
Wsi.CURSOR_FLEUR
;
5915 state
.mstate
<- Mpan
(x, y);
5917 | Uannotation
(opaque, slinkindex
) -> enterannotmode opaque slinkindex
5919 | Unone
| Utext
_ ->
5924 state
.mstate
<- Msel
((x, y), (x, y));
5925 G.postRedisplay "mouse select";
5929 match state
.mstate
with
5932 | Mzoom
_ | Mscrollx
| Mscrolly
->
5933 state
.mstate
<- Mnone
5935 | Mzoomrect
((x0, y0), _) ->
5939 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
5940 state
.mstate
<- Mnone
5942 | Msel
((x0, y0), (x1, y1)) ->
5943 let rec loop = function
5947 let a0 = l.pagedispy in
5948 let a1 = a0 + l.pagevh in
5949 let b0 = l.pagedispx in
5950 let b1 = b0 + l.pagevw in
5951 ((y0 >= a0 && y0 <= a1) || (y1 >= a0 && y1 <= a1))
5952 && ((x0 >= b0 && x0 <= b1) || (x1 >= b0 && x1 <= b1))
5956 match getopaque l.pageno with
5959 match Unix.pipe
() with
5960 | (exception exn
) ->
5961 impmsg "cannot create sel pipe: %s" @@
5965 Ne.clo fd
(fun msg
->
5966 dolog
"%s close failed: %s" what msg
)
5969 try spawn
cmd [r, 0; w, -1]
5971 dolog
"cannot execute %S: %s"
5978 G.postRedisplay "copysel";
5980 else clo "Msel pipe/w" w;
5981 clo "Msel pipe/r" r;
5983 dosel conf
.selcmd
();
5984 state
.roam
<- dosel conf
.paxcmd
;
5996 let birdseyemouse button down
x y mask
5997 (conf
, leftx
, _, hooverpageno
, anchor) =
6000 let rec loop = function
6003 if y > l.pagedispy && y < l.pagedispy + l.pagevh
6004 && x > l.pagedispx && x < l.pagedispx + l.pagevw
6006 leavebirdseye (conf
, leftx
, l.pageno, hooverpageno
, anchor) false;
6012 | _ -> viewmouse button down
x y mask
6018 method key key mask
=
6019 begin match state
.mode with
6020 | Textentry
textentry -> textentrykeyboard key mask
textentry
6021 | Birdseye
birdseye -> birdseyekeyboard key mask
birdseye
6022 | View
-> viewkeyboard key mask
6023 | LinkNav
linknav -> linknavkeyboard key mask
linknav
6027 method button button bstate
x y mask
=
6028 begin match state
.mode with
6030 | View
-> viewmouse button bstate
x y mask
6031 | Birdseye beye
-> birdseyemouse button bstate
x y mask beye
6036 method multiclick clicks
x y mask
=
6037 begin match state
.mode with
6039 | View
-> viewmulticlick clicks
x y mask
6046 begin match state
.mode with
6048 | View
| Birdseye
_ | LinkNav
_ ->
6049 match state
.mstate
with
6050 | Mzoom
_ | Mnone
-> ()
6055 state
.mstate
<- Mpan
(x, y);
6056 let x = if canpan () then panbound (state
.x + dx) else state
.x in
6058 gotoxy_and_clear_text x y
6061 state
.mstate
<- Msel
(a, (x, y));
6062 G.postRedisplay "motion select";
6065 let y = min state
.winh
(max
0 y) in
6069 let x = min state
.winw (max
0 x) in
6072 | Mzoomrect
(p0
, _) ->
6073 state
.mstate
<- Mzoomrect
(p0
, (x, y));
6074 G.postRedisplay "motion zoomrect";
6078 method pmotion
x y =
6079 begin match state
.mode with
6080 | Birdseye
(conf
, leftx
, pageno, hooverpageno
, anchor) ->
6081 let rec loop = function
6083 if hooverpageno
!= -1
6085 state
.mode <- Birdseye
(conf
, leftx
, pageno, -1, anchor);
6086 G.postRedisplay "pmotion birdseye no hoover";
6089 if y > l.pagedispy && y < l.pagedispy + l.pagevh
6090 && x > l.pagedispx && x < l.pagedispx + l.pagevw
6092 state
.mode <- Birdseye
(conf
, leftx
, pageno, l.pageno, anchor);
6093 G.postRedisplay "pmotion birdseye hoover";
6103 match state
.mstate
with
6104 | Mpan
_ | Msel
_ | Mzoom
_ | Mscrolly
| Mscrollx
| Mzoomrect
_ -> ()
6112 let past, _, _ = !r in
6114 let delta = now -. past in
6117 else r := (now, x, y)
6121 method infochanged
_ = ()
6124 let maxy = state
.maxy - (if conf
.maxhfit
then state
.winh
else 0) in
6127 then 0.0, float state
.winh
6128 else scrollph state
.y maxy
6133 let winw = wadjsb () + state
.winw in
6134 let fwinw = float winw in
6136 let sw = fwinw /. float state
.w in
6137 let sw = fwinw *. sw in
6138 max
sw (float conf
.scrollh
)
6141 let maxx = state
.w + winw in
6142 let x = winw - state
.x in
6143 let percent = float x /. float maxx in
6144 (fwinw -. sw) *. percent
6146 hscrollh (), position, sw
6150 match state
.mode with
6151 | LinkNav
_ -> "links"
6152 | Textentry
_ -> "textentry"
6153 | Birdseye
_ -> "birdseye"
6156 findkeyhash conf
modename
6158 method eformsgs
= true
6159 method alwaysscrolly
= false
6162 let addrect pageno r g b a x0 y0 x1 y1 =
6163 Hashtbl.add state
.prects
pageno [|r; g; b; a; x0; y0; x1; y1|];
6167 let cl = splitatspace cmds
in
6169 try Scanf.sscanf
s fmt
f
6171 adderrfmt "remote exec"
6172 "error processing '%S': %s\n" cmds
@@ exntos exn
6174 let rectx s pageno (r, g, b, a) x0 y0 x1 y1 =
6175 vlog "%s page %d color (%f %f %f %f) x0,y0,x1,y1 = %f %f %f %f"
6176 s pageno r g b a x0 y0 x1 y1;
6180 let _,w1,h1
,_ = getpagedim
pageno in
6181 let sw = float w1 /. float w
6182 and sh = float h1
/. float h in
6186 and y1s
= y1 *. sh in
6187 let rect = (x0s,y0s
,x1s
,y0s
,x1s
,y1s
,x0s,y1s
) in
6188 let color = (r, g, b, a) in
6189 if conf
.verbose
then debugrect rect;
6190 state
.rects <- (pageno, color, rect) :: state
.rects;
6195 | "reload", "" -> reload ()
6197 scan args
"%u %f %f"
6199 let cmd, _ = state
.geomcmds
in
6201 then gotopagexy !wtmode pageno x y
6204 gotopagexy !wtmode pageno x y;
6207 state
.reprf
<- f state
.reprf
6209 | "goto1", args
-> scan args
"%u %f" gotopage
6212 (fun filename
pageno -> gotounder (Uremote
(filename
, pageno)))
6215 (fun filename
dest -> gotounder (Uremotedest
(filename
, dest)))
6217 scan args
"%u %u %f %f %f %f"
6218 (fun pageno c x0 y0 x1 y1 ->
6219 let color = (0.0, 0.0, 1.0 /. float c, 0.5) in
6220 rectx "rect" pageno color x0 y0 x1 y1;
6223 scan args
"%u %f %f %f %f %f %f %f %f"
6224 (fun pageno r g b alpha x0 y0 x1 y1 ->
6225 addrect pageno r g b alpha x0 y0 x1 y1;
6226 G.postRedisplay "prect"
6229 scan args
"%u %f %f"
6232 match getopaque pageno with
6233 | Some
opaque -> opaque
6236 pgoto optopaque pageno x y;
6237 let rec fixx = function
6240 if l.pageno = pageno
6241 then gotoxy (state
.x - l.pagedispx) state
.y
6246 match conf
.columns
with
6247 | Csingle
_ | Csplit
_ -> 1
6248 | Cmulti
((n, _, _), _) -> n
6250 layout 0 state
.y (state
.winw * mult) state
.winh
6254 | "activatewin", "" -> Wsi.activatewin
()
6255 | "quit", "" -> raise Quit
6258 let l = Config.keys_of_string
keys in
6259 List.iter
(fun (k
, m) -> keyboard k
m) l
6261 adderrfmt "error processing keys" "`%S': %s\n" cmds
@@ exntos exn
6263 | "clearrects", "" ->
6264 Hashtbl.clear state
.prects
;
6265 G.postRedisplay "clearrects"
6267 adderrfmt "remote command"
6268 "error processing remote command: %S\n" cmds
;
6272 let scratch = Bytes.create
80 in
6273 let buf = Buffer.create
80 in
6275 match tempfailureretry
(Unix.read fd
scratch 0) 80 with
6276 | (exception Unix.Unix_error
(Unix.EAGAIN
, _, _)) -> None
6279 if Buffer.length
buf > 0
6281 let s = Buffer.contents
buf in
6289 match Bytes.index_from
scratch ppos '
\n'
with
6290 | pos -> if pos >= n then -1 else pos
6291 | (exception Not_found
) -> -1
6295 Buffer.add_subbytes
buf scratch ppos
(nlpos-ppos
);
6296 let s = Buffer.contents
buf in
6302 Buffer.add_subbytes
buf scratch ppos
(n-ppos
);
6308 let remoteopen path =
6309 try Some
(Unix.openfile
path [Unix.O_NONBLOCK
; Unix.O_RDONLY
] 0o0)
6311 adderrfmt "remoteopen" "error opening %S: %s" path @@ exntos exn
;
6316 let gcconfig = ref E.s in
6317 let trimcachepath = ref E.s in
6318 let rcmdpath = ref E.s in
6319 let pageno = ref None
in
6320 let rootwid = ref 0 in
6321 let openlast = ref false in
6322 let nofc = ref false in
6323 let doreap = ref false in
6324 selfexec := Sys.executable_name
;
6327 [("-p", Arg.String
(fun s -> state
.password <- s),
6328 "<password> Set password");
6332 Config.fontpath
:= s;
6333 selfexec := !selfexec ^
" -f " ^
Filename.quote
s;
6335 "<path> Set path to the user interface font");
6339 selfexec := !selfexec ^
" -c " ^
Filename.quote
s;
6340 Config.confpath
:= s),
6341 "<path> Set path to the configuration file");
6343 ("-last", Arg.Set
openlast, " Open last document");
6345 ("-page", Arg.Int
(fun pageno1
-> pageno := Some
(pageno1
-1)),
6346 "<page-number> Jump to page");
6348 ("-tcf", Arg.String
(fun s -> trimcachepath := s),
6349 "<path> Set path to the trim cache file");
6351 ("-dest", Arg.String
(fun s -> state
.nameddest
<- s),
6352 "<named-destination> Set named destination");
6354 ("-wtmode", Arg.Set
wtmode, " Operate in wt mode");
6355 ("-cxack", Arg.Set
cxack, " Cut corners");
6357 ("-remote", Arg.String
(fun s -> rcmdpath := s),
6358 "<path> Set path to the remote commands source");
6360 ("-origin", Arg.String
(fun s -> state
.origin
<- s),
6361 "<original-path> Set original path");
6363 ("-gc", Arg.Set_string
gcconfig,
6364 "<script-path> Collect garbage with the help of a script");
6366 ("-nofc", Arg.Set
nofc, " Do not use fontconfig");
6368 ("-v", Arg.Unit
(fun () ->
6370 "%s\nconfiguration path: %s\n"
6374 exit
0), " Print version and exit");
6376 ("-embed", Arg.Set_int
rootwid,
6377 "<window-id> Embed into window")
6380 (fun s -> state
.path <- s)
6381 ("Usage: " ^
Sys.argv
.(0) ^
" [options] some.pdf\nOptions:")
6384 then selfexec := !selfexec ^
" -wtmode";
6386 let histmode = emptystr state
.path && not
!openlast in
6388 if not
(Config.load !openlast)
6389 then dolog
"failed to load configuration";
6391 begin match !pageno with
6392 | Some
pageno -> state
.anchor <- (pageno, 0.0, 0.0)
6396 if nonemptystr
!gcconfig
6399 match Unix.socketpair
Unix.PF_UNIX
Unix.SOCK_STREAM
0 with
6400 | (exception exn
) -> error
"socketpair for gc failed: %s" @@ exntos exn
6403 match spawn
!gcconfig [(c, 0); (c, 1); (s, -1)] with
6404 | (exception exn
) -> error
"failed to execute gc script: %s" @@ exntos exn
6406 Ne.clo c @@ (fun s -> error
"failed to close gc fd %s" s);
6411 let wsfd, winw, winh
= Wsi.init
(object (self)
6412 val mutable m_clicks
= 0
6413 val mutable m_click_x
= 0
6414 val mutable m_click_y
= 0
6415 val mutable m_lastclicktime
= infinity
6417 method private cleanup =
6418 state
.roam
<- noroam
;
6419 Hashtbl.iter
(fun _ opaque -> clearmark
opaque) state
.pagemap
6420 method expose
= G.postRedisplay "expose"
6424 | Wsi.Unobscured
-> "unobscured"
6425 | Wsi.PartiallyObscured
-> "partiallyobscured"
6426 | Wsi.FullyObscured
-> "fullyobscured"
6428 vlog "visibility change %s" name
6429 method display = display ()
6430 method map mapped
= vlog "mapped %b" mapped
6431 method reshape w h =
6434 method mouse
b d x y m =
6435 if d && canselect ()
6437 (* http://blogs.msdn.com/b/oldnewthing/archive/2004/10/18/243925.aspx *)
6443 if abs
x - m_click_x
> 10
6444 || abs
y - m_click_y
> 10
6445 || abs_float
(t -. m_lastclicktime
) > 0.3
6447 m_clicks
<- m_clicks
+ 1;
6448 m_lastclicktime
<- t;
6452 G.postRedisplay "cleanup";
6453 state
.uioh <- state
.uioh#button
b d x y m;
6455 else state
.uioh <- state
.uioh#multiclick m_clicks
x y m
6460 m_lastclicktime
<- infinity
;
6461 state
.uioh <- state
.uioh#button
b d x y m
6465 state
.uioh <- state
.uioh#button
b d x y m
6468 state
.mpos
<- (x, y);
6469 state
.uioh <- state
.uioh#motion
x y
6470 method pmotion
x y =
6471 state
.mpos
<- (x, y);
6472 state
.uioh <- state
.uioh#pmotion
x y
6474 let mascm = m land (
6475 Wsi.altmask
+ Wsi.shiftmask
+ Wsi.ctrlmask
+ Wsi.metamask
6478 let x = state
.x and y = state
.y in
6480 if x != state
.x || y != state
.y then self#
cleanup
6482 match state
.keystate
with
6484 let km = k
, mascm in
6487 let modehash = state
.uioh#
modehash in
6488 try Hashtbl.find modehash km
6490 try Hashtbl.find (findkeyhash conf
"global") km
6491 with Not_found
-> KMinsrt
(k
, m)
6493 | KMinsrt
(k
, m) -> keyboard k
m
6494 | KMinsrl
l -> List.iter
(fun (k
, m) -> keyboard k
m) l
6495 | KMmulti
(l, r) -> state
.keystate
<- KSinto
(l, r)
6497 | KSinto
((k'
, m'
) :: [], insrt
) when k'
=k
&& m'
land mascm = m'
->
6498 List.iter
(fun (k
, m) -> keyboard k
m) insrt
;
6499 state
.keystate
<- KSnone
6500 | KSinto
((k'
, m'
) :: keys, insrt
) when k'
=k
&& m'
land mascm = m'
->
6501 state
.keystate
<- KSinto
(keys, insrt
)
6502 | KSinto
_ -> state
.keystate
<- KSnone
6505 state
.mpos
<- (x, y);
6506 state
.uioh <- state
.uioh#pmotion
x y
6507 method leave = state
.mpos
<- (-1, -1)
6508 method winstate wsl
= state
.winstate
<- wsl
6509 method quit
= raise Quit
6510 end) !rootwid conf
.cwinw conf
.cwinh platform
in
6512 setbgcol conf
.bgcolor
;
6516 List.exists
GlMisc.check_extension
6517 [ "GL_ARB_texture_rectangle"
6518 ; "GL_EXT_texture_recangle"
6519 ; "GL_NV_texture_rectangle" ]
6521 then (dolog
"OpenGL does not suppport rectangular textures"; exit
1);
6524 let r = GlMisc.get_string `renderer
in
6525 let p = "Mesa DRI Intel(" in
6526 let l = String.length
p in
6527 String.length
r > l && String.sub
r 0 l = p
6530 defconf
.sliceheight
<- 1024;
6531 defconf
.texcount
<- 32;
6532 defconf
.usepbo
<- true;
6536 match Unix.socketpair
Unix.PF_UNIX
Unix.SOCK_STREAM
0 with
6537 | (exception exn
) ->
6538 dolog
"socketpair failed: %s" @@ exntos exn
;
6546 setcheckers conf
.checkers
;
6548 opengl_has_pbo := GlMisc.check_extension
"GL_ARB_pixel_buffer_object";
6551 conf
.angle
, conf
.fitmodel
, (conf
.trimmargins
, conf
.trimfuzz
),
6552 conf
.texcount
, conf
.sliceheight
, conf
.mustoresize
, conf
.colorspace
,
6553 !Config.fontpath
, !trimcachepath,
6557 List.iter
GlArray.enable
[`texture_coord
; `vertex
];
6559 reshape ~firsttime
:true winw winh
;
6563 Wsi.settitle
"llpp (history)";
6567 state
.text <- "Opening " ^
(mbtoutf8 state
.path);
6568 opendoc state
.path state
.password;
6572 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
6573 Sys.set_signal
Sys.sighup
(Sys.Signal_handle
(fun _ -> reload ()));
6576 match Unix.waitpid
[Unix.WNOHANG
] ~
-1 with
6577 | (exception (Unix.Unix_error
(Unix.ECHILD
, _, _))) -> ()
6578 | (exception exn
) -> dolog
"Unix.waitpid: %s" @@ exntos exn
6580 | _pid
, _status
-> reap ()
6582 Sys.set_signal
Sys.sigchld
(Sys.Signal_handle
(fun _ -> doreap := true));
6586 if nonemptystr
!rcmdpath
6587 then remoteopen !rcmdpath
6592 let rec loop deadline
=
6598 let r = [state
.ss; state
.wsfd] in
6602 | Some fd
-> fd
:: r
6606 state
.redisplay
<- false;
6613 if deadline
= infinity
6615 else max
0.0 (deadline
-. now)
6620 try Unix.select
r [] [] timeout
6621 with Unix.Unix_error
(Unix.EINTR
, _, _) -> [], [], []
6627 if state
.ghyll
== noghyll
6629 match state
.autoscroll
with
6630 | Some step
when step
!= 0 ->
6631 let y = state
.y + step
in
6632 let fy = if conf
.maxhfit
then state
.winh
else 0 in
6635 then state
.maxy - fy
6636 else if y >= state
.maxy - fy then 0 else y
6638 if state
.mode = View
6639 then gotoxy_and_clear_text state
.x y
6640 else gotoxy state
.x y;
6643 else deadline
+. 0.01
6648 let rec checkfds = function
6650 | fd
:: rest
when fd
= state
.ss ->
6651 let cmd = rcmd state
.ss in
6655 | fd
:: rest
when fd
= state
.wsfd ->
6659 | fd
:: rest
when Some fd
= !optrfd ->
6660 begin match remote fd
with
6661 | None
-> optrfd := remoteopen !rcmdpath;
6662 | opt -> optrfd := opt
6667 dolog
"select returned unknown descriptor";
6673 if deadline
= infinity
6677 match state
.autoscroll
with
6678 | Some step
when step
!= 0 -> deadline1
6679 | _ -> if state
.ghyll
== noghyll
then infinity
else deadline1
6687 Config.save leavebirdseye;
6688 if hasunsavedchanges
()