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 drawstr
: int -> int -> int -> string -> float = "ml_draw_string";;
16 external measurestr
: int -> string -> float = "ml_measure_string";;
17 external postprocess
:
18 opaque
-> int -> int -> int -> (int * string * int) -> int
20 external pagebbox
: opaque
-> (int * int * int * int) = "ml_getpagebox";;
21 external setaalevel
: int -> unit = "ml_setaalevel";;
22 external realloctexts
: int -> bool = "ml_realloctexts";;
23 external findlink
: opaque
-> linkdir
-> link
= "ml_findlink";;
24 external getlink
: opaque
-> int -> under
= "ml_getlink";;
25 external getlinkrect
: opaque
-> int -> irect
= "ml_getlinkrect";;
26 external getlinkcount
: opaque
-> int = "ml_getlinkcount";;
27 external findpwl
: int -> int -> pagewithlinks
= "ml_find_page_with_links";;
28 external getpbo
: width
-> height
-> colorspace
-> opaque
= "ml_getpbo";;
29 external freepbo
: opaque
-> unit = "ml_freepbo";;
30 external unmappbo
: opaque
-> unit = "ml_unmappbo";;
31 external pbousable
: unit -> bool = "ml_pbo_usable";;
32 external unproject
: opaque
-> int -> int -> (int * int) option
34 external drawtile
: tileparams
-> opaque
-> unit = "ml_drawtile";;
35 external rectofblock
: opaque
-> int -> int -> float array
option
37 external begintiles
: unit -> unit = "ml_begintiles";;
38 external endtiles
: unit -> unit = "ml_endtiles";;
39 external addannot
: opaque
-> int -> int -> string -> unit = "ml_addannot";;
40 external modannot
: opaque
-> slinkindex
-> string -> unit = "ml_modannot";;
41 external delannot
: opaque
-> slinkindex
-> unit = "ml_delannot";;
42 external hasunsavedchanges
: unit -> bool = "ml_hasunsavedchanges";;
43 external savedoc
: string -> unit = "ml_savedoc";;
44 external getannotcontents
: opaque
-> slinkindex
-> string
45 = "ml_getannotcontents";;
47 let reeenterhist = ref false;;
48 let selfexec = ref E.s
;;
50 let drawstring size x y s
=
52 Gl.enable `texture_2d
;
53 GlFunc.blend_func ~src
:`src_alpha ~dst
:`one_minus_src_alpha
;
54 ignore
(drawstr size x y s
);
56 Gl.disable `texture_2d
;
59 let drawstring1 size x y s
=
63 let drawstring2 size x y fmt
=
64 Printf.kprintf
(drawstring size
(x
+1) (y
+size
+1)) fmt
68 dolog
"l %d dim=%d {" l
.pageno l
.pagedimno
;
69 dolog
" WxH %dx%d" l
.pagew l
.pageh
;
70 dolog
" vWxH %dx%d" l
.pagevw l
.pagevh
;
71 dolog
" pagex,y %d,%d" l
.pagex l
.pagey
;
72 dolog
" dispx,y %d,%d" l
.pagedispx l
.pagedispy
;
73 dolog
" column %d" l
.pagecol
;
77 let debugrect (x0
, y0
, x1
, y1
, x2
, y2
, x3
, y3
) =
79 dolog
" x0,y0=(% f, % f)" x0 y0
;
80 dolog
" x1,y1=(% f, % f)" x1 y1
;
81 dolog
" x2,y2=(% f, % f)" x2 y2
;
82 dolog
" x3,y3=(% f, % f)" x3 y3
;
86 let isbirdseye = function
93 let istextentry = function
100 let wtmode = ref false;;
101 let cxack = ref false;;
103 let pgscale h
= truncate
(float h
*. conf
.pgscale);;
106 if not state
.uioh#alwaysscrolly
&& (conf
.scrollb
land scrollbhv
= 0)
107 || (state
.x
= 0 && state
.w
<= state
.winw
- conf
.scrollbw
)
113 if not state
.uioh#alwaysscrolly
&& (conf
.scrollb
land scrollbvv
= 0)
118 let wadjsb () = -vscrollw ();;
119 let xadjsb () = if conf
.leftscroll
then vscrollw () else 0;;
122 fstate
.fontsize
<- n
;
123 fstate
.wwidth
<- measurestr fstate
.fontsize
"w";
124 fstate
.maxrows
<- (state
.winh
- fstate
.fontsize
- 1) / (fstate
.fontsize
+ 1);
130 Printf.kprintf prerr_endline fmt
132 Printf.kprintf ignore fmt
136 if emptystr conf
.pathlauncher
137 then print_endline state
.path
139 let command = Str.global_replace percentsre state
.path conf
.pathlauncher
in
140 try addpid
@@ popen
command []
142 Printf.eprintf
"failed to execute `%s': %s\n" command (exntos exn
);
147 let redirectstderr () =
148 let clofail what errmsg
= dolog
"failed to close %s: %s" what errmsg
in
149 if conf
.redirectstderr
151 match Unix.pipe
() with
153 dolog
"failed to create stderr redirection pipes: %s" (exntos exn
)
156 begin match Unix.dup
Unix.stderr
with
158 dolog
"failed to dup stderr: %s" (exntos exn
);
159 Ne.clo r
(clofail "pipe/r");
160 Ne.clo w
(clofail "pipe/w");
163 begin match Unix.dup2 w
Unix.stderr
with
165 dolog
"failed to dup2 to stderr: %s" (exntos exn
);
166 Ne.clo dupstderr
(clofail "stderr duplicate");
167 Ne.clo r
(clofail "redir pipe/r");
168 Ne.clo w
(clofail "redir pipe/w");
171 state
.stderr
<- dupstderr
;
172 state
.errfd
<- Some r
;
176 state
.newerrmsgs
<- false;
177 begin match state
.errfd
with
179 begin match Unix.dup2 state
.stderr
Unix.stderr
with
181 dolog
"failed to dup2 original stderr: %s" (exntos exn
)
183 Ne.clo fd
(clofail "dup of stderr");
188 prerr_string
(Buffer.contents state
.errmsgs
);
190 Buffer.clear state
.errmsgs
;
196 let postRedisplay who
=
198 then prerr_endline
("redisplay for " ^ who
);
199 state
.redisplay
<- true;
203 let getopaque pageno
=
204 try Some
(Hashtbl.find state
.pagemap
(pageno
, state
.gen
))
205 with Not_found
-> None
208 let putopaque pageno opaque
=
209 Hashtbl.replace state
.pagemap
(pageno
, state
.gen
) opaque
212 let pagetranslatepoint l x y
=
213 let dy = y
- l
.pagedispy
in
214 let y = dy + l
.pagey
in
215 let dx = x
- l
.pagedispx
in
216 let x = dx + l
.pagex
in
220 let onppundermouse g
x y d
=
223 begin match getopaque l
.pageno
with
225 let x0 = l
.pagedispx
in
226 let x1 = x0 + l
.pagevw
in
227 let y0 = l
.pagedispy
in
228 let y1 = y0 + l
.pagevh
in
229 if y >= y0 && y <= y1 && x >= x0 && x <= x1
231 let px, py
= pagetranslatepoint l
x y in
232 match g opaque l
px py
with
245 let g opaque l
px py
=
248 match rectofblock opaque
px py
with
250 let rect = (a
.(0),a
.(2),a
.(1),a
.(2),a
.(1),a
.(3),a
.(0),a
.(3)) in
251 state
.rects
<- [l
.pageno
, l
.pageno
mod 3, rect];
252 G.postRedisplay "getunder";
255 let under = whatsunder opaque
px py
in
256 if under = Unone
then None
else Some
under
258 onppundermouse g x y Unone
263 match unproject opaque
x y with
264 | Some
(x, y) -> Some
(Some
(opaque
, l
.pageno
, x, y))
267 onppundermouse g x y None
;
271 state
.text
<- Printf.sprintf
"%c%s" c s
;
272 G.postRedisplay "showtext";
275 let pipesel opaque cmd
=
278 match Unix.pipe
() with
281 (Printf.sprintf
"pipesel can not create pipe: %s" (exntos exn
));
283 let doclose what fd
=
284 Ne.clo fd
(fun msg
-> dolog
"%s close failed: %s" what msg
)
287 try popen cmd
[r
, 0; w
, -1]
289 dolog
"can not execute %S: %s" cmd
(exntos exn
);
295 G.postRedisplay "pipesel";
297 else doclose "pipesel pipe/w" w
;
298 doclose "pipesel pipe/r" r
;
302 let g opaque l
px py
=
303 if markunder opaque
px py conf
.paxmark
306 match getopaque l
.pageno
with
308 | Some opaque
-> pipesel opaque conf
.paxcmd
313 G.postRedisplay "paxunder";
314 if conf
.paxmark
= Mark_page
317 match getopaque l
.pageno
with
319 | Some opaque
-> clearmark opaque
) state
.layout
;
321 onppundermouse g x y (fun () -> showtext '
!'
"Whoopsie daisy");
325 match Unix.pipe
() with
327 showtext '
!'
(Printf.sprintf
"pipe failed: %s" (exntos exn
))
330 Ne.clo fd
(fun msg
->
331 showtext '
!'
(Printf.sprintf
"failed to close %s: %s" cap msg
)
335 try popen conf
.selcmd
[r
, 0; w
, -1]
338 (Printf.sprintf
"failed to execute %s: %s"
339 conf
.selcmd
(exntos exn
));
345 let l = String.length s
in
346 let bytes = Bytes.unsafe_of_string s
in
347 let n = tempfailureretry
(Unix.write w
bytes 0) l in
352 "failed to write %d characters to sel pipe, wrote %d"
357 (Printf.sprintf
"failed to write to sel pipe: %s"
362 clo "selstring pipe/r" r
;
363 clo "selstring pipe/w" w
;
366 let undertext = function
369 | Ulinkgoto
(pageno
, _
) -> Printf.sprintf
"%s: page %d" state
.path
(pageno
+1)
370 | Utext s
-> "font: " ^ s
371 | Uunexpected s
-> "unexpected: " ^ s
372 | Ulaunch s
-> "launch: " ^ s
373 | Unamed s
-> "named: " ^ s
374 | Uremote
(filename
, pageno
) ->
375 Printf.sprintf
"%s: page %d" filename
(pageno
+1)
376 | Uremotedest
(filename
, destname
) ->
377 Printf.sprintf
"%s: destination %S" filename destname
378 | Uannotation
(opaque
, slinkindex
) ->
379 "annotation: " ^ getannotcontents opaque slinkindex
382 let updateunder x y =
383 match getunder x y with
384 | Unone
-> Wsi.setcursor
Wsi.CURSOR_INHERIT
386 if conf
.underinfo
then showtext 'u'
("ri: " ^ uri
);
387 Wsi.setcursor
Wsi.CURSOR_INFO
388 | Ulinkgoto
(pageno
, _
) ->
390 then showtext 'p'
("age: " ^ string_of_int
(pageno
+1));
391 Wsi.setcursor
Wsi.CURSOR_INFO
393 if conf
.underinfo
then showtext '
f'
("ont: " ^ s
);
394 Wsi.setcursor
Wsi.CURSOR_TEXT
396 if conf
.underinfo
then showtext 'u'
("nexpected: " ^ s
);
397 Wsi.setcursor
Wsi.CURSOR_INHERIT
399 if conf
.underinfo
then showtext '
l'
("aunch: " ^ s
);
400 Wsi.setcursor
Wsi.CURSOR_INHERIT
402 if conf
.underinfo
then showtext '
n'
("amed: " ^ s
);
403 Wsi.setcursor
Wsi.CURSOR_INHERIT
404 | Uremote
(filename
, pageno
) ->
405 if conf
.underinfo
then showtext 'r'
406 (Printf.sprintf
"emote: %s (%d)" filename
(pageno
+1));
407 Wsi.setcursor
Wsi.CURSOR_INFO
408 | Uremotedest
(filename
, destname
) ->
409 if conf
.underinfo
then showtext 'r'
410 (Printf.sprintf
"emote destination: %s (%S)" filename destname
);
411 Wsi.setcursor
Wsi.CURSOR_INFO
413 if conf
.underinfo
then showtext 'a'
"nnotation";
414 Wsi.setcursor
Wsi.CURSOR_INFO
417 let showlinktype under =
418 if conf
.underinfo
&& under != Unone
419 then showtext ' '
@@ undertext under
422 let intentry_with_suffix text key
=
424 if key
>= 32 && key
< 127
428 match Char.lowercase
c with
430 let text = addchar
text c in
434 let text = addchar
text c in
438 state
.text <- Printf.sprintf
"invalid char (%d, `%c')" key
c;
443 let s = Bytes.create
4 in
444 let n = tempfailureretry
(Unix.read fd
s 0) 4 in
445 if n != 4 then error
"incomplete read(len) = %d" n;
446 let len = (Char.code
(Bytes.get
s 0) lsl 24)
447 lor (Char.code
(Bytes.get
s 1) lsl 16)
448 lor (Char.code
(Bytes.get
s 2) lsl 8)
449 lor (Char.code
(Bytes.get
s 3))
451 let s = Bytes.create
len in
452 let n = tempfailureretry
(Unix.read fd
s 0) len in
453 if n != len then error
"incomplete read(data) %d vs %d" n len;
458 let b = Buffer.create
16 in
459 Buffer.add_string
b "llll";
462 let s = Buffer.to_bytes
b in
463 let n = Bytes.length
s in
465 (* dolog "wcmd %S" (String.sub s 4 len); *)
466 Bytes.set
s 0 (Char.chr
((len lsr 24) land 0xff));
467 Bytes.set
s 1 (Char.chr
((len lsr 16) land 0xff));
468 Bytes.set
s 2 (Char.chr
((len lsr 8) land 0xff));
469 Bytes.set
s 3 (Char.chr
(len land 0xff));
470 let n'
= tempfailureretry
(Unix.write state
.ss
s 0) n in
471 if n'
!= n then error
"write failed %d vs %d" n'
n;
475 let nogeomcmds cmds
=
477 | s, [] -> emptystr
s
481 let layoutN ((columns
, coverA
, coverB
), b) y sh
=
482 let sh = sh - (hscrollh ()) in
483 let wadj = wadjsb () in
484 let rec fold accu
n =
485 if n = Array.length
b
488 let pdimno, dx, vy
, (_
, w
, h
, xoff
) = b.(n) in
491 || n = state
.pagecount
- coverB
492 || (n - coverA
) mod columns
= columns
- 1)
498 let pagey = max
0 (y - vy
) in
499 let pagedispy = if pagey > 0 then 0 else vy
- y in
500 let pagedispx, pagex
=
502 if n = coverA
- 1 || n = state
.pagecount
- coverB
503 then state
.x + (wadj + state
.winw
- w
) / 2
504 else dx + xoff
+ state
.x
511 let vw = wadj + state
.winw
- pagedispx in
512 let pw = w
- pagex
in
515 let pagevh = min
(h
- pagey) (sh - pagedispy) in
516 if pagevw > 0 && pagevh > 0
527 ; pagedispx = pagedispx
528 ; pagedispy = pagedispy
540 if Array.length
b = 0
542 else List.rev
(fold [] (page_of_y
y))
545 let layoutS (columns
, b) y sh =
546 let sh = sh - hscrollh () in
547 let wadj = wadjsb () in
548 let rec fold accu n =
549 if n = Array.length
b
552 let pdimno, px, vy
, (_
, pagew
, pageh
, xoff
) = b.(n) in
559 let x = xoff
+ state
.x in
560 let pagey = max
0 (y - vy
) in
561 let pagedispy = if pagey > 0 then 0 else vy
- y in
562 let pagedispx, pagex
=
576 let pagecolw = pagew
/columns
in
578 if pagecolw < state
.winw
579 then pagedispx + ((wadj + state
.winw
- pagecolw) / 2)
583 let vw = wadj + state
.winw
- pagedispx in
584 let pw = pagew
- pagex
in
587 let pagevw = min
pagevw pagecolw in
588 let pagevh = min
(pageh
- pagey) (sh - pagedispy) in
589 if pagevw > 0 && pagevh > 0
600 ; pagedispx = pagedispx
601 ; pagedispy = pagedispy
602 ; pagecol
= n mod columns
617 if nogeomcmds state
.geomcmds
619 match conf
.columns
with
620 | Csingle
b -> layoutN ((1, 0, 0), b) y sh
621 | Cmulti
c -> layoutN c y sh
622 | Csplit
s -> layoutS s y sh
627 let y = state
.y + incr
in
629 let y = min
y (state
.maxy
- (if conf
.maxhfit
then state
.winh
else 0)) in
634 let tilex = l.pagex
mod conf
.tilew
in
635 let tiley = l.pagey mod conf
.tileh
in
637 let col = l.pagex
/ conf
.tilew
in
638 let row = l.pagey / conf
.tileh
in
640 let xadj = xadjsb () in
641 let rec rowloop row y0 dispy h
=
645 let dh = conf
.tileh
- y0 in
647 let rec colloop col x0 dispx w
=
651 let dw = conf
.tilew
- x0 in
653 let dispx'
= xadj + dispx in
654 f col row dispx' dispy
x0 y0 dw dh;
655 colloop (col+1) 0 (dispx+dw) (w
-dw)
658 colloop col tilex l.pagedispx l.pagevw;
659 rowloop (row+1) 0 (dispy
+dh) (h
-dh)
662 if l.pagevw > 0 && l.pagevh > 0
663 then rowloop row tiley l.pagedispy l.pagevh;
666 let gettileopaque l col row =
668 l.pageno
, state
.gen
, conf
.colorspace
, conf
.angle
, l.pagew
, l.pageh
, col, row
670 try Some
(Hashtbl.find state
.tilemap
key)
671 with Not_found
-> None
674 let puttileopaque l col row gen colorspace angle opaque size elapsed
=
675 let key = l.pageno
, gen
, colorspace
, angle
, l.pagew
, l.pageh
, col, row in
676 Hashtbl.add state
.tilemap
key (opaque
, size
, elapsed
)
679 let filledrect x0 y0 x1 y1 =
680 GlArray.disable `texture_coord
;
681 Raw.sets_float state
.vraw ~pos
:0 [| x0; y0; x0; y1; x1; y0; x1; y1 |];
682 GlArray.vertex `two state
.vraw
;
683 GlArray.draw_arrays `triangle_strip ~first
:0 ~count
:4;
684 GlArray.enable `texture_coord
;
687 let linerect x0 y0 x1 y1 =
688 GlArray.disable `texture_coord
;
689 Raw.sets_float state
.vraw ~pos
:0 [| x0; y0; x0; y1; x1; y1; x1; y0 |];
690 GlArray.vertex `two state
.vraw
;
691 GlArray.draw_arrays `line_loop ~first
:0 ~count
:4;
692 GlArray.enable `texture_coord
;
695 let drawtiles l color
=
697 let wadj = wadjsb () in
699 let f col row x y tilex tiley w h
=
700 match gettileopaque l col row with
701 | Some
(opaque
, _
, t
) ->
702 let params = x, y, w
, h
, tilex, tiley in
704 then GlTex.env
(`mode `blend
);
705 drawtile
params opaque
;
707 then GlTex.env
(`mode `modulate
);
711 let s = Printf.sprintf
715 let w = measurestr fstate
.fontsize
s in
716 GlDraw.color
(0.0, 0.0, 0.0);
717 filledrect (float (x-2))
720 (float (y + fstate
.fontsize
+ 2));
721 GlDraw.color
(1.0, 1.0, 1.0);
722 drawstring fstate
.fontsize
x (y + fstate
.fontsize
- 1) s;
732 let lw = wadj + state
.winw
- x in
735 let lh = state
.winh
- y in
739 then GlTex.env
(`mode `blend
);
740 begin match state
.checkerstexid
with
742 Gl.enable `texture_2d
;
743 GlTex.bind_texture ~target
:`texture_2d id
;
747 and y1 = float (y+h
) in
749 let tw = float w /. 16.0
750 and th
= float h
/. 16.0 in
751 let tx0 = float tilex /. 16.0
752 and ty0
= float tiley /. 16.0 in
754 and ty1
= ty0
+. th
in
755 Raw.sets_float state
.vraw ~pos
:0
756 [| x0; y0; x0; y1; x1; y0; x1; y1 |];
757 Raw.sets_float state
.traw ~pos
:0
758 [| tx0; ty0
; tx0; ty1
; tx1; ty0
; tx1; ty1
|];
759 GlArray.vertex `two state
.vraw
;
760 GlArray.tex_coord `two state
.traw
;
761 GlArray.draw_arrays `triangle_strip ~first
:0 ~count
:4;
762 Gl.disable `texture_2d
;
765 GlDraw.color
(1.0, 1.0, 1.0);
766 filledrect (float x) (float y) (float (x+w)) (float (y+h
));
769 then GlTex.env
(`mode `modulate
);
770 if w > 128 && h
> fstate
.fontsize
+ 10
772 let c = if conf
.invert
then 1.0 else 0.0 in
773 GlDraw.color
(c, c, c);
776 then (col*conf
.tilew
, row*conf
.tileh
)
779 drawstring2 fstate
.fontsize
x y "Loading %d [%d,%d]" l.pageno
c r
;
788 let pagevisible layout n = List.exists
(fun l -> l.pageno
= n) layout;;
790 let tilevisible1 l x y =
792 and ax1
= l.pagex
+ l.pagevw
794 and ay1
= l.pagey + l.pagevh in
798 let bx1 = min
(bx0 + conf
.tilew
) l.pagew
799 and by1
= min
(by0
+ conf
.tileh
) l.pageh
in
801 let rx0 = max
ax0 bx0
802 and ry0
= max ay0 by0
803 and rx1
= min ax1
bx1
804 and ry1
= min ay1 by1
in
806 let nonemptyintersection = rx1
> rx0 && ry1
> ry0
in
810 let tilevisible layout n x y =
811 let rec findpageinlayout m
= function
812 | l :: rest
when l.pageno
= n ->
813 tilevisible1 l x y || (
814 match conf
.columns
with
815 | Csplit
(c, _
) when c > m
-> findpageinlayout (m
+1) rest
820 | _
:: rest
-> findpageinlayout 0 rest
823 findpageinlayout 0 layout;
826 let tileready l x y =
827 tilevisible1 l x y &&
828 gettileopaque l (x/conf
.tilew
) (y/conf
.tileh
) != None
831 let tilepage n p
layout =
832 let rec loop = function
836 let f col row _ _ _ _ _ _
=
837 if state
.currently
= Idle
839 match gettileopaque l col row with
842 let x = col*conf
.tilew
843 and y = row*conf
.tileh
in
845 let w = l.pagew
- x in
849 let h = l.pageh
- y in
854 then getpbo
w h conf
.colorspace
857 wcmd "tile %s %d %d %d %d %s"
858 (~
> p
) x y w h (~
> pbo);
861 l, p
, conf
.colorspace
, conf
.angle
,
862 state
.gen
, col, row, conf
.tilew
, conf
.tileh
871 if nogeomcmds state
.geomcmds
875 let preloadlayout y =
876 let y = if y < state
.winh
then 0 else y - state
.winh
in
877 let h = state
.winh
*3 in
883 if state
.currently
!= Idle
888 begin match getopaque l.pageno
with
890 wcmd "page %d %d" l.pageno
l.pagedimno
;
891 state
.currently
<- Loading
(l, state
.gen
);
893 tilepage l.pageno opaque pages
;
898 if nogeomcmds state
.geomcmds
904 if conf
.preload && state
.currently
= Idle
905 then load (preloadlayout state
.y);
908 let layoutready layout =
909 let rec fold all ls
=
912 let seen = ref false in
913 let allvisible = ref true in
914 let foo col row _ _ _ _ _ _
=
916 allvisible := !allvisible &&
917 begin match gettileopaque l col row with
923 fold (!seen && !allvisible) rest
926 let alltilesvisible = fold true layout in
931 let y = bound
y 0 state
.maxy
in
932 let y, layout, proceed
=
933 match conf
.maxwait
with
934 | Some time
when state
.ghyll
== noghyll
->
935 begin match state
.throttle
with
937 let layout = layout y state
.winh
in
938 let ready = layoutready layout in
942 state
.throttle
<- Some
(layout, y, now
());
944 else G.postRedisplay "gotoy showall (None)";
946 | Some
(_
, _
, started
) ->
947 let dt = now
() -. started
in
950 state
.throttle
<- None
;
951 let layout = layout y state
.winh
in
953 G.postRedisplay "maxwait";
960 let layout = layout y state
.winh
in
961 if not
!wtmode || layoutready layout
962 then G.postRedisplay "gotoy ready";
968 state
.layout <- layout;
969 begin match state
.mode
with
972 | Ltexact
(pageno
, linkno
) ->
973 let rec loop = function
975 state
.mode
<- LinkNav
(Ltgendir
0)
976 | l :: _
when l.pageno
= pageno
->
977 begin match getopaque pageno
with
978 | None
-> state
.mode
<- LinkNav
(Ltnotready
(pageno
, 0))
980 let x0, y0, x1, y1 = getlinkrect opaque linkno
in
981 if not
(x0 >= l.pagex
&& x1 <= l.pagex
+ l.pagevw
982 && y0 >= l.pagey && y1 <= l.pagey + l.pagevh)
983 then state
.mode
<- LinkNav
(Ltgendir
0)
985 | _
:: rest
-> loop rest
988 | Ltnotready _
| Ltgendir _
-> ()
994 begin match state
.mode
with
995 | Birdseye
(conf
, leftx
, pageno
, hooverpageno
, anchor
) ->
996 if not
(pagevisible layout pageno
)
998 match state
.layout with
1001 state
.mode
<- Birdseye
(
1002 conf
, leftx
, l.pageno
, hooverpageno
, anchor
1007 | Ltnotready
(_
, dir
)
1010 let rec loop = function
1013 match getopaque l.pageno
with
1014 | None
-> Ltnotready
(l.pageno
, dir
)
1019 then LDfirstvisible
(l.pagex
, l.pagey, dir
)
1021 if dir
> 0 then LDfirst
else LDlast
1027 | Lnotfound
-> loop rest
1029 showlinktype (getlink opaque
n);
1030 Ltexact
(l.pageno
, n)
1034 state
.mode
<- LinkNav
linknav
1042 state
.ghyll
<- noghyll
;
1045 let mx, my
= state
.mpos
in
1050 let conttiling pageno opaque
=
1051 tilepage pageno opaque
1052 (if conf
.preload then preloadlayout state
.y else state
.layout)
1055 let gotoy_and_clear_text y =
1056 if not conf
.verbose
then state
.text <- E.s;
1060 let getanchory (n, top
, dtop
) =
1061 let y, h = getpageyh
n in
1062 if conf
.presentation
1064 let ips = calcips
h in
1065 y + truncate
(top
*.float h -. dtop
*.float ips) + ips;
1067 y + truncate
(top
*.float h -. dtop
*.float conf
.interpagespace
)
1070 let gotoanchor anchor
=
1071 gotoy (getanchory anchor
);
1075 cbput state
.hists
.nav
(getanchor
());
1079 let anchor = cbgetc state
.hists
.nav dir
in
1083 let gotoghyll1 single
y =
1084 let scroll f n a
b =
1085 (* http://devmaster.net/forums/topic/9796-ease-in-ease-out-algorithm/ *)
1087 let s x = 3.0*.x**2.0 -. 2.0*.x**3.0 in
1089 then s (float f /. float a
)
1092 then 1.0 -. s ((float (f-b) /. float (n-b)))
1098 let ins = float a
*. 0.5
1099 and outs
= float (n-b) *. 0.5 in
1101 ins +. outs
+. float ones
1103 let rec set nab
y sy
=
1104 let (_N
, _A
, _B
), y =
1107 let scl = if y > sy
then 2 else -2 in
1108 let _N, _
, _
= nab
in
1109 (_N,0,_N), y+conf
.scrollstep
*scl
1111 let sum = summa
_N _A _B
in
1112 let dy = float (y - sy
) in
1116 then state
.ghyll
<- noghyll
1119 let s = scroll n _N _A _B
in
1120 let y1 = y1 +. ((s *. dy) /. sum) in
1121 gotoy_and_clear_text (truncate
y1);
1122 state
.ghyll
<- gf (n+1) y1;
1126 | Some
y'
when single
-> set nab
y' state
.y
1127 | Some
y'
-> set (_N/2, 1, 1) y' state
.y
1129 gf 0 (float state
.y)
1132 match conf
.ghyllscroll
with
1133 | Some nab
when not conf
.presentation
->
1134 if state
.ghyll
== noghyll
1135 then set nab
y state
.y
1136 else state
.ghyll
(Some
y)
1138 gotoy_and_clear_text y
1141 let gotoghyll = gotoghyll1 false;;
1143 let gotopage n top
=
1144 let y, h = getpageyh
n in
1145 let y = y + (truncate
(top
*. float h)) in
1149 let gotopage1 n top
=
1150 let y = getpagey
n in
1155 let invalidate s f =
1160 match state
.geomcmds
with
1161 | ps
, [] when emptystr ps
->
1163 state
.geomcmds
<- s, [];
1166 state
.geomcmds
<- ps
, [s, f];
1168 | ps
, (s'
, _
) :: rest
when s'
= s ->
1169 state
.geomcmds
<- ps
, ((s, f) :: rest
);
1172 state
.geomcmds
<- ps
, ((s, f) :: cmds
);
1176 Hashtbl.iter
(fun _ opaque
->
1177 wcmd "freepage %s" (~
> opaque
);
1179 Hashtbl.clear state
.pagemap
;
1183 if not
(Queue.is_empty state
.tilelru
)
1185 Queue.iter
(fun (k
, p
, s) ->
1186 wcmd "freetile %s" (~
> p
);
1187 state
.memused
<- state
.memused
- s;
1188 Hashtbl.remove state
.tilemap k
;
1190 state
.uioh#infochanged Memused
;
1191 Queue.clear state
.tilelru
;
1197 let h = truncate
(float h*.conf
.zoom
) in
1198 let d = conf
.interpagespace
lsl (if conf
.presentation
then 1 else 0) in
1202 let opendoc path password
=
1204 state
.password
<- password
;
1205 state
.gen
<- state
.gen
+ 1;
1206 state
.docinfo
<- [];
1207 state
.outlines
<- [||];
1210 setaalevel conf
.aalevel
;
1212 if emptystr state
.origin
1216 Wsi.settitle
("llpp " ^
(mbtoutf8
(Filename.basename
titlepath)));
1217 wcmd "open %d %d %s\000%s\000" (btod
!wtmode) (btod
!cxack) path password
;
1218 invalidate "reqlayout"
1220 wcmd "reqlayout %d %d %d %s\000"
1221 conf
.angle
(FMTE.to_int conf
.fitmodel
)
1222 (stateh state
.winh
) state
.nameddest
1227 state
.anchor <- getanchor
();
1228 opendoc state
.path state
.password
;
1232 let c = c *. conf
.colorscale
in
1236 let scalecolor2 (r
, g, b) =
1237 (r
*. conf
.colorscale
, g *. conf
.colorscale
, b *. conf
.colorscale
);
1240 let docolumns columns
=
1241 let wadj = wadjsb () in
1244 let a = Array.make state
.pagecount
(-1, -1, -1, (-1, -1, -1, -1)) in
1245 let wadj = wadjsb () in
1246 let rec loop pageno
pdimno pdim
y ph pdims
=
1247 if pageno
= state
.pagecount
1250 let pdimno, ((_
, w, h, xoff
) as pdim
), pdims
=
1252 | ((pageno'
, _
, _
, _
) as pdim
) :: rest
when pageno'
= pageno
->
1253 pdimno+1, pdim
, rest
1257 let x = max
0 (((wadj + state
.winw
- w) / 2) - xoff
) in
1259 (if conf
.presentation
1260 then (if pageno
= 0 then calcips
h else calcips ph
+ calcips
h)
1261 else (if pageno
= 0 then 0 else conf
.interpagespace
)
1264 a.(pageno
) <- (pdimno, x, y, pdim
);
1265 loop (pageno
+1) pdimno pdim
(y + h) h pdims
1267 loop 0 ~
-1 (-1,-1,-1,-1) 0 0 state
.pdims
;
1268 conf
.columns
<- Csingle
a;
1270 | Cmulti
((columns
, coverA
, coverB
), _
) ->
1271 let a = Array.make state
.pagecount
(-1, -1, -1, (-1, -1, -1, -1)) in
1272 let rec loop pageno
pdimno pdim
x y rowh pdims
=
1273 let rec fixrow m
= if m
= pageno
then () else
1274 let (pdimno, x, y, ((_
, _
, h, _
) as pdim
)) = a.(m
) in
1277 let y = y + (rowh
- h) / 2 in
1278 a.(m
) <- (pdimno, x, y, pdim
);
1282 if pageno
= state
.pagecount
1283 then fixrow (((pageno
- 1) / columns
) * columns
)
1285 let pdimno, ((_
, w, h, xoff
) as pdim
), pdims
=
1287 | ((pageno'
, _
, _
, _
) as pdim
) :: rest
when pageno'
= pageno
->
1288 pdimno+1, pdim
, rest
1293 if pageno
= coverA
- 1 || pageno
= state
.pagecount
- coverB
1295 let x = (wadj + state
.winw
- w) / 2 in
1297 if conf
.presentation
then calcips
h else conf
.interpagespace
in
1298 x, y + ips + rowh
, h
1301 if (pageno
- coverA
) mod columns
= 0
1303 let x = max
0 (wadj + state
.winw
- state
.w) / 2 in
1305 if conf
.presentation
1307 let ips = calcips
h in
1308 y + (if pageno
= 0 then 0 else calcips rowh
+ ips)
1310 y + (if pageno
= 0 then 0 else conf
.interpagespace
)
1314 else x, y, max rowh
h
1318 if pageno
> 1 && (pageno
- coverA
) mod columns
= 0
1321 if pageno
= columns
&& conf
.presentation
1323 let ips = calcips rowh
in
1324 for i
= 0 to pred columns
1326 let (pdimno, x, y, pdim
) = a.(i
) in
1327 a.(i
) <- (pdimno, x, y+ips, pdim
)
1333 fixrow (pageno
- columns
);
1338 a.(pageno
) <- (pdimno, x, y, pdim
);
1339 let x = x + w + xoff
*2 + conf
.interpagespace
in
1340 loop (pageno
+1) pdimno pdim
x y rowh' pdims
1342 loop 0 ~
-1 (-1,-1,-1,-1) 0 0 0 state
.pdims
;
1343 conf
.columns
<- Cmulti
((columns
, coverA
, coverB
), a);
1346 let a = Array.make
(state
.pagecount
*c) (-1, -1, -1, (-1, -1, -1, -1)) in
1347 let rec loop pageno
pdimno pdim
y pdims
=
1348 if pageno
= state
.pagecount
1351 let pdimno, ((_
, w, h, _
) as pdim
), pdims
=
1353 | ((pageno'
, _
, _
, _
) as pdim
) :: rest
when pageno'
= pageno
->
1354 pdimno+1, pdim
, rest
1359 let rec loop1 n x y =
1360 if n = c then y else (
1361 a.(pageno
*c + n) <- (pdimno, x, y, pdim
);
1362 loop1 (n+1) (x+cw) (y + h + conf
.interpagespace
)
1365 let y = loop1 0 0 y in
1366 loop (pageno
+1) pdimno pdim
y pdims
1368 loop 0 ~
-1 (-1,-1,-1,-1) 0 state
.pdims
;
1369 conf
.columns
<- Csplit
(c, a);
1373 docolumns conf
.columns
;
1374 state
.maxy
<- calcheight
();
1375 if state
.reprf
== noreprf
1377 match state
.mode
with
1378 | Birdseye
(_
, _
, pageno
, _
, _
) ->
1379 let y, h = getpageyh pageno
in
1380 let top = (state
.winh
- h) / 2 in
1381 gotoy (max
0 (y - top))
1384 | LinkNav _
-> gotoanchor state
.anchor
1388 state
.reprf
<- noreprf
;
1393 GlDraw.viewport ~
x:0 ~
y:0 ~
w:w ~
h:h;
1394 let firsttime = state
.geomcmds
== firstgeomcmds
in
1395 if not
firsttime && nogeomcmds state
.geomcmds
1396 then state
.anchor <- getanchor
();
1399 let w = wadjsb () + (truncate
(float w *. conf
.zoom
)) in
1402 setfontsize fstate
.fontsize
;
1403 GlMat.mode `modelview
;
1404 GlMat.load_identity
();
1406 GlMat.mode `projection
;
1407 GlMat.load_identity
();
1408 GlMat.rotate ~
x:1.0 ~angle
:180.0 ();
1409 GlMat.translate ~
x:~
-.1.0 ~
y:~
-.1.0 ();
1410 GlMat.scale3
(2.0 /. float state
.winw
, 2.0 /. float state
.winh
, 1.0);
1415 else float state
.x /. float state
.w
1417 invalidate "geometry"
1421 then state
.x <- truncate
(relx *. float w);
1423 match conf
.columns
with
1425 | Cmulti
((c, _
, _
), _
) -> (w - (c-1)*conf
.interpagespace
) / c
1426 | Csplit
(c, _
) -> w * c
1428 wcmd "geometry %d %d %d"
1429 w (stateh h) (FMTE.to_int conf
.fitmodel
)
1434 let len = String.length state
.text in
1435 let x0 = xadjsb () in
1438 match state
.mode
with
1439 | Textentry _
| View
| LinkNav _
->
1440 let h, _
, _
= state
.uioh#scrollpw
in
1445 filledrect x (float (state
.winh
- (fstate
.fontsize
+ 4) - hscrollh))
1446 (x+.w) (float (state
.winh
- hscrollh))
1449 let w = float (wadjsb () + state
.winw
- 1) in
1450 if state
.progress
>= 0.0 && state
.progress
< 1.0
1452 GlDraw.color
(0.3, 0.3, 0.3);
1453 let w1 = w *. state
.progress
in
1455 GlDraw.color
(0.0, 0.0, 0.0);
1456 rect (float x0+.w1) (float x0+.w-.w1)
1459 GlDraw.color
(0.0, 0.0, 0.0);
1463 GlDraw.color
(1.0, 1.0, 1.0);
1464 drawstring fstate
.fontsize
1465 (if conf
.leftscroll
then x0 + 2 else x0 + if len > 0 then 8 else 2)
1466 (state
.winh
- hscrollh - 5) s;
1469 match state
.mode
with
1470 | Textentry
((prefix
, text, _
, _
, _
, _
), _
) ->
1474 Printf.sprintf
"%s%s_ [%s]" prefix
text state
.text
1476 Printf.sprintf
"%s%s_" prefix
text
1482 | LinkNav _
-> state
.text
1487 if not
(istextentry state
.mode
) && state
.uioh#eformsgs
1489 let s1 = "(press 'e' to review error messasges)" in
1490 if nonemptystr
s then s ^
" " ^
s1 else s1
1500 let len = Queue.length state
.tilelru
in
1502 match state
.throttle
with
1505 then preloadlayout state
.y
1507 | Some
(layout, _
, _
) ->
1511 if state
.memused
<= conf
.memlimit
1516 let (k
, p
, s) as lruitem
= Queue.pop state
.tilelru
in
1517 let n, gen
, colorspace
, angle
, pagew
, pageh
, col, row = k
in
1518 let (_
, pw, ph
, _
) = getpagedim
n in
1521 && colorspace
= conf
.colorspace
1522 && angle
= conf
.angle
1526 let x = col*conf
.tilew
1527 and y = row*conf
.tileh
in
1528 tilevisible (Lazy.force_val
layout) n x y
1530 then Queue.push lruitem state
.tilelru
1533 wcmd "freetile %s" (~
> p
);
1534 state
.memused
<- state
.memused
- s;
1535 state
.uioh#infochanged Memused
;
1536 Hashtbl.remove state
.tilemap k
;
1544 let onpagerect pageno
f =
1546 match conf
.columns
with
1547 | Cmulti
(_
, b) -> b
1549 | Csplit
(_
, b) -> b
1551 if pageno
>= 0 && pageno
< Array.length
b
1553 let (_
, _
, _
, (w, h, _
, _
)) = b.(pageno
) in
1557 let gotopagexy1 pageno
x y =
1558 let _,w1,h1
,leftx
= getpagedim pageno
in
1559 let top = y /. (float h1
) in
1560 let left = x /. (float w1) in
1561 let py, w, h = getpageywh pageno
in
1562 let wh = state
.winh
- hscrollh () in
1563 let x = left *. (float w) in
1564 let x = leftx
+ state
.x + truncate
x in
1565 let wadj = wadjsb () in
1567 if x < 0 || x >= wadj + state
.winw
1571 let pdy = truncate
(top *. float h) in
1572 let y'
= py + pdy in
1573 let dy = y'
- state
.y in
1575 if x != state
.x || not
(dy > 0 && dy < wh)
1577 if conf
.presentation
1579 if abs
(py - y'
) > wh
1586 if state
.x != sx || state
.y != sy
1591 let ww = wadj + state
.winw
in
1593 and qy
= pdy / wh in
1595 and y = py + qy
* wh in
1596 let x = if -x + ww > w1 then -(w1-ww) else x
1597 and y'
= if y + wh > state
.maxy
then state
.maxy
- wh else y in
1599 if conf
.presentation
1601 if abs
(py - y'
) > wh
1611 gotoy_and_clear_text y;
1613 else gotoy_and_clear_text state
.y;
1616 let gotopagexy pageno
x y =
1617 match state
.mode
with
1618 | Birdseye
_ -> gotopage pageno
0.0
1621 | LinkNav
_ -> gotopagexy1 pageno
x y
1624 let getpassword () =
1625 let passcmd = getenvwithdef
"LLPP_ASKPASS" conf
.passcmd in
1630 showtext '
!'
@@ "error getting password: " ^
s;
1631 dolog
"%s" s) passcmd;
1635 (* dolog "%S" cmds; *)
1636 let cl = splitatspace cmds
in
1638 try Scanf.sscanf
s fmt
f
1640 dolog
"error processing '%S': %s" cmds
(exntos exn
);
1643 let addoutline outline
=
1644 match state
.currently
with
1645 | Outlining outlines
->
1646 state
.currently
<- Outlining
(outline
:: outlines
)
1647 | Idle
-> state
.currently
<- Outlining
[outline
]
1650 dolog
"invalid outlining state";
1651 logcurrently state
.currently
1655 state
.uioh#infochanged Pdim
;
1658 | "clearrects" :: [] ->
1659 state
.rects
<- state
.rects1
;
1660 G.postRedisplay "clearrects";
1662 | "continue" :: args
:: [] ->
1663 let n = scan args
"%u" (fun n -> n) in
1664 state
.pagecount
<- n;
1665 begin match state
.currently
with
1667 state
.currently
<- Idle
;
1668 state
.outlines
<- Array.of_list
(List.rev
l)
1674 let cur, cmds
= state
.geomcmds
in
1676 then failwith
"umpossible";
1678 begin match List.rev cmds
with
1680 state
.geomcmds
<- E.s, [];
1681 state
.throttle
<- None
;
1685 state
.geomcmds
<- s, List.rev rest
;
1687 if conf
.maxwait
= None
&& not
!wtmode
1688 then G.postRedisplay "continue";
1690 | "msg" :: args
:: [] ->
1693 | "vmsg" :: args
:: [] ->
1695 then showtext ' ' args
1697 | "emsg" :: args
:: [] ->
1698 Buffer.add_string state
.errmsgs args
;
1699 state
.newerrmsgs
<- true;
1700 G.postRedisplay "error message"
1702 | "progress" :: args
:: [] ->
1703 let progress, text =
1706 f, String.sub args pos
(String.length args
- pos
))
1709 state
.progress <- progress;
1710 G.postRedisplay "progress"
1712 | "firstmatch" :: args
:: [] ->
1713 let pageno, c, x0, y0, x1, y1, x2
, y2
, x3
, y3
=
1714 scan args
"%u %d %f %f %f %f %f %f %f %f"
1715 (fun p
c x0 y0 x1 y1 x2 y2 x3 y3
->
1716 (p
, c, x0, y0, x1, y1, x2
, y2
, x3
, y3
))
1718 let xoff = float (xadjsb ()) in
1722 and x3
= x3
+. xoff in
1723 let y = (getpagey
pageno) + truncate
y0 in
1726 state
.rects1
<- [pageno, c, (x0, y0, x1, y1, x2
, y2
, x3
, y3
)]
1728 | "match" :: args
:: [] ->
1729 let pageno, c, x0, y0, x1, y1, x2
, y2
, x3
, y3
=
1730 scan args
"%u %d %f %f %f %f %f %f %f %f"
1731 (fun p
c x0 y0 x1 y1 x2 y2 x3 y3
->
1732 (p
, c, x0, y0, x1, y1, x2
, y2
, x3
, y3
))
1734 let xoff = float (xadjsb ()) in
1738 and x3
= x3
+. xoff in
1740 (pageno, c, (x0, y0, x1, y1, x2
, y2
, x3
, y3
)) :: state
.rects1
1742 | "page" :: args
:: [] ->
1743 let pageopaques, t
= scan args
"%s %f" (fun p t
-> p
, t
) in
1744 let pageopaque = ~
< pageopaques in
1745 begin match state
.currently
with
1746 | Loading
(l, gen
) ->
1747 vlog "page %d took %f sec" l.pageno t
;
1748 Hashtbl.replace state
.pagemap
(l.pageno, gen
) pageopaque;
1749 begin match state
.throttle
with
1751 let preloadedpages =
1753 then preloadlayout state
.y
1758 List.fold_left
(fun s l -> IntSet.add
l.pageno s)
1759 IntSet.empty
preloadedpages
1762 Hashtbl.fold (fun ((pageno, _) as key) opaque
accu ->
1763 if not
(IntSet.mem
pageno set)
1765 wcmd "freepage %s" (~
> opaque
);
1771 List.iter
(Hashtbl.remove state
.pagemap
) evictedpages;
1774 state
.currently
<- Idle
;
1777 tilepage l.pageno pageopaque state
.layout;
1779 load preloadedpages;
1780 let visible = pagevisible state
.layout l.pageno in
1783 match state
.mode
with
1784 | LinkNav
(Ltnotready
(pageno, dir
)) ->
1785 if pageno = l.pageno
1790 then LDfirstvisible
(l.pagex
, l.pagey, dir
)
1792 if dir
> 0 then LDfirst
else LDlast
1795 findlink
pageopaque ld
1800 showlinktype (getlink
pageopaque n);
1801 state
.mode
<- LinkNav
(Ltexact
(l.pageno, n))
1803 | LinkNav
(Ltgendir
_)
1804 | LinkNav
(Ltexact
_)
1810 if visible && layoutready state
.layout
1812 G.postRedisplay "page";
1816 | Some
(layout, _, _) ->
1817 state
.currently
<- Idle
;
1818 tilepage l.pageno pageopaque layout;
1825 dolog
"Inconsistent loading state";
1826 logcurrently state
.currently
;
1830 | "tile" :: args
:: [] ->
1831 let (x, y, opaques
, size
, t
) =
1832 scan args
"%u %u %s %u %f"
1833 (fun x y p size t
-> (x, y, p
, size
, t
))
1835 let opaque = ~
< opaques
in
1836 begin match state
.currently
with
1837 | Tiling
(l, pageopaque, cs
, angle
, gen
, col, row, tilew
, tileh
) ->
1838 vlog "tile %d [%d,%d] took %f sec" l.pageno col row t
;
1841 if tilew
!= conf
.tilew
|| tileh
!= conf
.tileh
1843 wcmd "freetile %s" (~
> opaque);
1844 state
.currently
<- Idle
;
1848 puttileopaque l col row gen cs angle
opaque size t
;
1849 state
.memused
<- state
.memused
+ size
;
1850 state
.uioh#infochanged Memused
;
1852 Queue.push
((l.pageno, gen
, cs
, angle
, l.pagew
, l.pageh
, col, row),
1853 opaque, size
) state
.tilelru
;
1856 match state
.throttle
with
1857 | None
-> state
.layout
1858 | Some
(layout, _, _) -> layout
1861 state
.currently
<- Idle
;
1863 && conf
.colorspace
= cs
1864 && conf
.angle
= angle
1865 && tilevisible layout l.pageno x y
1866 then conttiling l.pageno pageopaque;
1868 begin match state
.throttle
with
1870 preload state
.layout;
1872 && conf
.colorspace
= cs
1873 && conf
.angle
= angle
1874 && tilevisible state
.layout l.pageno x y
1875 && (not
!wtmode || layoutready state
.layout)
1876 then G.postRedisplay "tile nothrottle";
1878 | Some
(layout, y, _) ->
1879 let ready = layoutready layout in
1883 state
.layout <- layout;
1884 state
.throttle
<- None
;
1885 G.postRedisplay "throttle";
1894 dolog
"Inconsistent tiling state";
1895 logcurrently state
.currently
;
1899 | "pdim" :: args
:: [] ->
1900 let (n, w, h, _) as pdim
=
1901 scan args
"%u %u %u %u" (fun n w h x -> n, w, h, x)
1904 match conf
.fitmodel
with
1906 | FitPage
| FitProportional
->
1907 match conf
.columns
with
1908 | Csplit
_ -> (n, w, h, 0)
1909 | Csingle
_ | Cmulti
_ -> pdim
1911 state
.uioh#infochanged Pdim
;
1912 state
.pdims
<- pdim :: state
.pdims
1914 | "o" :: args
:: [] ->
1915 let (l, n, t
, h, pos
) =
1916 scan args
"%u %u %d %u %n"
1917 (fun l n t
h pos
-> l, n, t
, h, pos
)
1919 let s = String.sub args pos
(String.length args
- pos
) in
1920 addoutline (s, l, Oanchor
(n, float t
/. float h, 0.0))
1922 | "ou" :: args
:: [] ->
1923 let (l, len, pos
) = scan args
"%u %u %n" (fun l len pos
-> l, len, pos
) in
1924 let s = String.sub args pos
len in
1925 let pos2 = pos
+ len + 1 in
1926 let uri = String.sub args
pos2 (String.length args
- pos2) in
1927 addoutline (s, l, Ouri
uri)
1929 | "on" :: args
:: [] ->
1930 let (l, pos
) = scan args
"%u %n" (fun l pos
-> l, pos
) in
1931 let s = String.sub args pos
(String.length args
- pos
) in
1932 addoutline (s, l, Onone
)
1934 | "a" :: args
:: [] ->
1936 scan args
"%u %d %d" (fun n l t
-> n, l, t
)
1938 state
.reprf
<- (fun () -> gotopagexy n (float l) (float t
))
1940 | "info" :: args
:: [] ->
1941 let pos = nindex args '
\t'
in
1942 if pos >= 0 && String.sub args
0 pos = "Title"
1944 let s = String.sub args
(pos+1) @@ String.length args
- pos - 1 in
1948 state
.docinfo
<- (1, args
) :: state
.docinfo
1950 | "infoend" :: [] ->
1951 state
.uioh#infochanged Docinfo
;
1952 state
.docinfo
<- List.rev state
.docinfo
1956 then Wsi.settitle
"Wrong password";
1957 let password = getpassword () in
1959 then error
"document is password protected"
1960 else opendoc state
.path
password
1963 error
"unknown cmd `%S'" cmds
1968 let action = function
1969 | HCprev
-> cbget cb ~
-1
1970 | HCnext
-> cbget cb
1
1971 | HCfirst
-> cbget cb ~
-(cb
.rc)
1972 | HClast
-> cbget cb
(cb
.len - 1 - cb
.rc)
1973 and cancel
() = cb
.rc <- rc
1977 let search pattern forward
=
1978 match conf
.columns
with
1980 showtext '
!'
"searching does not work properly in split columns mode"
1983 if nonemptystr pattern
1986 match state
.layout with
1989 l.pageno, (l.pagey + if forward
then 0 else 0*l.pagevh)
1991 wcmd "search %d %d %d %d,%s\000"
1992 (btod conf
.icase
) pn py (btod forward
) pattern
;
1995 let intentry text key =
1997 if key >= 32 && key < 127
2003 let text = addchar
text c in
2007 state
.text <- Printf.sprintf
"invalid char (%d, `%c')" key c;
2011 let linknentry text key =
2013 if key >= 32 && key < 127
2019 let text = addchar
text c in
2023 state
.text <- Printf.sprintf
"invalid char (%d, `%c')" key c;
2031 let l = String.length
s in
2032 let rec loop pos n = if pos = l then n else
2033 let m = Char.code
s.[pos] - (if pos = 0 && l > 1 then 96 else 97) in
2034 loop (pos+1) (n*26 + m)
2037 let rec loop n = function
2040 match getopaque l.pageno with
2041 | None
-> loop n rest
2043 let m = getlinkcount
opaque in
2046 let under = getlink
opaque n in
2049 else loop (n-m) rest
2051 loop n state
.layout;
2055 let textentry text key =
2056 if key land 0xff00 = 0xff00
2058 else TEcont
(text ^ toutf8
key)
2061 let reqlayout angle fitmodel
=
2062 match state
.throttle
with
2064 if nogeomcmds state
.geomcmds
2065 then state
.anchor <- getanchor
();
2066 conf
.angle
<- angle
mod 360;
2069 match state
.mode
with
2070 | LinkNav
_ -> state
.mode
<- View
2075 conf
.fitmodel
<- fitmodel
;
2076 invalidate "reqlayout"
2078 wcmd "reqlayout %d %d %d"
2079 conf
.angle
(FMTE.to_int conf
.fitmodel
) (stateh state
.winh
)
2084 let settrim trimmargins trimfuzz
=
2085 if nogeomcmds state
.geomcmds
2086 then state
.anchor <- getanchor
();
2087 conf
.trimmargins
<- trimmargins
;
2088 conf
.trimfuzz
<- trimfuzz
;
2089 let x0, y0, x1, y1 = trimfuzz
in
2090 invalidate "settrim"
2092 wcmd "settrim %d %d %d %d %d" (btod conf
.trimmargins
) x0 y0 x1 y1);
2097 match state
.throttle
with
2099 let zoom = max
0.0001 zoom in
2100 if zoom <> conf
.zoom
2102 state
.prevzoom
<- (conf
.zoom, state
.x);
2104 reshape state
.winw state
.winh
;
2105 state
.text <- Printf.sprintf
"zoom is now %-5.2f" (zoom *. 100.0);
2108 | Some
(layout, y, started
) ->
2110 match conf
.maxwait
with
2114 let dt = now
() -. started
in
2122 let setcolumns mode columns coverA coverB
=
2123 state
.prevcolumns
<- Some
(conf
.columns
, conf
.zoom);
2127 then showtext '
!'
"split mode doesn't work in bird's eye"
2129 conf
.columns
<- Csplit
(-columns
, E.a);
2137 conf
.columns
<- Csingle
E.a;
2142 conf
.columns
<- Cmulti
((columns
, coverA
, coverB
), E.a);
2146 reshape state
.winw state
.winh
;
2149 let resetmstate () =
2150 state
.mstate
<- Mnone
;
2151 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
2154 let enterbirdseye () =
2155 let zoom = float conf
.thumbw
/. float state
.winw
in
2156 let birdseyepageno =
2157 let cy = state
.winh
/ 2 in
2161 let rec fold best
= function
2164 let d = cy - (l.pagedispy + l.pagevh/2)
2165 and dbest
= cy - (best
.pagedispy + best
.pagevh/2) in
2166 if abs
d < abs dbest
2173 state
.mode
<- Birdseye
(
2174 { conf
with zoom = conf
.zoom }, state
.x, birdseyepageno, -1, getanchor
()
2178 conf
.presentation
<- false;
2179 conf
.interpagespace
<- 10;
2180 conf
.hlinks
<- false;
2181 conf
.fitmodel
<- FitPage
;
2183 conf
.maxwait
<- None
;
2185 match conf
.beyecolumns
with
2188 Cmulti
((c, 0, 0), E.a)
2189 | None
-> Csingle
E.a
2193 state
.text <- Printf.sprintf
"birds eye mode on (zoom %3.1f%%)"
2198 reshape state
.winw state
.winh
;
2201 let leavebirdseye (c, leftx
, pageno, _, anchor) goback
=
2203 conf
.zoom <- c.zoom;
2204 conf
.presentation
<- c.presentation
;
2205 conf
.interpagespace
<- c.interpagespace
;
2206 conf
.maxwait
<- c.maxwait
;
2207 conf
.hlinks
<- c.hlinks
;
2208 conf
.fitmodel
<- c.fitmodel
;
2209 conf
.beyecolumns
<- (
2210 match conf
.columns
with
2211 | Cmulti
((c, _, _), _) -> Some
c
2213 | Csplit
_ -> failwith
"leaving bird's eye split mode"
2216 match c.columns
with
2217 | Cmulti
(c, _) -> Cmulti
(c, E.a)
2218 | Csingle
_ -> Csingle
E.a
2219 | Csplit
(c, _) -> Csplit
(c, E.a)
2223 state
.text <- Printf.sprintf
"birds eye mode off (zoom %3.1f%%)"
2226 reshape state
.winw state
.winh
;
2227 state
.anchor <- if goback
then anchor else (pageno, 0.0, 1.0);
2231 let togglebirdseye () =
2232 match state
.mode
with
2233 | Birdseye vals
-> leavebirdseye vals
true
2234 | View
-> enterbirdseye ()
2239 let upbirdseye incr
(conf
, leftx
, pageno, hooverpageno
, anchor) =
2240 let pageno = max
0 (pageno - incr
) in
2241 let rec loop = function
2242 | [] -> gotopage1 pageno 0
2243 | l :: _ when l.pageno = pageno ->
2244 if l.pagedispy >= 0 && l.pagey = 0
2245 then G.postRedisplay "upbirdseye"
2246 else gotopage1 pageno 0
2247 | _ :: rest
-> loop rest
2251 state
.mode
<- Birdseye
(conf
, leftx
, pageno, hooverpageno
, anchor)
2254 let downbirdseye incr
(conf
, leftx
, pageno, hooverpageno
, anchor) =
2255 let pageno = min
(state
.pagecount
- 1) (pageno + incr
) in
2256 state
.mode
<- Birdseye
(conf
, leftx
, pageno, hooverpageno
, anchor);
2257 let rec loop = function
2259 let y, h = getpageyh
pageno in
2260 let dy = (y - state
.y) - (state
.winh
- h - conf
.interpagespace
) in
2262 | l :: _ when l.pageno = pageno ->
2263 if l.pagevh != l.pageh
2264 then gotoy (clamp (l.pageh
- l.pagevh + conf
.interpagespace
))
2265 else G.postRedisplay "downbirdseye"
2266 | _ :: rest
-> loop rest
2272 let optentry mode
_ key =
2273 let btos b = if b then "on" else "off" in
2274 if key >= 32 && key < 127
2276 let c = Char.chr
key in
2280 try conf
.scrollstep
<- int_of_string
s with exc
->
2281 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2283 TEswitch
("scroll step: ", E.s, None
, intentry, ondone, true)
2288 conf
.autoscrollstep
<- boundastep state
.winh
(int_of_string
s);
2289 if state
.autoscroll
<> None
2290 then state
.autoscroll
<- Some conf
.autoscrollstep
2292 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2294 TEswitch
("auto scroll step: ", E.s, None
, intentry, ondone, true)
2299 let n, a, b = multicolumns_of_string
s in
2300 setcolumns mode
n a b;
2302 state
.text <- Printf.sprintf
"bad columns `%s': %s" s (exntos exc
)
2304 TEswitch
("columns: ", E.s, None
, textentry, ondone, true)
2309 let zoom = float (int_of_string
s) /. 100.0 in
2312 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2314 TEswitch
("zoom: ", E.s, None
, intentry, ondone, true)
2319 conf
.thumbw
<- bound
(int_of_string
s) 2 4096;
2321 Printf.sprintf
"thumbnail width is set to %d" conf
.thumbw
;
2322 begin match mode
with
2324 leavebirdseye beye
false;
2331 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2333 TEswitch
("thumbnail width: ", E.s, None
, intentry, ondone, true)
2338 Some
(int_of_string
s)
2340 state
.text <- Printf.sprintf
"bad integer `%s': %s"
2344 | Some angle
-> reqlayout angle conf
.fitmodel
2347 TEswitch
("rotation: ", E.s, None
, intentry, ondone, true)
2350 conf
.icase
<- not conf
.icase
;
2351 TEdone
("case insensitive search " ^
(btos conf
.icase
))
2354 conf
.preload <- not conf
.preload;
2356 TEdone
("preload " ^
(btos conf
.preload))
2359 conf
.verbose
<- not conf
.verbose
;
2360 TEdone
("verbose " ^
(btos conf
.verbose
))
2363 conf
.debug
<- not conf
.debug
;
2364 TEdone
("debug " ^
(btos conf
.debug
))
2367 conf
.maxhfit
<- not conf
.maxhfit
;
2368 state
.maxy
<- calcheight
();
2369 TEdone
("maxhfit " ^
(btos conf
.maxhfit
))
2372 conf
.crophack
<- not conf
.crophack
;
2373 TEdone
("crophack " ^
btos conf
.crophack
)
2377 match conf
.maxwait
with
2379 conf
.maxwait
<- Some infinity
;
2380 "always wait for page to complete"
2382 conf
.maxwait
<- None
;
2383 "show placeholder if page is not ready"
2388 conf
.underinfo
<- not conf
.underinfo
;
2389 TEdone
("underinfo " ^
btos conf
.underinfo
)
2392 conf
.savebmarks
<- not conf
.savebmarks
;
2393 TEdone
("persistent bookmarks " ^
btos conf
.savebmarks
)
2399 match state
.layout with
2404 conf
.interpagespace
<- int_of_string
s;
2405 docolumns conf
.columns
;
2406 state
.maxy
<- calcheight
();
2407 let y = getpagey
pageno in
2410 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2412 TEswitch
("vertical margin: ", E.s, None
, intentry, ondone, true)
2416 match conf
.fitmodel
with
2417 | FitProportional
-> FitWidth
2418 | FitWidth
| FitPage
-> FitProportional
2420 reqlayout conf
.angle
fm;
2421 TEdone
("proportional display " ^
btos (fm == FitProportional
))
2424 settrim (not conf
.trimmargins
) conf
.trimfuzz
;
2425 TEdone
("trim margins " ^
btos conf
.trimmargins
)
2428 conf
.invert
<- not conf
.invert
;
2429 TEdone
("invert colors " ^
btos conf
.invert
)
2433 cbput state
.hists
.sel
s;
2436 TEswitch
("selection command: ", E.s, Some
(onhist state
.hists
.sel
),
2437 textentry, ondone, true)
2441 then conf
.pax
<- Some
(ref (0.0, 0, 0))
2442 else conf
.pax
<- None
;
2443 TEdone
("PAX " ^
btos (conf
.pax
!= None
))
2446 state
.text <- Printf.sprintf
"bad option %d `%c'" key c;
2452 class type lvsource
= object
2453 method getitemcount
: int
2454 method getitem
: int -> (string * int)
2455 method hasaction
: int -> bool
2463 method getactive
: int
2464 method getfirst
: int
2466 method getminfo
: (int * int) array
2469 class virtual lvsourcebase
= object
2470 val mutable m_active
= 0
2471 val mutable m_first
= 0
2472 val mutable m_pan
= 0
2473 method getactive
= m_active
2474 method getfirst
= m_first
2475 method getpan
= m_pan
2476 method getminfo
: (int * int) array
= E.a
2479 let textentrykeyboard
2480 key _mask
((c, text, opthist
, onkey
, ondone, cancelonempty
), onleave
) =
2482 if key >= 0xffb0 && key <= 0xffb9
2483 then key - 0xffb0 + 48 else key
2486 state
.mode
<- Textentry
(te
, onleave
);
2489 G.postRedisplay "textentrykeyboard enttext";
2491 let histaction cmd
=
2494 | Some
(action, _) ->
2495 state
.mode
<- Textentry
(
2496 (c, action cmd
, opthist
, onkey
, ondone, cancelonempty
), onleave
2498 G.postRedisplay "textentry histaction"
2502 if emptystr
text && cancelonempty
2505 G.postRedisplay "textentrykeyboard after cancel";
2508 let s = withoutlastutf8
text in
2509 enttext (c, s, opthist
, onkey
, ondone, cancelonempty
)
2511 | @enter
| @kpenter
->
2514 G.postRedisplay "textentrykeyboard after confirm"
2516 | @up
| @kpup
-> histaction HCprev
2517 | @down
| @kpdown
-> histaction HCnext
2518 | @home
| @kphome
-> histaction HCfirst
2519 | @jend
| @kpend
-> histaction HClast
2524 begin match opthist
with
2526 | Some
(_, onhistcancel
) -> onhistcancel
()
2530 G.postRedisplay "textentrykeyboard after cancel2"
2533 enttext (c, E.s, opthist
, onkey
, ondone, cancelonempty
)
2536 | @delete
| @kpdelete
-> ()
2539 && key land 0xff00 != 0xff00 (* keyboard *)
2540 && key land 0xfe00 != 0xfe00 (* xkb *)
2541 && key land 0xfd00 != 0xfd00 (* 3270 *)
2543 begin match onkey
text key with
2547 G.postRedisplay "textentrykeyboard after confirm2";
2550 enttext (c, text, opthist
, onkey
, ondone, cancelonempty
);
2554 G.postRedisplay "textentrykeyboard after cancel3"
2557 state
.mode
<- Textentry
(te
, onleave
);
2558 G.postRedisplay "textentrykeyboard switch";
2562 vlog "unhandled key %s" (Wsi.keyname
key)
2565 let firstof first active
=
2566 if first
> active
|| abs
(first
- active
) > fstate
.maxrows
- 1
2567 then max
0 (active
- (fstate
.maxrows
/2))
2571 let calcfirst first active
=
2574 let rows = active
- first
in
2575 if rows > fstate
.maxrows
then active
- fstate
.maxrows
else first
2579 let scrollph y maxy
=
2580 let sh = float (maxy
+ state
.winh
) /. float state
.winh
in
2581 let sh = float state
.winh
/. sh in
2582 let sh = max
sh (float conf
.scrollh
) in
2584 let percent = float y /. float maxy
in
2585 let position = (float state
.winh
-. sh) *. percent in
2588 if position +. sh > float state
.winh
2589 then float state
.winh
-. sh
2595 let coe s = (s :> uioh
);;
2597 class listview ~zebra ~helpmode ~
(source
:lvsource
) ~trusted ~modehash
=
2599 val m_pan
= source#getpan
2600 val m_first
= source#getfirst
2601 val m_active
= source#getactive
2603 val m_prev_uioh
= state
.uioh
2605 method private elemunder
y =
2609 let n = y / (fstate
.fontsize
+1) in
2610 if m_first
+ n < source#getitemcount
2612 if source#hasaction
(m_first
+ n)
2613 then Some
(m_first
+ n)
2620 GlFunc.blend_func ~src
:`src_alpha ~dst
:`one_minus_src_alpha
;
2621 GlDraw.color
(0., 0., 0.) ~alpha
:0.85;
2622 filledrect 0. 0. (float state
.winw
) (float state
.winh
);
2623 GlDraw.color
(1., 1., 1.);
2624 Gl.enable `texture_2d
;
2625 let fs = fstate
.fontsize
in
2627 let hw = (wadjsb () + xadjsb () + state
.winw
)/3 in
2628 let ww = fstate
.wwidth
in
2629 let tabw = 17.0*.ww in
2630 let itemcount = source#getitemcount
in
2631 let minfo = source#getminfo
in
2634 then float (xadjsb ()), float (state
.winw
- 1)
2635 else 0.0, float (state
.winw
- conf
.scrollbw
- 1)
2637 let xadj = xadjsb () in
2639 if (row - m_first
) > fstate
.maxrows
2642 if row >= 0 && row < itemcount
2644 let (s, level
) = source#getitem
row in
2645 let y = (row - m_first
) * nfs in
2647 (if conf
.leftscroll
then float xadj else 5.0)
2648 +. (float (level
+ m_pan
)) *. ww in
2651 (let c = if row land 1 = 0 then 1.0 else 0.92 in (c,c,c));
2655 Gl.disable `texture_2d
;
2656 let alpha = if source#hasaction
row then 0.9 else 0.3 in
2657 GlDraw.color
(1., 1., 1.) ~
alpha;
2658 linerect (x0 +. 1.) (float (y + 1)) (x1) (float (y + fs + 3));
2659 Gl.enable `texture_2d
;
2662 if zebra
&& row land 1 = 1
2666 GlDraw.color
(c,c,c);
2667 let drawtabularstring s =
2669 let x'
= truncate
(x0 +. x) in
2670 let pos = nindex
s '
\000'
in
2672 then drawstring1 fs x'
(y+nfs) s
2674 let s1 = String.sub
s 0 pos
2675 and s2
= String.sub
s (pos+1) (String.length
s - pos - 1) in
2680 let s'
= withoutlastutf8
s in
2681 let s = s' ^
"@Uellipsis" in
2682 let w = measurestr
fs s in
2683 if float x'
+. w +. ww < float (hw + x'
)
2688 if float x'
+. ww +. measurestr
fs s1 > float (hw + x'
)
2692 ignore
(drawstring1 fs x'
(y+nfs) s1);
2693 drawstring1 fs (hw + x'
) (y+nfs) s2
2697 let x = if helpmode
&& row > 0 then x +. ww else x in
2698 let tabpos = nindex
s '
\t'
in
2701 let len = String.length
s - tabpos - 1 in
2702 let s1 = String.sub
s 0 tabpos
2703 and s2
= String.sub
s (tabpos + 1) len in
2704 let nx = drawstr x s1 in
2706 let x = x +. (max
tabw sw) in
2709 let len = String.length
s - 2 in
2710 if len > 0 && s.[0] = '
\xc2'
&& s.[1] = '
\xb7'
2712 let s = String.sub
s 2 len in
2713 let x = if not helpmode
then x +. ww else x in
2714 GlDraw.color
(1.2, 1.2, 1.2);
2715 let vinc = drawstring1 (fs+fs/4)
2716 (truncate
(x -. ww)) (y+nfs) s in
2717 GlDraw.color
(1., 1., 1.);
2718 vinc +. (float fs *. 0.8)
2724 ignore
(drawtabularstring s);
2730 GlDraw.color
(1.0, 1.0, 1.0) ~
alpha:0.5;
2731 let xadj = float (xadjsb () + 5) in
2733 if (row - m_first
) > fstate
.maxrows
2736 if row >= 0 && row < itemcount
2738 let (s, level
) = source#getitem
row in
2739 let pos0 = nindex
s '
\000'
in
2740 let y = (row - m_first
) * nfs in
2741 let x = float (level
+ m_pan
) *. ww in
2742 let (first
, last
) = minfo.(row) in
2744 if pos0 > 0 && first
> pos0
2745 then String.sub
s (pos0+1) (first
-pos0-1)
2746 else String.sub
s 0 first
2748 let suffix = String.sub
s first
(last
- first
) in
2749 let w1 = measurestr fstate
.fontsize
prefix in
2750 let w2 = measurestr fstate
.fontsize
suffix in
2751 let x = x +. if conf
.leftscroll
then xadj else 5.0 in
2752 let x = if pos0 > 0 && first
> pos0 then x +. float hw else x in
2754 and y0 = float (y+2) in
2756 and y1 = float (y+fs+3) in
2757 filledrect x0 y0 x1 y1;
2762 Gl.disable `texture_2d
;
2763 if Array.length
minfo > 0 then loop m_first
;
2766 method updownlevel incr
=
2767 let len = source#getitemcount
in
2769 if m_active
>= 0 && m_active
< len
2770 then snd
(source#getitem m_active
)
2774 if i
= len then i
-1 else if i
= -1 then 0 else
2775 let _, l = source#getitem i
in
2776 if l != curlevel then i
else flow (i
+incr
)
2778 let active = flow m_active
in
2779 let first = calcfirst m_first
active in
2780 G.postRedisplay "outline updownlevel";
2781 {< m_active
= active; m_first
= first >}
2783 method private key1
key mask
=
2784 let set1 active first qsearch
=
2785 coe {< m_active
= active; m_first
= first; m_qsearch
= qsearch
>}
2787 let search active pattern incr
=
2788 let active = if active = -1 then m_first
else active in
2791 if n >= 0 && n < source#getitemcount
2793 let s, _ = source#getitem
n in
2795 (try ignore
(Str.search_forward re
s 0); true
2796 with Not_found
-> false)
2798 else loop (n + incr
)
2805 let re = Str.regexp_case_fold pattern
in
2811 let itemcount = source#getitemcount
in
2812 let find start incr
=
2814 if i
= -1 || i
= itemcount
2817 if source#hasaction i
2819 else find (i
+ incr
)
2824 let set active first =
2825 let first = bound
first 0 (itemcount - fstate
.maxrows
) in
2827 coe {< m_active
= active; m_first
= first; m_qsearch
= E.s >}
2830 let isvisible first n = n >= first && n - first <= fstate
.maxrows
in
2832 let incr1 = if incr
> 0 then 1 else -1 in
2833 if isvisible m_first m_active
2836 let next = m_active
+ incr
in
2838 if next < 0 || next >= itemcount
2840 else find next incr1
2842 if abs
(m_active
- next) > fstate
.maxrows
2848 let first = m_first
+ incr
in
2849 let first = bound
first 0 (itemcount - fstate
.maxrows
) in
2851 let next = m_active
+ incr
in
2852 let next = bound
next 0 (itemcount - 1) in
2859 if isvisible first next
2866 let first = min
next m_first
in
2868 if abs
(next - first) > fstate
.maxrows
2874 let first = m_first
+ incr
in
2875 let first = bound
first 0 (itemcount - 1) in
2877 let next = m_active
+ incr
in
2878 let next = bound
next 0 (itemcount - 1) in
2879 let next = find next incr1 in
2881 if next = -1 || abs
(m_active
- first) > fstate
.maxrows
2883 let active = if m_active
= -1 then next else m_active
in
2888 if isvisible first active
2894 G.postRedisplay "listview navigate";
2898 | (@r
|@s) when Wsi.withctrl mask
->
2899 let incr = if key = @r
then -1 else 1 in
2901 match search (m_active
+ incr) m_qsearch
incr with
2903 state
.text <- m_qsearch ^
" [not found]";
2906 state
.text <- m_qsearch
;
2907 active, firstof m_first
active
2909 G.postRedisplay "listview ctrl-r/s";
2910 set1 active first m_qsearch
;
2912 | @insert
when Wsi.withctrl mask
->
2913 if m_active
>= 0 && m_active
< source#getitemcount
2915 let s, _ = source#getitem m_active
in
2921 if emptystr m_qsearch
2924 let qsearch = withoutlastutf8 m_qsearch
in
2928 G.postRedisplay "listview empty qsearch";
2929 set1 m_active m_first
E.s;
2933 match search m_active
qsearch ~
-1 with
2935 state
.text <- qsearch ^
" [not found]";
2938 state
.text <- qsearch;
2939 active, firstof m_first
active
2941 G.postRedisplay "listview backspace qsearch";
2942 set1 active first qsearch
2945 | key when (key != 0 && key land 0xff00 != 0xff00) ->
2946 let pattern = m_qsearch ^ toutf8
key in
2948 match search m_active
pattern 1 with
2950 state
.text <- pattern ^
" [not found]";
2953 state
.text <- pattern;
2954 active, firstof m_first
active
2956 G.postRedisplay "listview qsearch add";
2957 set1 active first pattern;
2961 if emptystr m_qsearch
2963 G.postRedisplay "list view escape";
2966 source#exit ~uioh
:(coe self
)
2967 ~cancel
:true ~
active:m_active ~
first:m_first ~pan
:m_pan
2969 | None
-> m_prev_uioh
2974 G.postRedisplay "list view kill qsearch";
2975 coe {< m_qsearch
= E.s >}
2978 | @enter
| @kpenter
->
2980 let self = {< m_qsearch
= E.s >} in
2982 G.postRedisplay "listview enter";
2983 if m_active
>= 0 && m_active
< source#getitemcount
2985 source#exit ~uioh
:(coe self) ~cancel
:false
2986 ~
active:m_active ~
first:m_first ~pan
:m_pan
;
2989 source#exit ~uioh
:(coe self) ~cancel
:true
2990 ~
active:m_active ~
first:m_first ~pan
:m_pan
;
2993 begin match opt with
2994 | None
-> m_prev_uioh
2998 | @delete
| @kpdelete
->
3001 | @up
| @kpup
-> navigate ~
-1
3002 | @down
| @kpdown
-> navigate 1
3003 | @prior
| @kpprior
-> navigate ~
-(fstate
.maxrows
)
3004 | @next | @kpnext
-> navigate fstate
.maxrows
3006 | @right
| @kpright
->
3008 G.postRedisplay "listview right";
3009 coe {< m_pan
= m_pan
- 1 >}
3011 | @left | @kpleft
->
3013 G.postRedisplay "listview left";
3014 coe {< m_pan
= m_pan
+ 1 >}
3016 | @home
| @kphome
->
3017 let active = find 0 1 in
3018 G.postRedisplay "listview home";
3022 let first = max
0 (itemcount - fstate
.maxrows
) in
3023 let active = find (itemcount - 1) ~
-1 in
3024 G.postRedisplay "listview end";
3027 | key when (key = 0 || key land 0xff00 = 0xff00) ->
3031 dolog
"listview unknown key %#x" key; coe self
3033 method key key mask
=
3034 match state
.mode
with
3035 | Textentry te
-> textentrykeyboard key mask te
; coe self
3038 | LinkNav
_ -> self#key1
key mask
3040 method button button down
x y _ =
3043 | 1 when x > state
.winw
- conf
.scrollbw
->
3044 G.postRedisplay "listview scroll";
3047 let _, position, sh = self#
scrollph in
3048 if y > truncate
position && y < truncate
(position +. sh)
3050 state
.mstate
<- Mscrolly
;
3054 let s = float (max
0 (y - conf
.scrollh
)) /. float state
.winh
in
3055 let first = truncate
(s *. float source#getitemcount
) in
3056 let first = min source#getitemcount
first in
3057 Some
(coe {< m_first
= first; m_active
= first >})
3059 state
.mstate
<- Mnone
;
3063 begin match self#elemunder
y with
3065 G.postRedisplay "listview click";
3066 source#exit ~uioh
:(coe {< m_active
= n >})
3067 ~cancel
:false ~
active:n ~
first:m_first ~pan
:m_pan
3071 | n when (n == 4 || n == 5) && not down
->
3072 let len = source#getitemcount
in
3074 if n = 5 && m_first
+ fstate
.maxrows
>= len
3078 let first = m_first
+ (if n == 4 then -1 else 1) in
3079 bound
first 0 (len - 1)
3081 G.postRedisplay "listview wheel";
3082 Some
(coe {< m_first
= first >})
3083 | n when (n = 6 || n = 7) && not down
->
3084 let inc = if n = 7 then -1 else 1 in
3085 G.postRedisplay "listview hwheel";
3086 Some
(coe {< m_pan
= m_pan
+ inc >})
3091 | None
-> m_prev_uioh
3094 method multiclick
_ x y = self#button
1 true x y
3097 match state
.mstate
with
3099 let s = float (max
0 (y - conf
.scrollh
)) /. float state
.winh
in
3100 let first = truncate
(s *. float source#getitemcount
) in
3101 let first = min source#getitemcount
first in
3102 G.postRedisplay "listview motion";
3103 coe {< m_first
= first; m_active
= first >}
3111 method pmotion
x y =
3112 if x < state
.winw
- conf
.scrollbw
3115 match self#elemunder
y with
3116 | None
-> Wsi.setcursor
Wsi.CURSOR_INHERIT
; m_active
3117 | Some
n -> Wsi.setcursor
Wsi.CURSOR_INFO
; n
3121 then (G.postRedisplay "listview pmotion"; {< m_active
= n >})
3126 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
3130 method infochanged
_ = ()
3132 method scrollpw
= (0, 0.0, 0.0)
3134 let nfs = fstate
.fontsize
+ 1 in
3135 let y = m_first
* nfs in
3136 let itemcount = source#getitemcount
in
3137 let maxi = max
0 (itemcount - fstate
.maxrows
) in
3138 let maxy = maxi * nfs in
3139 let p, h = scrollph y maxy in
3142 method modehash
= modehash
3143 method eformsgs
= false
3144 method alwaysscrolly
= true
3147 class outlinelistview ~zebra ~source
=
3148 let settext autonarrow
s =
3151 let ss = source#statestr
in
3155 else "{" ^
ss ^
"} [" ^
s ^
"]"
3156 else state
.text <- s
3162 ~source
:(source
:> lvsource
)
3164 ~modehash
:(findkeyhash conf
"outline")
3167 val m_autonarrow
= false
3169 method! key key mask
=
3171 if emptystr state
.text
3173 else fstate
.maxrows - 2
3175 let calcfirst first active =
3178 let rows = active - first in
3179 if rows > maxrows then active - maxrows else first
3183 let active = m_active
+ incr in
3184 let active = bound
active 0 (source#getitemcount
- 1) in
3185 let first = calcfirst m_first
active in
3186 G.postRedisplay "outline navigate";
3187 coe {< m_active
= active; m_first
= first >}
3189 let navscroll first =
3191 let dist = m_active
- first in
3197 else first + maxrows
3200 G.postRedisplay "outline navscroll";
3201 coe {< m_first
= first; m_active
= active >}
3203 let ctrl = Wsi.withctrl mask
in
3208 then (source#denarrow
; E.s)
3210 let pattern = source#renarrow
in
3211 if nonemptystr m_qsearch
3212 then (source#narrow m_qsearch
; m_qsearch
)
3216 settext (not m_autonarrow
) text;
3217 G.postRedisplay "toggle auto narrowing";
3218 coe {< m_first
= 0; m_active
= 0; m_autonarrow
= not m_autonarrow
>}
3220 | @slash
when emptystr m_qsearch
&& not m_autonarrow
->
3222 G.postRedisplay "toggle auto narrowing";
3223 coe {< m_first
= 0; m_active
= 0; m_autonarrow
= true >}
3226 source#narrow m_qsearch
;
3228 then source#add_narrow_pattern m_qsearch
;
3229 G.postRedisplay "outline ctrl-n";
3230 coe {< m_first
= 0; m_active
= 0 >}
3233 let active = source#calcactive
(getanchor
()) in
3234 let first = firstof m_first
active in
3235 G.postRedisplay "outline ctrl-s";
3236 coe {< m_first
= first; m_active
= active >}
3239 G.postRedisplay "outline ctrl-u";
3240 if m_autonarrow
&& nonemptystr m_qsearch
3242 ignore
(source#renarrow
);
3243 settext m_autonarrow
E.s;
3244 coe {< m_first
= 0; m_active
= 0; m_qsearch
= E.s >}
3247 source#del_narrow_pattern
;
3248 let pattern = source#renarrow
in
3250 if emptystr
pattern then E.s else "Narrowed to " ^
pattern
3252 settext m_autonarrow
text;
3253 coe {< m_first
= 0; m_active
= 0; m_qsearch
= E.s >}
3257 let first = max
0 (m_active
- (fstate
.maxrows / 2)) in
3258 G.postRedisplay "outline ctrl-l";
3259 coe {< m_first
= first >}
3261 | @tab
when m_autonarrow
->
3262 if nonemptystr m_qsearch
3264 G.postRedisplay "outline list view tab";
3265 source#add_narrow_pattern m_qsearch
;
3267 coe {< m_qsearch
= E.s >}
3271 | @escape
when m_autonarrow
->
3272 if nonemptystr m_qsearch
3273 then source#add_narrow_pattern m_qsearch
;
3276 | @enter
| @kpenter
when m_autonarrow
->
3277 if nonemptystr m_qsearch
3278 then source#add_narrow_pattern m_qsearch
;
3281 | key when m_autonarrow
&& (key != 0 && key land 0xff00 != 0xff00) ->
3282 let pattern = m_qsearch ^ toutf8
key in
3283 G.postRedisplay "outlinelistview autonarrow add";
3284 source#narrow
pattern;
3285 settext true pattern;
3286 coe {< m_first
= 0; m_active
= 0; m_qsearch
= pattern >}
3288 | key when m_autonarrow
&& key = @backspace
->
3289 if emptystr m_qsearch
3292 let pattern = withoutlastutf8 m_qsearch
in
3293 G.postRedisplay "outlinelistview autonarrow backspace";
3294 ignore
(source#renarrow
);
3295 source#narrow
pattern;
3296 settext true pattern;
3297 coe {< m_first
= 0; m_active
= 0; m_qsearch
= pattern >}
3299 | @delete
| @kpdelete
->
3300 source#remove m_active
;
3301 G.postRedisplay "outline delete";
3302 let active = max
0 (m_active
-1) in
3303 coe {< m_first
= firstof m_first
active;
3304 m_active
= active >}
3306 | @up
| @kpup
when ctrl ->
3307 navscroll (max
0 (m_first
- 1))
3309 | @down
| @kpdown
when ctrl ->
3310 navscroll (min
(source#getitemcount
- 1) (m_first
+ 1))
3312 | @up
| @kpup
-> navigate ~
-1
3313 | @down
| @kpdown
-> navigate 1
3314 | @prior
| @kpprior
-> navigate ~
-(fstate
.maxrows)
3315 | @next | @kpnext
-> navigate fstate
.maxrows
3317 | @right
| @kpright
->
3321 G.postRedisplay "outline ctrl right";
3322 {< m_pan
= m_pan
+ 1 >}
3324 else self#updownlevel
1
3328 | @left | @kpleft
->
3332 G.postRedisplay "outline ctrl left";
3333 {< m_pan
= m_pan
- 1 >}
3335 else self#updownlevel ~
-1
3339 | @home
| @kphome
->
3340 G.postRedisplay "outline home";
3341 coe {< m_first
= 0; m_active
= 0 >}
3344 let active = source#getitemcount
- 1 in
3345 let first = max
0 (active - fstate
.maxrows) in
3346 G.postRedisplay "outline end";
3347 coe {< m_active
= active; m_first
= first >}
3349 | _ -> super#
key key mask
3352 let genhistoutlines =
3353 let order ty
(p1
, c1
, _, _, _) (p2
, c2
, _, _, _) =
3355 | `lastvisit
-> compare c1
.lastvisit c2
.lastvisit
3356 | `path
-> compare p2 p1
3357 | `file
-> compare
(Filename.basename p2
) (Filename.basename p1
)
3359 let e1 = emptystr c1
.title
3360 and e2
= emptystr c2
.title
in
3362 then compare
(Filename.basename p2
) (Filename.basename p1
)
3365 else compare c1
.title c2
.title
3367 let showfullpath = ref false in
3370 let s = if orderty
= t
then "[@Uradical] " ^
s else "[ ] " ^
s in
3371 s, 0, Oaction
(fun () -> Config.historder
:= t
; reeenterhist := true)
3373 let list = ref [] in
3374 if Config.gethist
list
3378 (fun accu (path
, c, b, x, a) ->
3379 let hist = (path
, (c, b, x, a)) in
3380 let s = if !showfullpath then path
else Filename.basename path
in
3381 let base = mbtoutf8
s in
3382 (base ^
"\000" ^
c.title
, 1, Ohistory
hist) :: accu
3384 [ setorty "Sort by time of last visit" `lastvisit
;
3385 setorty "Sort by file name" `file
;
3386 setorty "Sort by path" `path
;
3387 setorty "Sort by title" `title
;
3388 (if !showfullpath then "@Uradical "
3389 else " ") ^
"Show full path", 0, Oaction
(fun () ->
3390 showfullpath := not
!showfullpath; reeenterhist := true)
3391 ] (List.sort
(order orderty
) !list)
3397 let gotohist (path
, (c, bookmarks
, x, anchor)) =
3398 Config.save
leavebirdseye;
3399 state
.anchor <- anchor;
3401 state
.bookmarks
<- bookmarks
;
3402 state
.origin
<- E.s;
3404 let x0, y0, x1, y1 = conf
.trimfuzz
in
3405 wcmd "trimset %d %d %d %d %d" (btod conf
.trimmargins
) x0 y0 x1 y1;
3409 let makecheckers () =
3410 (* Based on lablGL-1.04/LablGlut/examples/lablGL/checker.ml which had
3412 converted by Issac Trotts. July 25, 2002 *)
3413 let image = GlPix.create `ubyte ~format
:`luminance ~width
:2 ~height
:2 in
3414 Raw.sets_string
(GlPix.to_raw
image) ~
pos:0 "\255\200\200\255";
3415 let id = GlTex.gen_texture
() in
3416 GlTex.bind_texture ~target
:`texture_2d
id;
3417 GlPix.store
(`unpack_alignment
1);
3418 GlTex.image2d
image;
3419 List.iter
(GlTex.parameter ~target
:`texture_2d
)
3420 [ `mag_filter `nearest
; `min_filter `nearest
];
3424 let setcheckers enabled
=
3425 match state
.checkerstexid
with
3427 if enabled
then state
.checkerstexid
<- Some
(makecheckers ())
3429 | Some checkerstexid
->
3432 GlTex.delete_texture checkerstexid
;
3433 state
.checkerstexid
<- None
;
3437 let describe_location () =
3438 let fn = page_of_y state
.y in
3439 let ln = page_of_y
(state
.y + state
.winh
- hscrollh () - 1) in
3440 let maxy = state
.maxy - (if conf
.maxhfit
then state
.winh
else 0) in
3444 else (100. *. (float state
.y /. float maxy))
3448 Printf.sprintf
"page %d of %d [%.2f%%]"
3449 (fn+1) state
.pagecount
percent
3452 "pages %d-%d of %d [%.2f%%]"
3453 (fn+1) (ln+1) state
.pagecount
percent
3456 let setpresentationmode v
=
3457 let n = page_of_y state
.y in
3458 state
.anchor <- (n, 0.0, 1.0);
3459 conf
.presentation
<- v
;
3460 if conf
.fitmodel
= FitPage
3461 then reqlayout conf
.angle conf
.fitmodel
;
3466 let btos b = if b then "@Uradical" else E.s in
3467 let showextended = ref false in
3468 let leave mode
_ = state
.mode
<- mode
in
3471 val mutable m_first_time
= true
3472 val mutable m_l
= []
3473 val mutable m_a
= E.a
3474 val mutable m_prev_uioh
= nouioh
3475 val mutable m_prev_mode
= View
3477 inherit lvsourcebase
3479 method reset prev_mode prev_uioh
=
3480 m_a
<- Array.of_list
(List.rev m_l
);
3482 m_prev_mode
<- prev_mode
;
3483 m_prev_uioh
<- prev_uioh
;
3487 if n >= Array.length m_a
3491 | _, _, _, Action
_ -> m_active
<- n
3492 | _, _, _, Noaction
-> loop (n+1)
3495 m_first_time
<- false;
3498 method int name get
set =
3500 (name
, `
int get
, 1, Action
(
3503 try set (int_of_string
s)
3505 state
.text <- Printf.sprintf
"bad integer `%s': %s"
3509 let te = name ^
": ", E.s, None
, intentry, ondone, true in
3510 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3514 method int_with_suffix name get
set =
3516 (name
, `intws get
, 1, Action
(
3519 try set (int_of_string_with_suffix
s)
3521 state
.text <- Printf.sprintf
"bad integer `%s': %s"
3526 name ^
": ", E.s, None
, intentry_with_suffix, ondone, true
3528 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3532 method bool ?
(offset
=1) ?
(btos=btos) name get
set =
3534 (name
, `
bool (btos, get
), offset
, Action
(
3541 method color name get
set =
3543 (name
, `color get
, 1, Action
(
3545 let invalid = (nan
, nan
, nan
) in
3548 try color_of_string
s
3550 state
.text <- Printf.sprintf
"bad color `%s': %s"
3557 let te = name ^
": ", E.s, None
, textentry, ondone, true in
3558 state
.text <- color_to_string
(get
());
3559 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3563 method string name get
set =
3565 (name
, `
string get
, 1, Action
(
3567 let ondone s = set s in
3568 let te = name ^
": ", E.s, None
, textentry, ondone, true in
3569 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3573 method colorspace name get
set =
3575 (name
, `
string get
, 1, Action
(
3579 inherit lvsourcebase
3582 m_active
<- CSTE.to_int conf
.colorspace
;
3585 method getitemcount
=
3586 Array.length
CSTE.names
3589 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3590 ignore
(uioh
, first, pan
);
3591 if not cancel
then set active;
3593 method hasaction
_ = true
3597 let modehash = findkeyhash conf
"info" in
3598 coe (new listview ~zebra
:false ~helpmode
:false
3599 ~
source ~trusted
:true ~
modehash)
3602 method paxmark name get
set =
3604 (name
, `
string get
, 1, Action
(
3608 inherit lvsourcebase
3611 m_active
<- MTE.to_int conf
.paxmark
;
3614 method getitemcount
= Array.length
MTE.names
3615 method getitem
n = (MTE.names
.(n), 0)
3616 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3617 ignore
(uioh
, first, pan
);
3618 if not cancel
then set active;
3620 method hasaction
_ = true
3624 let modehash = findkeyhash conf
"info" in
3625 coe (new listview ~zebra
:false ~helpmode
:false
3626 ~
source ~trusted
:true ~
modehash)
3629 method fitmodel name get
set =
3631 (name
, `
string get
, 1, Action
(
3635 inherit lvsourcebase
3638 m_active
<- FMTE.to_int conf
.fitmodel
;
3641 method getitemcount
= Array.length
FMTE.names
3642 method getitem
n = (FMTE.names
.(n), 0)
3643 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3644 ignore
(uioh
, first, pan
);
3645 if not cancel
then set active;
3647 method hasaction
_ = true
3651 let modehash = findkeyhash conf
"info" in
3652 coe (new listview ~zebra
:false ~helpmode
:false
3653 ~
source ~trusted
:true ~
modehash)
3656 method caption
s offset
=
3657 m_l
<- (s, `empty
, offset
, Noaction
) :: m_l
3659 method caption2
s f offset
=
3660 m_l
<- (s, `
string f, offset
, Noaction
) :: m_l
3662 method getitemcount
= Array.length m_a
3665 let tostr = function
3666 | `
int f -> string_of_int
(f ())
3667 | `intws
f -> string_with_suffix_of_int
(f ())
3669 | `color
f -> color_to_string
(f ())
3670 | `
bool (btos, f) -> btos (f ())
3673 let name, t
, offset
, _ = m_a
.(n) in
3674 ((let s = tostr t
in
3676 then Printf.sprintf
"%s\t%s" name s
3680 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3685 match m_a
.(active) with
3686 | _, _, _, Action
f -> f uioh
3687 | _, _, _, Noaction
-> uioh
3698 method hasaction
n =
3700 | _, _, _, Action
_ -> true
3701 | _, _, _, Noaction
-> false
3704 let rec fillsrc prevmode prevuioh
=
3705 let sep () = src#caption
E.s 0 in
3706 let colorp name get
set =
3708 (fun () -> color_to_string
(get
()))
3711 let c = color_of_string
v in
3714 state
.text <- Printf.sprintf
"bad color `%s': %s" v (exntos exn
)
3717 let oldmode = state
.mode
in
3718 let birdseye = isbirdseye state
.mode
in
3720 src#caption
(if birdseye then "Setup (Bird's eye)" else "Setup") 0;
3722 src#
bool "presentation mode"
3723 (fun () -> conf
.presentation
)
3724 (fun v -> setpresentationmode v);
3726 src#
bool "ignore case in searches"
3727 (fun () -> conf
.icase
)
3728 (fun v -> conf
.icase
<- v);
3731 (fun () -> conf
.preload)
3732 (fun v -> conf
.preload <- v);
3734 src#
bool "highlight links"
3735 (fun () -> conf
.hlinks
)
3736 (fun v -> conf
.hlinks
<- v);
3738 src#
bool "under info"
3739 (fun () -> conf
.underinfo
)
3740 (fun v -> conf
.underinfo
<- v);
3742 src#
bool "persistent bookmarks"
3743 (fun () -> conf
.savebmarks
)
3744 (fun v -> conf
.savebmarks
<- v);
3746 src#fitmodel
"fit model"
3747 (fun () -> FMTE.to_string conf
.fitmodel
)
3748 (fun v -> reqlayout conf
.angle
(FMTE.of_int
v));
3750 src#
bool "trim margins"
3751 (fun () -> conf
.trimmargins
)
3752 (fun v -> settrim v conf
.trimfuzz
; fillsrc prevmode prevuioh
);
3754 src#
bool "persistent location"
3755 (fun () -> conf
.jumpback
)
3756 (fun v -> conf
.jumpback
<- v);
3759 src#
int "inter-page space"
3760 (fun () -> conf
.interpagespace
)
3762 conf
.interpagespace
<- n;
3763 docolumns conf
.columns
;
3765 match state
.layout with
3770 state
.maxy <- calcheight
();
3771 let y = getpagey
pageno in
3776 (fun () -> conf
.pagebias
)
3777 (fun v -> conf
.pagebias
<- v);
3779 src#
int "scroll step"
3780 (fun () -> conf
.scrollstep
)
3781 (fun n -> conf
.scrollstep
<- n);
3783 src#
int "horizontal scroll step"
3784 (fun () -> conf
.hscrollstep
)
3785 (fun v -> conf
.hscrollstep
<- v);
3787 src#
int "auto scroll step"
3789 match state
.autoscroll
with
3791 | _ -> conf
.autoscrollstep
)
3793 let n = boundastep state
.winh
n in
3794 if state
.autoscroll
<> None
3795 then state
.autoscroll
<- Some
n;
3796 conf
.autoscrollstep
<- n);
3799 (fun () -> truncate
(conf
.zoom *. 100.))
3800 (fun v -> setzoom ((float v) /. 100.));
3803 (fun () -> conf
.angle
)
3804 (fun v -> reqlayout v conf
.fitmodel
);
3806 src#
int "scroll bar width"
3807 (fun () -> conf
.scrollbw
)
3810 reshape state
.winw state
.winh
;
3813 src#
int "scroll handle height"
3814 (fun () -> conf
.scrollh
)
3815 (fun v -> conf
.scrollh
<- v;);
3817 src#
int "thumbnail width"
3818 (fun () -> conf
.thumbw
)
3820 conf
.thumbw
<- min
4096 v;
3823 leavebirdseye beye
false;
3830 let mode = state
.mode in
3831 src#
string "columns"
3833 match conf
.columns
with
3835 | Cmulti
(multi
, _) -> multicolumns_to_string multi
3836 | Csplit
(count
, _) -> "-" ^ string_of_int count
3839 let n, a, b = multicolumns_of_string
v in
3840 setcolumns mode n a b);
3843 src#caption
"Pixmap cache" 0;
3844 src#int_with_suffix
"size (advisory)"
3845 (fun () -> conf
.memlimit
)
3846 (fun v -> conf
.memlimit
<- v);
3849 (fun () -> Printf.sprintf
"%s bytes, %d tiles"
3850 (string_with_suffix_of_int state
.memused
)
3851 (Hashtbl.length state
.tilemap
)) 1;
3854 src#caption
"Layout" 0;
3855 src#caption2
"Dimension"
3857 Printf.sprintf
"%dx%d (virtual %dx%d)"
3858 state
.winw state
.winh
3863 src#caption2
"Position" (fun () ->
3864 Printf.sprintf
"%dx%d" state
.x state
.y
3867 src#caption2
"Position" (fun () -> describe_location ()) 1
3871 src#
bool ~offset
:0 ~
btos:(fun v -> if v then "(on)" else "(off)")
3872 "Save these parameters as global defaults at exit"
3873 (fun () -> conf
.bedefault
)
3874 (fun v -> conf
.bedefault
<- v)
3878 let btos b = if b then "@Ulguillemet" else "@Urguillemet" in
3879 src#
bool ~offset
:0 ~
btos "Extended parameters"
3880 (fun () -> !showextended)
3881 (fun v -> showextended := v; fillsrc prevmode prevuioh
);
3885 (fun () -> conf
.checkers
)
3886 (fun v -> conf
.checkers
<- v; setcheckers v);
3887 src#
bool "update cursor"
3888 (fun () -> conf
.updatecurs
)
3889 (fun v -> conf
.updatecurs
<- v);
3890 src#
bool "scroll-bar on the left"
3891 (fun () -> conf
.leftscroll
)
3892 (fun v -> conf
.leftscroll
<- v);
3894 (fun () -> conf
.verbose
)
3895 (fun v -> conf
.verbose
<- v);
3896 src#
bool "invert colors"
3897 (fun () -> conf
.invert
)
3898 (fun v -> conf
.invert
<- v);
3900 (fun () -> conf
.maxhfit
)
3901 (fun v -> conf
.maxhfit
<- v);
3902 src#
bool "redirect stderr"
3903 (fun () -> conf
.redirectstderr)
3904 (fun v -> conf
.redirectstderr <- v; redirectstderr ());
3906 (fun () -> conf
.pax
!= None
)
3909 then conf
.pax
<- Some
(ref (now
(), 0, 0))
3910 else conf
.pax
<- None
);
3911 src#
string "uri launcher"
3912 (fun () -> conf
.urilauncher
)
3913 (fun v -> conf
.urilauncher
<- v);
3914 src#
string "path launcher"
3915 (fun () -> conf
.pathlauncher
)
3916 (fun v -> conf
.pathlauncher
<- v);
3917 src#
string "tile size"
3918 (fun () -> Printf.sprintf
"%dx%d" conf
.tilew conf
.tileh
)
3921 let w, h = Scanf.sscanf
v "%dx%d" (fun w h -> w, h) in
3922 conf
.tilew
<- max
64 w;
3923 conf
.tileh
<- max
64 h;
3926 state
.text <- Printf.sprintf
"bad tile size `%s': %s"
3929 src#
int "texture count"
3930 (fun () -> conf
.texcount
)
3933 then conf
.texcount
<- v
3934 else showtext '
!'
" Failed to set texture count please retry later"
3936 src#
int "slice height"
3937 (fun () -> conf
.sliceheight
)
3939 conf
.sliceheight
<- v;
3940 wcmd "sliceh %d" conf
.sliceheight
;
3942 src#
int "anti-aliasing level"
3943 (fun () -> conf
.aalevel
)
3945 conf
.aalevel
<- bound
v 0 8;
3946 state
.anchor <- getanchor
();
3947 opendoc state
.path state
.password;
3949 src#
string "page scroll scaling factor"
3950 (fun () -> string_of_float conf
.pgscale)
3953 let s = float_of_string
v in
3956 state
.text <- Printf.sprintf
3957 "bad page scroll scaling factor `%s': %s" v (exntos exn
)
3960 src#
int "ui font size"
3961 (fun () -> fstate
.fontsize
)
3962 (fun v -> setfontsize (bound
v 5 100));
3963 src#
int "hint font size"
3964 (fun () -> conf
.hfsize
)
3965 (fun v -> conf
.hfsize
<- bound
v 5 100);
3966 colorp "background color"
3967 (fun () -> conf
.bgcolor
)
3968 (fun v -> conf
.bgcolor
<- v);
3969 src#
bool "crop hack"
3970 (fun () -> conf
.crophack
)
3971 (fun v -> conf
.crophack
<- v);
3972 src#
string "trim fuzz"
3973 (fun () -> irect_to_string conf
.trimfuzz
)
3976 conf
.trimfuzz
<- irect_of_string
v;
3978 then settrim true conf
.trimfuzz
;
3980 state
.text <- Printf.sprintf
"bad irect `%s': %s" v (exntos exn
)
3982 src#
string "throttle"
3984 match conf
.maxwait
with
3985 | None
-> "show place holder if page is not ready"
3988 then "wait for page to fully render"
3990 "wait " ^ string_of_float
time
3991 ^
" seconds before showing placeholder"
3995 let f = float_of_string
v in
3997 then conf
.maxwait
<- None
3998 else conf
.maxwait
<- Some
f
4000 state
.text <- Printf.sprintf
"bad time `%s': %s" v (exntos exn
)
4002 src#
string "ghyll scroll"
4004 match conf
.ghyllscroll
with
4006 | Some nab
-> ghyllscroll_to_string nab
4009 try conf
.ghyllscroll
<- ghyllscroll_of_string
v
4011 state
.text <- Printf.sprintf
"bad ghyll `%s': %s" v (exntos exn
)
4013 src#
string "selection command"
4014 (fun () -> conf
.selcmd
)
4015 (fun v -> conf
.selcmd
<- v);
4016 src#
string "synctex command"
4017 (fun () -> conf
.stcmd
)
4018 (fun v -> conf
.stcmd
<- v);
4019 src#
string "pax command"
4020 (fun () -> conf
.paxcmd
)
4021 (fun v -> conf
.paxcmd
<- v);
4022 src#
string "ask password command"
4023 (fun () -> conf
.passcmd)
4024 (fun v -> conf
.passcmd <- v);
4025 src#
string "save path command"
4026 (fun () -> conf
.savecmd
)
4027 (fun v -> conf
.savecmd
<- v);
4028 src#colorspace
"color space"
4029 (fun () -> CSTE.to_string conf
.colorspace
)
4031 conf
.colorspace
<- CSTE.of_int
v;
4035 src#paxmark
"pax mark method"
4036 (fun () -> MTE.to_string conf
.paxmark
)
4037 (fun v -> conf
.paxmark
<- MTE.of_int
v);
4041 (fun () -> conf
.usepbo
)
4042 (fun v -> conf
.usepbo
<- v);
4043 src#
bool "mouse wheel scrolls pages"
4044 (fun () -> conf
.wheelbypage
)
4045 (fun v -> conf
.wheelbypage
<- v);
4046 src#
bool "open remote links in a new instance"
4047 (fun () -> conf
.riani
)
4048 (fun v -> conf
.riani
<- v);
4049 src#
bool "edit annotations inline"
4050 (fun () -> conf
.annotinline
)
4051 (fun v -> conf
.annotinline
<- v);
4055 src#caption
"Document" 0;
4056 List.iter
(fun (_, s) -> src#caption
s 1) state
.docinfo
;
4057 src#caption2
"Pages"
4058 (fun () -> string_of_int state
.pagecount
) 1;
4059 src#caption2
"Dimensions"
4060 (fun () -> string_of_int
(List.length state
.pdims
)) 1;
4064 src#caption
"Trimmed margins" 0;
4065 src#caption2
"Dimensions"
4066 (fun () -> string_of_int
(List.length state
.pdims
)) 1;
4070 src#caption
"OpenGL" 0;
4071 src#caption
(Printf.sprintf
"Vendor\t%s" (GlMisc.get_string `vendor
)) 1;
4072 src#caption
(Printf.sprintf
"Renderer\t%s" (GlMisc.get_string `renderer
)) 1;
4075 src#caption
"Location" 0;
4076 if nonemptystr state
.origin
4077 then src#caption
("Orign\t" ^ mbtoutf8 state
.origin
) 1;
4078 src#caption
("Path\t" ^ mbtoutf8 state
.path
) 1;
4080 src#reset prevmode prevuioh
;
4085 let prevmode = state
.mode
4086 and prevuioh
= state
.uioh in
4087 fillsrc prevmode prevuioh
;
4088 let source = (src :> lvsource
) in
4089 let modehash = findkeyhash conf
"info" in
4090 state
.uioh <- coe (object (self)
4091 inherit listview ~zebra
:false ~helpmode
:false
4092 ~
source ~trusted
:true ~
modehash as super
4093 val mutable m_prevmemused
= 0
4094 method! infochanged
= function
4096 if m_prevmemused
!= state
.memused
4098 m_prevmemused
<- state
.memused
;
4099 G.postRedisplay "memusedchanged";
4101 | Pdim
-> G.postRedisplay "pdimchanged"
4102 | Docinfo
-> fillsrc prevmode prevuioh
4104 method! key key mask
=
4105 if not
(Wsi.withctrl mask
)
4108 | @left | @kpleft
-> coe (self#updownlevel ~
-1)
4109 | @right
| @kpright
-> coe (self#updownlevel
1)
4110 | _ -> super#
key key mask
4111 else super#
key key mask
4113 G.postRedisplay "info";
4119 inherit lvsourcebase
4120 method getitemcount
= Array.length state
.help
4122 let s, l, _ = state
.help
.(n) in
4125 method exit ~
uioh ~cancel ~
active ~
first ~pan
=
4129 match state
.help
.(active) with
4130 | _, _, Action
f -> Some
(f uioh)
4131 | _, _, Noaction
-> Some
uioh
4140 method hasaction
n =
4141 match state
.help
.(n) with
4142 | _, _, Action
_ -> true
4143 | _, _, Noaction
-> false
4149 let modehash = findkeyhash conf
"help" in
4151 state
.uioh <- coe (new listview
4152 ~zebra
:false ~helpmode
:true
4153 ~
source ~trusted
:true ~
modehash);
4154 G.postRedisplay "help";
4160 inherit lvsourcebase
4161 val mutable m_items
= E.a
4163 method getitemcount
= 1 + Array.length m_items
4168 else m_items
.(n-1), 0
4170 method exit ~
uioh ~cancel ~
active ~
first ~pan
=
4175 then Buffer.clear state
.errmsgs
;
4182 method hasaction
n =
4186 state
.newerrmsgs
<- false;
4187 let l = Str.split newlinere
(Buffer.contents state
.errmsgs
) in
4188 m_items
<- Array.of_list
l
4197 let source = (msgsource :> lvsource
) in
4198 let modehash = findkeyhash conf
"listview" in
4199 state
.uioh <- coe (object
4200 inherit listview ~zebra
:false ~helpmode
:false
4201 ~
source ~trusted
:false ~
modehash as super
4204 then msgsource#reset
;
4207 G.postRedisplay "msgs";
4211 let editor = getenvwithdef
"EDITOR" E.s in
4215 let tmppath = Filename.temp_file
"llpp" "note" in
4218 let oc = open_out
tmppath in
4222 let execstr = editor ^
" " ^
tmppath in
4224 match popen
execstr [] with
4225 | (exception exn
) ->
4227 Printf.sprintf
"popen(%S) failed: %s" execstr (exntos exn
);
4230 match Unix.waitpid
[] pid
4232 | (exception exn
) ->
4234 Printf.sprintf
"waitpid(%d) failed: %s" pid (exntos exn
);
4238 | Unix.WEXITED
0 -> filelines
tmppath
4241 Printf.sprintf
"editor process(%s) exited abnormally: %d"
4244 | Unix.WSIGNALED
n ->
4246 Printf.sprintf
"editor process(%s) was killed by signal %d"
4249 | Unix.WSTOPPED
n ->
4251 Printf.sprintf
"editor(%s) process was stopped by signal %d"
4255 match Unix.unlink
tmppath with
4256 | (exception exn
) ->
4257 showtext '
!'
@@ Printf.sprintf
"failed to ulink %S: %s"
4258 tmppath (exntos exn
);
4263 let enterannotmode opaque slinkindex
=
4266 inherit lvsourcebase
4267 val mutable m_text
= E.s
4268 val mutable m_items
= E.a
4270 method getitemcount
= Array.length m_items
4273 let label, _func
= m_items
.(n) in
4276 method exit ~
uioh ~cancel ~
active ~
first ~pan
=
4277 ignore
(uioh, first, pan
);
4280 let _label, func
= m_items
.(active) in
4285 method hasaction
n = not
@@ emptystr
@@ fst m_items
.(n)
4288 let rec split accu b i
=
4290 if p = String.length
s
4291 then (String.sub
s b (p-b), unit) :: accu
4293 if (i
> 70 && s.[p] = ' '
) || s.[p] = '
\r'
|| s.[p] = '
\n'
4295 let ss = if i
= 0 then E.s else String.sub
s b i
in
4296 split ((ss, unit)::accu) (p+1) 0
4301 wcmd "freepage %s" (~
> opaque);
4303 Hashtbl.fold (fun key opaque'
accu ->
4304 if opaque'
= opaque'
4305 then key :: accu else accu) state
.pagemap
[]
4307 List.iter
(Hashtbl.remove state
.pagemap
) keys;
4312 delannot
opaque slinkindex
;
4315 let edit inline
() =
4320 modannot
opaque slinkindex
s;
4326 let mode = state
.mode in
4329 ("annotation: ", m_text
, None
, textentry, update, true),
4330 fun _ -> state
.mode <- mode);
4334 let s = getusertext m_text
in
4339 ( "[Copy]", fun () -> selstring m_text
)
4340 :: ("[Delete]", dele)
4341 :: ("[Edit]", edit conf
.annotinline
)
4343 :: split [] 0 0 |> List.rev
|> Array.of_list
4350 let s = getannotcontents
opaque slinkindex
in
4353 let source = (msgsource :> lvsource
) in
4354 let modehash = findkeyhash conf
"listview" in
4355 state
.uioh <- coe (object
4356 inherit listview ~zebra
:false ~helpmode
:false
4357 ~
source ~trusted
:false ~
modehash
4359 G.postRedisplay "enterannotmode";
4362 let gotounder under =
4363 let getpath filename
=
4365 if nonemptystr filename
4367 if Filename.is_relative filename
4369 let dir = Filename.dirname state
.path in
4371 if Filename.is_implicit
dir
4372 then Filename.concat
(Sys.getcwd
()) dir
4375 Filename.concat
dir filename
4379 if Sys.file_exists
path
4384 | Ulinkgoto
(pageno, top) ->
4388 gotopage1 pageno top;
4394 | Uremote
(filename
, pageno) ->
4395 let path = getpath filename
in
4400 let command = Printf.sprintf
"%s -page %d %S" !selfexec pageno path in
4401 try addpid
@@ popen
command []
4403 Printf.eprintf
"failed to execute `%s': %s\n" command (exntos exn
);
4406 let anchor = getanchor
() in
4407 let ranchor = state
.path, state
.password, anchor, state
.origin
in
4408 state
.origin
<- E.s;
4409 state
.anchor <- (pageno, 0.0, 0.0);
4410 state
.ranchors
<- ranchor :: state
.ranchors
;
4413 else showtext '
!'
("Could not find " ^ filename
)
4415 | Uremotedest
(filename
, destname
) ->
4416 let path = getpath filename
in
4421 let command = !selfexec ^
" " ^
path ^
" -dest " ^ destname
in
4422 try addpid
@@ popen
command []
4425 "failed to execute `%s': %s\n" command (exntos exn
);
4428 let anchor = getanchor
() in
4429 let ranchor = state
.path, state
.password, anchor, state
.origin
in
4430 state
.origin
<- E.s;
4431 state
.nameddest
<- destname
;
4432 state
.ranchors
<- ranchor :: state
.ranchors
;
4435 else showtext '
!'
("Could not find " ^ filename
)
4437 | Uunexpected
_ | Ulaunch
_ | Unamed
_ | Utext
_ | Unone
-> ()
4438 | Uannotation
(opaque, slinkindex
) -> enterannotmode opaque slinkindex
4441 let gotooutline (_, _, kind
) =
4445 let (pageno, y, _) = anchor in
4447 (if conf
.presentation
then (pageno, y, 1.0) else anchor)
4451 | Ouri
uri -> gotounder (Ulinkuri
uri)
4452 | Olaunch cmd
-> gotounder (Ulaunch cmd
)
4453 | Oremote remote
-> gotounder (Uremote remote
)
4454 | Ohistory
hist -> gotohist hist
4455 | Oremotedest remotedest
-> gotounder (Uremotedest remotedest
)
4459 let outlinesource sourcetype
=
4461 inherit lvsourcebase
4462 val mutable m_items
= E.a
4463 val mutable m_minfo
= E.a
4464 val mutable m_orig_items
= E.a
4465 val mutable m_orig_minfo
= E.a
4466 val mutable m_narrow_patterns
= []
4467 val mutable m_hadremovals
= false
4468 val mutable m_gen
= -1
4470 method getitemcount
=
4471 Array.length m_items
+ (if m_hadremovals
then 1 else 0)
4474 if n == Array.length m_items
&& m_hadremovals
4476 ("[Confirm removal]", 0)
4478 let s, n, _ = m_items
.(n) in
4481 method exit ~
uioh ~cancel ~
active ~
first ~pan
=
4482 ignore
(uioh, first);
4483 let confrimremoval = m_hadremovals
&& active = Array.length m_items
in
4485 if m_narrow_patterns
= []
4486 then m_orig_items
, m_orig_minfo
4487 else m_items
, m_minfo
4491 if not
confrimremoval
4493 gotooutline m_items
.(active);
4498 state
.bookmarks
<- Array.to_list m_items
;
4499 m_orig_items
<- m_items
;
4500 m_orig_minfo
<- m_minfo
;
4510 method hasaction
_ = true
4513 if Array.length m_items
!= Array.length m_orig_items
4516 match m_narrow_patterns
with
4518 | many
-> String.concat
"@Uellipsis" (List.rev many
)
4520 "Narrowed to " ^
s ^
" (ctrl-u to restore)"
4524 match m_narrow_patterns
with
4527 | head
:: _ -> "@Uellipsis" ^ head
4529 method narrow
pattern =
4530 let reopt = try Some
(Str.regexp_case_fold
pattern) with _ -> None
in
4534 let rec loop accu minfo n =
4537 m_items
<- Array.of_list
accu;
4538 m_minfo
<- Array.of_list
minfo;
4541 let (s, _, t
) as o = m_items
.(n) in
4544 | Oaction
_ -> o :: accu, (0, 0) :: minfo
4545 | Onone
| Oanchor
_ | Ouri
_ | Olaunch
_
4546 | Oremote
_ | Oremotedest
_ | Ohistory
_ ->
4548 try Str.search_forward
re s 0
4549 with Not_found
-> -1
4552 then o :: accu, (first, Str.match_end
()) :: minfo
4555 loop accu minfo (n-1)
4557 loop [] [] (Array.length m_items
- 1)
4559 method! getminfo
= m_minfo
4563 match sourcetype
with
4564 | `bookmarks
-> Array.of_list state
.bookmarks
4565 | `outlines
-> state
.outlines
4566 | `history
-> genhistoutlines !Config.historder
4568 m_minfo
<- m_orig_minfo
;
4569 m_items
<- m_orig_items
4572 if sourcetype
= `bookmarks
4574 if m >= 0 && m < Array.length m_items
4576 m_hadremovals
<- true;
4577 m_items
<- Array.init
(Array.length m_items
- 1) (fun n ->
4578 let n = if n >= m then n+1 else n in
4583 method add_narrow_pattern
pattern =
4584 m_narrow_patterns
<- pattern :: m_narrow_patterns
4586 method del_narrow_pattern
=
4587 match m_narrow_patterns
with
4588 | _ :: rest
-> m_narrow_patterns
<- rest
4593 match m_narrow_patterns
with
4594 | pattern :: [] -> self#narrow
pattern; pattern
4596 List.fold_left
(fun accu pattern ->
4597 self#narrow
pattern;
4598 pattern ^
"@Uellipsis" ^
accu) E.s list
4600 method calcactive
anchor =
4601 let rely = getanchory anchor in
4602 let rec loop n best bestd
=
4603 if n = Array.length m_items
4606 let _, _, kind
= m_items
.(n) in
4609 let orely = getanchory anchor in
4610 let d = abs
(orely - rely) in
4613 else loop (n+1) best bestd
4614 | Onone
| Oremote
_ | Olaunch
_
4615 | Oremotedest
_ | Ouri
_ | Ohistory
_ | Oaction
_ ->
4616 loop (n+1) best bestd
4620 method reset
anchor items =
4621 m_hadremovals
<- false;
4622 if state
.gen
!= m_gen
4624 m_orig_items
<- items;
4626 m_narrow_patterns
<- [];
4628 m_orig_minfo
<- E.a;
4632 if items != m_orig_items
4634 m_orig_items
<- items;
4635 if m_narrow_patterns
== []
4636 then m_items
<- items;
4639 let active = self#calcactive
anchor in
4641 m_first
<- firstof m_first
active
4645 let enterselector sourcetype
=
4647 let source = outlinesource sourcetype
in
4650 match sourcetype
with
4651 | `bookmarks
-> Array.of_list state
.bookmarks
4652 | `
outlines -> state
.outlines
4653 | `history
-> genhistoutlines !Config.historder
4655 if Array.length
outlines = 0
4657 showtext ' ' errmsg
;
4660 state
.text <- source#greetmsg
;
4661 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
4662 let anchor = getanchor
() in
4663 source#reset
anchor outlines;
4665 coe (new outlinelistview ~zebra
:(sourcetype
=`history
) ~
source);
4666 G.postRedisplay "enter selector";
4670 let enteroutlinemode =
4671 let f = enterselector `
outlines in
4672 fun () -> f "Document has no outline";
4675 let enterbookmarkmode =
4676 let f = enterselector `bookmarks
in
4677 fun () -> f "Document has no bookmarks (yet)";
4680 let enterhistmode () = enterselector `history
"No history (yet)";;
4682 let quickbookmark ?title
() =
4683 match state
.layout with
4689 let tm = Unix.localtime
(now
()) in
4690 Printf.sprintf
"Quick (page %d) (bookmarked at %d/%d/%d %d:%d)"
4694 (tm.Unix.tm_year
+ 1900)
4697 | Some
title -> title
4699 state
.bookmarks
<- (title, 0, Oanchor
(getanchor1
l)) :: state
.bookmarks
4702 let setautoscrollspeed step goingdown
=
4703 let incr = max
1 ((abs step
) / 2) in
4704 let incr = if goingdown
then incr else -incr in
4705 let astep = boundastep state
.winh
(step
+ incr) in
4706 state
.autoscroll
<- Some
astep;
4710 match conf
.columns
with
4712 | Csingle
_ | Cmulti
_ -> state
.x != 0 || conf
.zoom > 1.0
4715 let panbound x = bound
x (-state
.w) (wadjsb () + state
.winw
);;
4717 let existsinrow pageno (columns
, coverA
, coverB
) p =
4718 let last = ((pageno - coverA
) mod columns
) + columns
in
4719 let rec any = function
4722 if l.pageno = coverA
- 1 || l.pageno = state
.pagecount
- coverB
4726 then (if l.pageno = last then false else any rest
)
4734 match state
.layout with
4736 let pageno = page_of_y state
.y in
4737 gotoghyll (getpagey
(pageno+1))
4739 match conf
.columns
with
4741 if conf
.presentation
&& rest
== [] && l.pageh
> l.pagey + l.pagevh
4743 let y = clamp (pgscale state
.winh
) in
4746 let pageno = min
(l.pageno+1) (state
.pagecount
-1) in
4747 gotoghyll (getpagey
pageno)
4748 | Cmulti
((c, _, _) as cl, _) ->
4749 if conf
.presentation
4750 && (existsinrow l.pageno cl
4751 (fun l -> l.pageh
> l.pagey + l.pagevh))
4753 let y = clamp (pgscale state
.winh
) in
4756 let pageno = min
(l.pageno+c) (state
.pagecount
-1) in
4757 gotoghyll (getpagey
pageno)
4759 if l.pageno < state
.pagecount
- 1 || l.pagecol
< n - 1
4761 let pagey, pageh
= getpageyh
l.pageno in
4762 let pagey = pagey + pageh
* l.pagecol
in
4763 let ips = if l.pagecol
= 0 then 0 else conf
.interpagespace
in
4764 gotoghyll (pagey + pageh
+ ips)
4768 match state
.layout with
4770 let pageno = page_of_y state
.y in
4771 gotoghyll (getpagey
(pageno-1))
4773 match conf
.columns
with
4775 if conf
.presentation
&& l.pagey != 0
4777 gotoghyll (clamp (pgscale ~
-(state
.winh
)))
4779 let pageno = max
0 (l.pageno-1) in
4780 gotoghyll (getpagey
pageno)
4781 | Cmulti
((c, _, coverB
) as cl, _) ->
4782 if conf
.presentation
&&
4783 (existsinrow l.pageno cl (fun l -> l.pagey != 0))
4785 gotoghyll (clamp (pgscale ~
-(state
.winh
)))
4788 if l.pageno = state
.pagecount
- coverB
4792 let pageno = max
0 (l.pageno-decr) in
4793 gotoghyll (getpagey
pageno)
4801 let pageno = max
0 (l.pageno-1) in
4802 let pagey, pageh
= getpageyh
pageno in
4805 let pagey, pageh
= getpageyh
l.pageno in
4806 pagey + pageh
* (l.pagecol
-1) - conf
.interpagespace
4812 if emptystr conf
.savecmd
4813 then error
"don't know where to save modified document"
4815 let savecmd = Str.global_replace percentsre state
.path conf
.savecmd in
4818 (fun s -> error
"failed to obtain path to the saved copy: %s" s)
4821 if not
(emptystr
path)
4823 let tmp = path ^
".tmp" in
4825 Unix.rename
tmp path;
4828 let viewkeyboard key mask
=
4830 let mode = state
.mode in
4831 state
.mode <- Textentry
(te, fun _ -> state
.mode <- mode);
4834 G.postRedisplay "view:enttext"
4836 let ctrl = Wsi.withctrl mask
in
4838 if key >= 0xffb0 && key < 0xffb9 then key - 0xffb0 + 48 else key
4844 if hasunsavedchanges
()
4848 if conf
.angle
mod 360 = 0 && not
(isbirdseye state
.mode)
4850 state
.mode <- LinkNav
(Ltgendir
0);
4853 else showtext '
!'
"Keyboard link navigation does not work under rotation"
4856 begin match state
.mstate
with
4859 G.postRedisplay "kill rect";
4862 | Mscrolly
| Mscrollx
4865 begin match state
.mode with
4868 G.postRedisplay "esc leave linknav"
4872 match state
.ranchors
with
4874 | (path, password, anchor, origin
) :: rest
->
4875 state
.ranchors
<- rest
;
4876 state
.anchor <- anchor;
4877 state
.origin
<- origin
;
4878 state
.nameddest
<- E.s;
4879 opendoc path password
4884 gotoghyll (getnav ~
-1)
4895 Hashtbl.iter
(fun _ opaque -> clearmark
opaque) state
.pagemap
;
4896 G.postRedisplay "dehighlight";
4898 | @slash
| @question
->
4899 let ondone isforw
s =
4900 cbput state
.hists
.pat
s;
4901 state
.searchpattern
<- s;
4904 let s = String.make
1 (Char.chr
key) in
4905 enttext (s, E.s, Some
(onhist state
.hists
.pat
),
4906 textentry, ondone (key = @slash
), true)
4908 | @plus
| @kpplus
| @equals
when ctrl ->
4909 let incr = if conf
.zoom +. 0.01 > 0.1 then 0.1 else 0.01 in
4910 setzoom (conf
.zoom +. incr)
4912 | @plus
| @kpplus
->
4915 try int_of_string
s with exc
->
4916 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
);
4922 state
.text <- "page bias is now " ^ string_of_int
n;
4925 enttext ("page bias: ", E.s, None
, intentry, ondone, true)
4927 | @minus
| @kpminus
when ctrl ->
4928 let decr = if conf
.zoom -. 0.1 < 0.1 then 0.01 else 0.1 in
4929 setzoom (max
0.01 (conf
.zoom -. decr))
4931 | @minus
| @kpminus
->
4932 let ondone msg
= state
.text <- msg
in
4934 "option [acfhilpstvxACFPRSZTISM]: ", E.s, None
,
4935 optentry state
.mode, ondone, true
4946 | (@1 | @2) when ctrl && conf
.fitmodel
!= FitPage
-> (* ctrl-1/2 *)
4948 match conf
.columns
with
4949 | Csingle
_ | Cmulti
_ -> 1
4950 | Csplit
(n, _) -> n
4952 let h = state
.winh
-
4953 conf
.interpagespace
lsl (if conf
.presentation
then 1 else 0)
4955 let zoom = zoomforh state
.winw
h (vscrollw ()) cols in
4956 if zoom > 0.0 && (key = 50 || zoom < 1.0)
4961 match conf
.fitmodel
with
4962 | FitWidth
-> FitProportional
4963 | FitProportional
-> FitPage
4964 | FitPage
-> FitWidth
4966 state
.text <- "fit model: " ^
FMTE.to_string
fm;
4967 reqlayout conf
.angle
fm
4975 | (48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57)
4976 when not
ctrl -> (* 0..9 *)
4979 try int_of_string
s with exc
->
4980 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
);
4986 cbput state
.hists
.pag
(string_of_int
n);
4987 gotopage1 (n + conf
.pagebias
- 1) 0;
4990 let pageentry text key =
4991 match Char.unsafe_chr
key with
4992 | '
g'
-> TEdone
text
4993 | _ -> intentry text key
4995 let text = String.make
1 (Char.chr
key) in
4996 enttext (":", text, Some
(onhist state
.hists
.pag
),
4997 pageentry, ondone, true)
5000 conf
.scrollb
<- if conf
.scrollb
= 0 then (scrollbvv
lor scrollbhv
) else 0;
5001 reshape state
.winw state
.winh
;
5004 state
.bzoom
<- not state
.bzoom
;
5006 showtext ' '
("block zoom " ^
if state
.bzoom
then "on" else "off")
5009 conf
.hlinks
<- not conf
.hlinks
;
5010 state
.text <- "highlightlinks " ^
if conf
.hlinks
then "on" else "off";
5011 G.postRedisplay "toggle highlightlinks";
5014 state
.glinks
<- true;
5015 let mode = state
.mode in
5016 state
.mode <- Textentry
(
5017 (":", E.s, None
, linknentry, linkndone gotounder, false),
5019 state
.glinks
<- false;
5023 G.postRedisplay "view:linkent(F)"
5026 state
.glinks
<- true;
5027 let mode = state
.mode in
5028 state
.mode <- Textentry
(
5030 ":", E.s, None
, linknentry, linkndone (fun under ->
5031 selstring (undertext under);
5035 state
.glinks
<- false;
5039 G.postRedisplay "view:linkent"
5042 begin match state
.autoscroll
with
5044 conf
.autoscrollstep
<- step
;
5045 state
.autoscroll
<- None
5047 if conf
.autoscrollstep
= 0
5048 then state
.autoscroll
<- Some
1
5049 else state
.autoscroll
<- Some conf
.autoscrollstep
5056 setpresentationmode (not conf
.presentation
);
5057 showtext ' '
("presentation mode " ^
5058 if conf
.presentation
then "on" else "off");
5061 if List.mem
Wsi.Fullscreen state
.winstate
5062 then Wsi.reshape conf
.cwinw conf
.cwinh
5063 else Wsi.fullscreen
()
5066 search state
.searchpattern
false
5069 search state
.searchpattern
true
5072 begin match state
.layout with
5075 gotoghyll (getpagey
l.pageno)
5081 | @delete
| @kpdelete
-> (* delete *)
5085 showtext ' '
(describe_location ());
5088 begin match state
.layout with
5091 Wsi.reshape (l.pagew
+ vscrollw ()) l.pageh
;
5096 enterbookmarkmode ()
5104 | @e when Buffer.length state
.errmsgs
> 0 ->
5109 match state
.layout with
5114 (s, 0, Oanchor
(getanchor1
l)) :: state
.bookmarks
5117 enttext ("bookmark: ", E.s, None
, textentry, ondone, true)
5121 showtext ' '
"Quick bookmark added";
5124 begin match state
.layout with
5126 let rect = getpdimrect
l.pagedimno
in
5130 (truncate
(1.8 *. (rect.(1) -. rect.(0))),
5131 truncate
(1.2 *. (rect.(3) -. rect.(0))))
5133 (truncate
(rect.(1) -. rect.(0)),
5134 truncate
(rect.(3) -. rect.(0)))
5136 let w = truncate
((float w)*.conf
.zoom)
5137 and h = truncate
((float h)*.conf
.zoom) in
5140 state
.anchor <- getanchor
();
5141 Wsi.reshape (w + vscrollw ()) (h + conf
.interpagespace
)
5143 G.postRedisplay "z";
5148 | @x -> state
.roam
()
5151 reqlayout (conf
.angle
+
5152 (if key = @Gt
then 30 else -30)) conf
.fitmodel
5156 bound
(conf
.colorscale
+. (if key = 93 then 0.1 else -0.1)) 0.0 1.0
5158 G.postRedisplay "brightness";
5160 | @c when state
.mode = View
->
5165 let m = (wadjsb () + state
.winw
- state
.w) / 2 in
5167 gotoy_and_clear_text state
.y
5171 match state
.prevcolumns
with
5172 | None
-> (1, 0, 0), 1.0
5173 | Some
(columns
, z
) ->
5176 | Csplit
(c, _) -> -c, 0, 0
5177 | Cmulti
((c, a, b), _) -> c, a, b
5178 | Csingle
_ -> 1, 0, 0
5182 setcolumns View
c a b;
5185 | @down
| @up
when ctrl && Wsi.withshift mask
->
5186 let zoom, x = state
.prevzoom
in
5190 | @k
| @up
| @kpup
->
5191 begin match state
.autoscroll
with
5193 begin match state
.mode with
5194 | Birdseye beye
-> upbirdseye 1 beye
5199 then gotoy_and_clear_text (clamp ~
-(state
.winh
/2))
5201 if not
(Wsi.withshift mask
) && conf
.presentation
5203 else gotoghyll1 true (clamp (-conf
.scrollstep
))
5207 setautoscrollspeed n false
5210 | @j
| @down
| @kpdown
->
5211 begin match state
.autoscroll
with
5213 begin match state
.mode with
5214 | Birdseye beye
-> downbirdseye 1 beye
5219 then gotoy_and_clear_text (clamp (state
.winh
/2))
5221 if not
(Wsi.withshift mask
) && conf
.presentation
5223 else gotoghyll1 true (clamp (conf
.scrollstep
))
5227 setautoscrollspeed n true
5230 | @left | @right
| @kpleft
| @kpright
when not
(Wsi.withalt mask
) ->
5236 else conf
.hscrollstep
5238 let dx = if key = @left || key = @kpleft
then dx else -dx in
5239 state
.x <- panbound (state
.x + dx);
5240 gotoy_and_clear_text state
.y
5243 G.postRedisplay "left/right"
5246 | @prior
| @kpprior
->
5250 match state
.layout with
5252 | l :: _ -> state
.y - l.pagey
5254 clamp (pgscale (-state
.winh
))
5258 | @next | @kpnext
->
5262 match List.rev state
.layout with
5264 | l :: _ -> getpagey
l.pageno
5266 clamp (pgscale state
.winh
)
5270 | @g | @home
| @kphome
->
5273 | @G
| @jend
| @kpend
->
5275 gotoghyll (clamp state
.maxy)
5277 | @right
| @kpright
when Wsi.withalt mask
->
5278 gotoghyll (getnav 1)
5279 | @left | @kpleft
when Wsi.withalt mask
->
5280 gotoghyll (getnav ~
-1)
5285 | @v when conf
.debug
->
5288 match getopaque l.pageno with
5291 let x0, y0, x1, y1 = pagebbox
opaque in
5292 let a,b = float x0, float y0 in
5293 let c,d = float x1, float y0 in
5294 let e,f = float x1, float y1 in
5295 let h,j
= float x0, float y1 in
5296 let rect = (a,b,c,d,e,f,h,j
) in
5298 state
.rects
<- (l.pageno, l.pageno mod 3, rect) :: state
.rects
;
5300 G.postRedisplay "v";
5303 let mode = state
.mode in
5304 let cmd = ref E.s in
5305 let onleave = function
5306 | Cancel
-> state
.mode <- mode
5309 match getopaque l.pageno with
5310 | Some
opaque -> pipesel opaque !cmd
5311 | None
-> ()) state
.layout;
5315 cbput state
.hists
.sel
s;
5319 "| ", !cmd, Some
(onhist state
.hists
.sel
), textentry, ondone, true
5321 G.postRedisplay "|";
5322 state
.mode <- Textentry
(te, onleave);
5325 vlog "huh? %s" (Wsi.keyname
key)
5328 let linknavkeyboard key mask
linknav =
5329 let getpage pageno =
5330 let rec loop = function
5332 | l :: _ when l.pageno = pageno -> Some
l
5333 | _ :: rest
-> loop rest
5334 in loop state
.layout
5336 let doexact (pageno, n) =
5337 match getopaque pageno, getpage pageno with
5338 | Some
opaque, Some
l ->
5339 if key = @enter
|| key = @kpenter
5341 let under = getlink
opaque n in
5342 G.postRedisplay "link gotounder";
5349 Some
(findlink
opaque LDfirst
), -1
5352 Some
(findlink
opaque LDlast
), 1
5355 Some
(findlink
opaque (LDleft
n)), -1
5358 Some
(findlink
opaque (LDright
n)), 1
5361 Some
(findlink
opaque (LDup
n)), -1
5364 Some
(findlink
opaque (LDdown
n)), 1
5369 begin match findpwl
l.pageno dir with
5373 state
.mode <- LinkNav
(Ltgendir
dir);
5374 let y, h = getpageyh
pageno in
5377 then y + h - state
.winh
5382 begin match getopaque pageno, getpage pageno with
5383 | Some
opaque, Some
_ ->
5385 let ld = if dir > 0 then LDfirst
else LDlast
in
5388 begin match link with
5390 showlinktype (getlink
opaque m);
5391 state
.mode <- LinkNav
(Ltexact
(pageno, m));
5392 G.postRedisplay "linknav jpage";
5393 | Lnotfound
-> notfound dir
5399 begin match opt with
5400 | Some Lnotfound
-> pwl l dir;
5401 | Some
(Lfound
m) ->
5405 let _, y0, _, y1 = getlinkrect
opaque m in
5407 then gotopage1 l.pageno y0
5409 let d = fstate
.fontsize
+ 1 in
5410 if y1 - l.pagey > l.pagevh - d
5411 then gotopage1 l.pageno (y1 - state
.winh
- hscrollh () + d)
5412 else G.postRedisplay "linknav";
5414 showlinktype (getlink
opaque m);
5415 state
.mode <- LinkNav
(Ltexact
(l.pageno, m));
5418 | None
-> viewkeyboard key mask
5420 | _ -> viewkeyboard key mask
5425 G.postRedisplay "leave linknav"
5429 | Ltgendir
_ | Ltnotready
_ -> viewkeyboard key mask
5430 | Ltexact exact
-> doexact exact
5433 let keyboard key mask
=
5434 if (key = 103 && Wsi.withctrl mask
) && not
(istextentry state
.mode)
5435 then wcmd "interrupt"
5436 else state
.uioh <- state
.uioh#
key key mask
5439 let birdseyekeyboard key mask
5440 ((oconf
, leftx
, pageno, hooverpageno
, anchor) as beye
) =
5442 match conf
.columns
with
5444 | Cmulti
((c, _, _), _) -> c
5445 | Csplit
_ -> failwith
"bird's eye split mode"
5447 let pgh layout = List.fold_left
5448 (fun m l -> max
l.pageh
m) state
.winh
layout in
5450 | @l when Wsi.withctrl mask
->
5451 let y, h = getpageyh
pageno in
5452 let top = (state
.winh
- h) / 2 in
5453 gotoy (max
0 (y - top))
5454 | @enter
| @kpenter
-> leavebirdseye beye
false
5455 | @escape
-> leavebirdseye beye
true
5456 | @up
-> upbirdseye incr beye
5457 | @down
-> downbirdseye incr beye
5458 | @left -> upbirdseye 1 beye
5459 | @right
-> downbirdseye 1 beye
5462 begin match state
.layout with
5466 state
.mode <- Birdseye
(
5467 oconf
, leftx
, l.pageno, hooverpageno
, anchor
5469 gotopage1 l.pageno 0;
5472 let layout = layout (state
.y-state
.winh
) (pgh state
.layout) in
5474 | [] -> gotoy (clamp (-state
.winh
))
5476 state
.mode <- Birdseye
(
5477 oconf
, leftx
, l.pageno, hooverpageno
, anchor
5479 gotopage1 l.pageno 0
5482 | [] -> gotoy (clamp (-state
.winh
))
5486 begin match List.rev state
.layout with
5488 let layout = layout (state
.y + (pgh state
.layout)) state
.winh
in
5489 begin match layout with
5491 let incr = l.pageh
- l.pagevh in
5496 oconf
, leftx
, state
.pagecount
- 1, hooverpageno
, anchor
5498 G.postRedisplay "birdseye pagedown";
5500 else gotoy (clamp (incr + conf
.interpagespace
*2));
5504 Birdseye
(oconf
, leftx
, l.pageno, hooverpageno
, anchor);
5505 gotopage1 l.pageno 0;
5508 | [] -> gotoy (clamp state
.winh
)
5512 state
.mode <- Birdseye
(oconf
, leftx
, 0, hooverpageno
, anchor);
5516 let pageno = state
.pagecount
- 1 in
5517 state
.mode <- Birdseye
(oconf
, leftx
, pageno, hooverpageno
, anchor);
5518 if not
(pagevisible state
.layout pageno)
5521 match List.rev state
.pdims
with
5523 | (_, _, h, _) :: _ -> h
5525 gotoy (max
0 (getpagey
pageno - (state
.winh
- h - conf
.interpagespace
)))
5526 else G.postRedisplay "birdseye end";
5528 | _ -> viewkeyboard key mask
5533 match state
.mode with
5534 | Textentry
_ -> scalecolor 0.4
5536 | View
-> scalecolor 1.0
5537 | Birdseye
(_, _, pageno, hooverpageno
, _) ->
5538 if l.pageno = hooverpageno
5541 if l.pageno = pageno
5543 let c = scalecolor 1.0 in
5545 GlDraw.line_width
3.0;
5546 let dispx = xadjsb () + l.pagedispx in
5548 (float (dispx-1)) (float (l.pagedispy-1))
5549 (float (dispx+l.pagevw+1))
5550 (float (l.pagedispy+l.pagevh+1))
5552 GlDraw.line_width
1.0;
5561 let postdrawpage l linkindexbase
=
5562 match getopaque l.pageno with
5564 if tileready l l.pagex
l.pagey
5566 let x = l.pagedispx - l.pagex
+ xadjsb ()
5567 and y = l.pagedispy - l.pagey in
5569 match conf
.columns
with
5570 | Csingle
_ | Cmulti
_ ->
5571 (if conf
.hlinks
then 1 else 0)
5573 && not
(isbirdseye state
.mode) then 2 else 0)
5577 match state
.mode with
5578 | Textentry
((_, s, _, _, _, _), _) when state
.glinks
-> s
5584 postprocess
opaque hlmask x y (linkindexbase
, s, conf
.hfsize
);
5589 let scrollindicator () =
5590 let sbw, ph
, sh = state
.uioh#
scrollph in
5591 let sbh, pw, sw = state
.uioh#scrollpw
in
5596 else ((state
.winw
- sbw), state
.winw
, 0)
5599 GlDraw.color (0.64, 0.64, 0.64);
5600 filledrect (float x0) 0. (float x1) (float state
.winh
);
5602 (float hx0
) (float (state
.winh
- sbh))
5603 (float (hx0
+ wadjsb () + state
.winw
)) (float state
.winh
)
5605 GlDraw.color (0.0, 0.0, 0.0);
5607 filledrect (float x0) ph
(float x1) (ph
+. sh);
5608 let pw = pw +. float hx0
in
5609 filledrect pw (float (state
.winh
- sbh)) (pw +. sw) (float state
.winh
);
5613 match state
.mstate
with
5614 | Mnone
| Mscrolly
| Mscrollx
| Mpan
_ | Mzoom
_ | Mzoomrect
_ ->
5617 | Msel
((x0, y0), (x1, y1)) ->
5618 let identify opaque l px py = Some
(opaque, l.pageno, px, py) in
5619 let o0,n0
,px0
,py0
= onppundermouse identify x0 y0 (~
< E.s, -1, 0, 0) in
5620 let _o1,n1
,px1
,py1
= onppundermouse identify x1 y1 (~
< E.s, -1, 0, 0) in
5621 if n0
!= -1 && n0
= n1
then seltext
o0 (px0
, py0
, px1
, py1
);
5624 let showrects = function [] -> () | rects
->
5626 GlDraw.color (0.0, 0.0, 1.0) ~
alpha:0.5;
5627 GlFunc.blend_func ~
src:`src_alpha ~dst
:`one_minus_src_alpha
;
5629 (fun (pageno, c, (x0, y0, x1, y1, x2
, y2
, x3
, y3
)) ->
5631 if l.pageno = pageno
5633 let dx = float (l.pagedispx - l.pagex
) in
5634 let dy = float (l.pagedispy - l.pagey) in
5635 GlDraw.color (0.0, 0.0, 1.0 /. float c) ~
alpha:0.5;
5636 Raw.sets_float state
.vraw ~
pos:0
5641 GlArray.vertex `two state
.vraw
;
5642 GlArray.draw_arrays `triangle_strip ~
first:0 ~count
:4;
5651 GlClear.color (scalecolor2 conf
.bgcolor
);
5652 GlClear.clear
[`
color];
5653 List.iter
drawpage state
.layout;
5655 match state
.mode with
5656 | LinkNav
(Ltexact
(pageno, linkno
)) ->
5657 begin match getopaque pageno with
5659 let dx = xadjsb () in
5660 let x0, y0, x1, y1 = getlinkrect
opaque linkno
in
5661 let x0 = x0 + dx and x1 = x1 + dx in
5668 | None
-> state
.rects
5670 | LinkNav
(Ltgendir
_) | LinkNav
(Ltnotready
_)
5673 | View
-> state
.rects
5676 let rec postloop linkindexbase
= function
5678 let linkindexbase = linkindexbase + postdrawpage l linkindexbase in
5679 postloop linkindexbase rest
5683 postloop 0 state
.layout;
5685 begin match state
.mstate
with
5686 | Mzoomrect
((x0, y0), (x1, y1)) ->
5688 GlDraw.color (0.3, 0.3, 0.3) ~
alpha:0.5;
5689 GlFunc.blend_func ~
src:`src_alpha ~dst
:`one_minus_src_alpha
;
5690 filledrect (float x0) (float y0) (float x1) (float y1);
5694 | Mscrolly
| Mscrollx
5703 let zoomrect x y x1 y1 =
5706 and y0 = min
y y1 in
5707 gotoy (state
.y + y0);
5708 state
.anchor <- getanchor
();
5709 let zoom = (float state
.w) /. float (x1 - x0) in
5712 let adjw = wadjsb () + state
.winw
in
5714 then (adjw - state
.w) / 2
5717 match conf
.fitmodel
with
5718 | FitWidth
| FitProportional
-> simple ()
5720 match conf
.columns
with
5722 onppundermouse (fun _ l _ _ -> Some
l.pagedispx) x0 y0 x0
5723 | Cmulti
_ | Csingle
_ -> simple ()
5725 state
.x <- (state
.x + margin) - x0;
5730 let annot inline
x y =
5731 match unproject x y with
5732 | Some
(opaque, n, ux
, uy
) ->
5734 addannot
opaque ux uy
text;
5735 wcmd "freepage %s" (~
> opaque);
5736 Hashtbl.remove state
.pagemap
(n, state
.gen
);
5742 let ondone s = add s in
5743 let mode = state
.mode in
5744 state
.mode <- Textentry
(
5745 ("annotation: ", E.s, None
, textentry, ondone, true),
5746 fun _ -> state
.mode <- mode);
5749 G.postRedisplay "annot"
5752 let s = getusertext E.s in
5753 let l = Str.split newlinere
s in
5761 let g opaque l px py =
5762 match rectofblock
opaque px py with
5764 let x0 = a.(0) -. 20. in
5765 let x1 = a.(1) +. 20. in
5766 let y0 = a.(2) -. 20. in
5767 let zoom = (float state
.w) /. (x1 -. x0) in
5768 let pagey = getpagey
l.pageno in
5769 gotoy_and_clear_text (pagey + truncate
y0);
5770 state
.anchor <- getanchor
();
5771 let margin = (state
.w - l.pagew
)/2 in
5772 state
.x <- -truncate
x0 - margin;
5777 match conf
.columns
with
5779 showtext '
!'
"block zooming does not work properly in split columns mode"
5780 | Cmulti
_ | Csingle
_ -> onppundermouse g x y ()
5784 let winw = wadjsb () + state
.winw - 1 in
5785 let s = float x /. float winw in
5786 let destx = truncate
(float (state
.w + winw) *. s) in
5787 state
.x <- winw - destx;
5788 gotoy_and_clear_text state
.y;
5789 state
.mstate
<- Mscrollx
;
5793 let s = float y /. float state
.winh
in
5794 let desty = truncate
(float (state
.maxy - state
.winh
) *. s) in
5795 gotoy_and_clear_text desty;
5796 state
.mstate
<- Mscrolly
;
5799 let viewmulticlick clicks
x y mask
=
5800 let g opaque l px py =
5808 if markunder
opaque px py mark
5812 match getopaque l.pageno with
5814 | Some
opaque -> pipesel opaque cmd
5816 state
.roam
<- (fun () -> dopipe conf
.paxcmd
);
5817 if not
(Wsi.withctrl mask
) then dopipe conf
.selcmd
;
5822 G.postRedisplay "viewmulticlick";
5823 onppundermouse g x y (fun () -> showtext '
!'
"Nothing to select") ();
5827 match conf
.columns
with
5829 | Csingle
_ | Cmulti
_ -> conf
.angle
mod 360 = 0
5832 let viewmouse button down
x y mask
=
5834 | n when (n == 4 || n == 5) && not down
->
5835 if Wsi.withctrl mask
5837 match state
.mstate
with
5838 | Mzoom
(oldn
, i
) ->
5846 if conf
.zoom +. 0.01 > 0.1 then 0.1 else 0.01
5848 if conf
.zoom -. 0.1 < 0.1 then -0.01 else -0.1
5850 let zoom = conf
.zoom -. incr in
5852 state
.mstate
<- Mzoom
(n, 0);
5854 state
.mstate
<- Mzoom
(n, i
+1);
5856 else state
.mstate
<- Mzoom
(n, 0)
5860 | Mscrolly
| Mscrollx
5862 | Mnone
-> state
.mstate
<- Mzoom
(n, 0)
5865 match state
.autoscroll
with
5866 | Some step
-> setautoscrollspeed step
(n=4)
5868 if conf
.wheelbypage
|| conf
.presentation
5877 then -conf
.scrollstep
5878 else conf
.scrollstep
5880 let incr = incr * 2 in
5881 let y = clamp incr in
5882 gotoy_and_clear_text y
5885 | n when (n = 6 || n = 7) && not down
&& canpan () ->
5887 panbound (state
.x + (if n = 7 then -2 else 2) * conf
.hscrollstep
);
5888 gotoy_and_clear_text state
.y
5890 | 1 when Wsi.withshift mask
->
5891 state
.mstate
<- Mnone
;
5894 match unproject x y with
5895 | Some
(_, pageno, ux
, uy
) ->
5896 let cmd = Printf.sprintf
5898 conf
.stcmd state
.path pageno ux uy
5900 addpid
@@ popen
cmd []
5904 | 1 when Wsi.withctrl mask
->
5907 Wsi.setcursor
Wsi.CURSOR_CROSSHAIR
;
5908 state
.mstate
<- Mpan
(x, y)
5911 state
.mstate
<- Mnone
5916 if Wsi.withshift mask
5918 annot conf
.annotinline
x y;
5919 G.postRedisplay "addannot"
5923 Wsi.setcursor
Wsi.CURSOR_CYCLE
;
5924 state
.mstate
<- Mzoomrect
(p, p)
5927 match state
.mstate
with
5928 | Mzoomrect
((x0, y0), _) ->
5929 if abs
(x-x0) > 10 && abs
(y - y0) > 10
5930 then zoomrect x0 y0 x y
5933 G.postRedisplay "kill accidental zoom rect";
5937 | Mscrolly
| Mscrollx
5943 | 1 when x > state
.winw - vscrollw () ->
5946 let _, position, sh = state
.uioh#
scrollph in
5947 if y > truncate
position && y < truncate
(position +. sh)
5948 then state
.mstate
<- Mscrolly
5951 state
.mstate
<- Mnone
5953 | 1 when y > state
.winh
- hscrollh () ->
5956 let _, position, sw = state
.uioh#scrollpw
in
5957 if x > truncate
position && x < truncate
(position +. sw)
5958 then state
.mstate
<- Mscrollx
5961 state
.mstate
<- Mnone
5963 | 1 when state
.bzoom
-> if not down
then zoomblock x y
5966 let dest = if down
then getunder x y else Unone
in
5967 begin match dest with
5970 | Uremote
_ | Uremotedest
_
5971 | Uunexpected
_ | Ulaunch
_ | Unamed
_ ->
5974 | Unone
when down
->
5975 Wsi.setcursor
Wsi.CURSOR_CROSSHAIR
;
5976 state
.mstate
<- Mpan
(x, y);
5978 | Uannotation
(opaque, slinkindex
) -> enterannotmode opaque slinkindex
5980 | Unone
| Utext
_ ->
5985 state
.mstate
<- Msel
((x, y), (x, y));
5986 G.postRedisplay "mouse select";
5990 match state
.mstate
with
5993 | Mzoom
_ | Mscrollx
| Mscrolly
->
5994 state
.mstate
<- Mnone
5996 | Mzoomrect
((x0, y0), _) ->
6000 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
6001 state
.mstate
<- Mnone
6003 | Msel
((x0, y0), (x1, y1)) ->
6004 let rec loop = function
6008 let a0 = l.pagedispy in
6009 let a1 = a0 + l.pagevh in
6010 let b0 = l.pagedispx in
6011 let b1 = b0 + l.pagevw in
6012 ((y0 >= a0 && y0 <= a1) || (y1 >= a0 && y1 <= a1))
6013 && ((x0 >= b0 && x0 <= b1) || (x1 >= b0 && x1 <= b1))
6017 match getopaque l.pageno with
6020 match Unix.pipe
() with
6024 "can not create sel pipe: %s"
6028 Ne.clo fd
(fun msg
->
6029 dolog
"%s close failed: %s" what msg
)
6032 try popen
cmd [r
, 0; w, -1]
6034 dolog
"can not execute %S: %s"
6041 G.postRedisplay "copysel";
6043 else clo "Msel pipe/w" w;
6044 clo "Msel pipe/r" r
;
6046 dosel conf
.selcmd
();
6047 state
.roam
<- dosel conf
.paxcmd
;
6059 let birdseyemouse button down
x y mask
6060 (conf
, leftx
, _, hooverpageno
, anchor) =
6063 let rec loop = function
6066 if y > l.pagedispy && y < l.pagedispy + l.pagevh
6067 && x > l.pagedispx && x < l.pagedispx + l.pagevw
6069 leavebirdseye (conf
, leftx
, l.pageno, hooverpageno
, anchor) false;
6075 | _ -> viewmouse button down
x y mask
6081 method key key mask
=
6082 begin match state
.mode with
6083 | Textentry
textentry -> textentrykeyboard key mask
textentry
6084 | Birdseye
birdseye -> birdseyekeyboard key mask
birdseye
6085 | View
-> viewkeyboard key mask
6086 | LinkNav
linknav -> linknavkeyboard key mask
linknav
6090 method button button bstate
x y mask
=
6091 begin match state
.mode with
6093 | View
-> viewmouse button bstate
x y mask
6094 | Birdseye beye
-> birdseyemouse button bstate
x y mask beye
6099 method multiclick clicks
x y mask
=
6100 begin match state
.mode with
6102 | View
-> viewmulticlick clicks
x y mask
6109 begin match state
.mode with
6111 | View
| Birdseye
_ | LinkNav
_ ->
6112 match state
.mstate
with
6113 | Mzoom
_ | Mnone
-> ()
6118 state
.mstate
<- Mpan
(x, y);
6120 then state
.x <- panbound (state
.x + dx);
6122 gotoy_and_clear_text y
6125 state
.mstate
<- Msel
(a, (x, y));
6126 G.postRedisplay "motion select";
6129 let y = min state
.winh
(max
0 y) in
6133 let x = min state
.winw (max
0 x) in
6136 | Mzoomrect
(p0
, _) ->
6137 state
.mstate
<- Mzoomrect
(p0
, (x, y));
6138 G.postRedisplay "motion zoomrect";
6142 method pmotion
x y =
6143 begin match state
.mode with
6144 | Birdseye
(conf
, leftx
, pageno, hooverpageno
, anchor) ->
6145 let rec loop = function
6147 if hooverpageno
!= -1
6149 state
.mode <- Birdseye
(conf
, leftx
, pageno, -1, anchor);
6150 G.postRedisplay "pmotion birdseye no hoover";
6153 if y > l.pagedispy && y < l.pagedispy + l.pagevh
6154 && x > l.pagedispx && x < l.pagedispx + l.pagevw
6156 state
.mode <- Birdseye
(conf
, leftx
, pageno, l.pageno, anchor);
6157 G.postRedisplay "pmotion birdseye hoover";
6167 match state
.mstate
with
6168 | Mpan
_ | Msel
_ | Mzoom
_ | Mscrolly
| Mscrollx
| Mzoomrect
_ -> ()
6176 let past, _, _ = !r
in
6178 let delta = now -. past in
6181 else r
:= (now, x, y)
6185 method infochanged
_ = ()
6188 let maxy = state
.maxy - (if conf
.maxhfit
then state
.winh
else 0) in
6191 then 0.0, float state
.winh
6192 else scrollph state
.y maxy
6197 let winw = wadjsb () + state
.winw in
6198 let fwinw = float winw in
6200 let sw = fwinw /. float state
.w in
6201 let sw = fwinw *. sw in
6202 max
sw (float conf
.scrollh
)
6205 let maxx = state
.w + winw in
6206 let x = winw - state
.x in
6207 let percent = float x /. float maxx in
6208 (fwinw -. sw) *. percent
6210 hscrollh (), position, sw
6214 match state
.mode with
6215 | LinkNav
_ -> "links"
6216 | Textentry
_ -> "textentry"
6217 | Birdseye
_ -> "birdseye"
6220 findkeyhash conf
modename
6222 method eformsgs
= true
6223 method alwaysscrolly
= false
6226 let adderrmsg src msg
=
6227 Buffer.add_string state
.errmsgs msg
;
6228 state
.newerrmsgs
<- true;
6232 let adderrfmt src fmt
=
6233 Format.ksprintf
(fun s -> adderrmsg src s) fmt
;
6237 let cl = splitatspace cmds
in
6239 try Scanf.sscanf
s fmt
f
6241 adderrfmt "remote exec"
6242 "error processing '%S': %s\n" cmds
(exntos exn
)
6245 | "reload" :: [] -> reload ()
6246 | "goto" :: args
:: [] ->
6247 scan args
"%u %f %f"
6249 let cmd, _ = state
.geomcmds
in
6251 then gotopagexy pageno x y
6254 gotopagexy pageno x y;
6257 state
.reprf
<- f state
.reprf
6259 | "goto1" :: args
:: [] -> scan args
"%u %f" gotopage
6260 | "gotor" :: args
:: [] ->
6262 (fun filename
pageno -> gotounder (Uremote
(filename
, pageno)))
6263 | "gotord" :: args
:: [] ->
6265 (fun filename
dest -> gotounder (Uremotedest
(filename
, dest)))
6266 | "rect" :: args
:: [] ->
6267 scan args
"%u %u %f %f %f %f"
6268 (fun pageno color x0 y0 x1 y1 ->
6269 onpagerect pageno (fun w h ->
6270 let _,w1,h1
,_ = getpagedim
pageno in
6271 let sw = float w1 /. float w
6272 and sh = float h1
/. float h in
6276 and y1s
= y1 *. sh in
6277 let rect = (x0s,y0s
,x1s
,y0s
,x1s
,y1s
,x0s,y1s
) in
6279 state
.rects <- (pageno, color, rect) :: state
.rects;
6280 G.postRedisplay "rect";
6283 | "activatewin" :: [] -> Wsi.activatewin
()
6284 | "quit" :: [] -> raise Quit
6286 adderrfmt "remote command"
6287 "error processing remote command: %S\n" cmds
;
6291 let scratch = Bytes.create
80 in
6292 let buf = Buffer.create
80 in
6295 try Some
(Unix.read fd
scratch 0 80)
6297 | Unix.Unix_error
(Unix.EAGAIN
, _, _) -> None
6298 | Unix.Unix_error
(Unix.EINTR
, _, _) -> tempfr ()
6301 match tempfr () with
6307 if Buffer.length
buf > 0
6309 let s = Buffer.contents
buf in
6319 let pos = Bytes.index_from
scratch ppos '
\n'
in
6320 if pos >= n then -1 else pos
6321 with Not_found
-> -1
6325 Buffer.add_subbytes
buf scratch ppos
(nlpos-ppos
);
6326 let s = Buffer.contents
buf in
6332 Buffer.add_subbytes
buf scratch ppos
(n-ppos
);
6338 let remoteopen path =
6339 try Some
(Unix.openfile
path [Unix.O_NONBLOCK
; Unix.O_RDONLY
] 0o0)
6341 adderrfmt "remoteopen" "error opening %S: %s" path (exntos exn
);
6346 let gcconfig = ref E.s in
6347 let trimcachepath = ref E.s in
6348 let rcmdpath = ref E.s in
6349 let pageno = ref None
in
6350 let rootwid = ref 0 in
6351 let openlast = ref false in
6352 let nofc = ref false in
6353 let doreap = ref false in
6354 selfexec := Sys.executable_name
;
6357 [("-p", Arg.String
(fun s -> state
.password <- s),
6358 "<password> Set password");
6362 Config.fontpath
:= s;
6363 selfexec := !selfexec ^
" -f " ^
Filename.quote
s;
6365 "<path> Set path to the user interface font");
6369 selfexec := !selfexec ^
" -c " ^
Filename.quote
s;
6370 Config.confpath
:= s),
6371 "<path> Set path to the configuration file");
6373 ("-last", Arg.Set
openlast, " Open last document");
6375 ("-page", Arg.Int
(fun pageno1
-> pageno := Some
(pageno1
-1)),
6376 "<page-number> Jump to page");
6378 ("-tcf", Arg.String
(fun s -> trimcachepath := s),
6379 "<path> Set path to the trim cache file");
6381 ("-dest", Arg.String
(fun s -> state
.nameddest
<- s),
6382 "<named-destination> Set named destination");
6384 ("-wtmode", Arg.Set
wtmode, " Operate in wt mode");
6385 ("-cxack", Arg.Set
cxack, " Cut corners");
6387 ("-remote", Arg.String
(fun s -> rcmdpath := s),
6388 "<path> Set path to the remote commands source");
6390 ("-origin", Arg.String
(fun s -> state
.origin
<- s),
6391 "<original-path> Set original path");
6393 ("-gc", Arg.Set_string
gcconfig,
6394 "<script-path> Collect garbage with the help of a script");
6396 ("-nofc", Arg.Set
nofc, " Do not use fontconfig");
6398 ("-v", Arg.Unit
(fun () ->
6400 "%s\nconfiguration path: %s\n"
6404 exit
0), " Print version and exit");
6406 ("-embed", Arg.Set_int
rootwid,
6407 "<window-id> Embed into window")
6410 (fun s -> state
.path <- s)
6411 ("Usage: " ^
Sys.argv
.(0) ^
" [options] some.pdf\nOptions:")
6414 then selfexec := !selfexec ^
" -wtmode";
6416 let histmode = emptystr state
.path && not
!openlast in
6418 if not
(Config.load !openlast)
6419 then prerr_endline
"failed to load configuration";
6420 begin match !pageno with
6421 | Some
pageno -> state
.anchor <- (pageno, 0.0, 0.0)
6425 if not
(emptystr
!gcconfig)
6428 match Unix.socketpair
Unix.PF_UNIX
Unix.SOCK_STREAM
0 with
6430 error
"gc socketpair failed: %s" (exntos exn
)
6433 match addpid
@@ popen
!gcconfig [(c, 0); (c, 1)] with
6435 error
"failed to popen gc script: %s" (exntos exn
);
6441 let wsfd, winw, winh
= Wsi.init
(object (self)
6442 val mutable m_clicks
= 0
6443 val mutable m_click_x
= 0
6444 val mutable m_click_y
= 0
6445 val mutable m_lastclicktime
= infinity
6447 method private cleanup =
6448 state
.roam
<- noroam
;
6449 Hashtbl.iter
(fun _ opaque -> clearmark
opaque) state
.pagemap
6450 method expose
= G.postRedisplay"expose"
6454 | Wsi.Unobscured
-> "unobscured"
6455 | Wsi.PartiallyObscured
-> "partiallyobscured"
6456 | Wsi.FullyObscured
-> "fullyobscured"
6458 vlog "visibility change %s" name
6459 method display = display ()
6460 method map mapped
= vlog "mappped %b" mapped
6461 method reshape w h =
6464 method mouse
b d x y m =
6465 if d && canselect ()
6467 (* http://blogs.msdn.com/b/oldnewthing/archive/2004/10/18/243925.aspx *)
6473 if abs
x - m_click_x
> 10
6474 || abs
y - m_click_y
> 10
6475 || abs_float
(t -. m_lastclicktime
) > 0.3
6477 m_clicks
<- m_clicks
+ 1;
6478 m_lastclicktime
<- t;
6482 G.postRedisplay "cleanup";
6483 state
.uioh <- state
.uioh#button
b d x y m;
6485 else state
.uioh <- state
.uioh#multiclick m_clicks
x y m
6490 m_lastclicktime
<- infinity
;
6491 state
.uioh <- state
.uioh#button
b d x y m
6495 state
.uioh <- state
.uioh#button
b d x y m
6498 state
.mpos
<- (x, y);
6499 state
.uioh <- state
.uioh#motion
x y
6500 method pmotion
x y =
6501 state
.mpos
<- (x, y);
6502 state
.uioh <- state
.uioh#pmotion
x y
6504 let mascm = m land (
6505 Wsi.altmask
+ Wsi.shiftmask
+ Wsi.ctrlmask
+ Wsi.metamask
6508 let x = state
.x and y = state
.y in
6510 if x != state
.x || y != state
.y then self#
cleanup
6512 match state
.keystate
with
6514 let km = k
, mascm in
6517 let modehash = state
.uioh#
modehash in
6518 try Hashtbl.find modehash km
6520 try Hashtbl.find (findkeyhash conf
"global") km
6521 with Not_found
-> KMinsrt
(k
, m)
6523 | KMinsrt
(k
, m) -> keyboard k
m
6524 | KMinsrl
l -> List.iter
(fun (k
, m) -> keyboard k
m) l
6525 | KMmulti
(l, r
) -> state
.keystate
<- KSinto
(l, r
)
6527 | KSinto
((k'
, m'
) :: [], insrt
) when k'
=k
&& m'
land mascm = m'
->
6528 List.iter
(fun (k
, m) -> keyboard k
m) insrt
;
6529 state
.keystate
<- KSnone
6530 | KSinto
((k'
, m'
) :: keys, insrt
) when k'
=k
&& m'
land mascm = m'
->
6531 state
.keystate
<- KSinto
(keys, insrt
)
6532 | KSinto
_ -> state
.keystate
<- KSnone
6535 state
.mpos
<- (x, y);
6536 state
.uioh <- state
.uioh#pmotion
x y
6537 method leave = state
.mpos
<- (-1, -1)
6538 method winstate wsl
= state
.winstate
<- wsl
6539 method quit
= raise Quit
6540 end) !rootwid conf
.cwinw conf
.cwinh platform
in
6545 List.exists
GlMisc.check_extension
6546 [ "GL_ARB_texture_rectangle"
6547 ; "GL_EXT_texture_recangle"
6548 ; "GL_NV_texture_rectangle" ]
6550 then (prerr_endline
"OpenGL does not suppport rectangular textures"; exit
1);
6553 let r = GlMisc.get_string `renderer
in
6554 let p = "Mesa DRI Intel(" in
6555 let l = String.length
p in
6556 String.length
r > l && String.sub
r 0 l = p
6559 defconf
.sliceheight
<- 1024;
6560 defconf
.texcount
<- 32;
6561 defconf
.usepbo
<- true;
6565 match Unix.socketpair
Unix.PF_UNIX
Unix.SOCK_STREAM
0 with
6567 Printf.eprintf
"socketpair failed: %s" (exntos exn
);
6575 setcheckers conf
.checkers
;
6577 if conf
.redirectstderr
6581 (Buffer.to_bytes state
.errmsgs
)
6582 (match state
.errfd
with
6584 let s = Bytes.create
(80*24) in
6587 let r, _, _ = Unix.select
[fd
] [] [] 0.0 in
6589 then Unix.read fd
s 0 (Bytes.length
s)
6595 else Bytes.sub
s 0 n
6599 try ignore
(Unix.write state
.stderr
s 0 (Bytes.length
s))
6600 with exn
-> print_endline
(exntos exn
)
6605 conf
.angle
, conf
.fitmodel
, (conf
.trimmargins
, conf
.trimfuzz
),
6606 conf
.texcount
, conf
.sliceheight
, conf
.mustoresize
, conf
.colorspace
,
6607 !Config.fontpath
, !trimcachepath,
6608 GlMisc.check_extension
"GL_ARB_pixel_buffer_object",
6611 List.iter
GlArray.enable
[`texture_coord
; `vertex
];
6617 Wsi.settitle
"llpp (history)";
6621 state
.text <- "Opening " ^
(mbtoutf8 state
.path);
6622 opendoc state
.path state
.password;
6626 Sys.set_signal
Sys.sighup
(Sys.Signal_handle
(fun _ -> reload ()));
6629 match Unix.waitpid
[Unix.WNOHANG
] ~
-1 with
6630 | (exception (Unix.Unix_error
(Unix.ECHILD
, _, _))) -> ()
6631 | (exception exn
) -> dolog
"Unix.waitpid: %s" @@ exntos exn
6633 | _pid
, _status
-> reap ()
6635 Sys.set_signal
Sys.sigchld
(Sys.Signal_handle
(fun _ -> doreap := true));
6639 if nonemptystr
!rcmdpath
6640 then remoteopen !rcmdpath
6645 let rec loop deadline
=
6652 match state
.errfd
with
6653 | None
-> [state
.ss; state
.wsfd]
6654 | Some fd
-> [state
.ss; state
.wsfd; fd
]
6659 | Some fd
-> fd
:: r
6663 state
.redisplay
<- false;
6670 if deadline
= infinity
6672 else max
0.0 (deadline
-. now)
6677 try Unix.select
r [] [] timeout
6678 with Unix.Unix_error
(Unix.EINTR
, _, _) -> [], [], []
6684 if state
.ghyll
== noghyll
6686 match state
.autoscroll
with
6687 | Some step
when step
!= 0 ->
6688 let y = state
.y + step
in
6692 else if y >= state
.maxy then 0 else y
6695 if state
.mode = View
6696 then state
.text <- E.s;
6699 else deadline
+. 0.01
6704 let rec checkfds = function
6706 | fd
:: rest
when fd
= state
.ss ->
6707 let cmd = readcmd state
.ss in
6711 | fd
:: rest
when fd
= state
.wsfd ->
6715 | fd
:: rest
when Some fd
= !optrfd ->
6716 begin match remote fd
with
6717 | None
-> optrfd := remoteopen !rcmdpath;
6718 | opt -> optrfd := opt
6723 let s = Bytes.create
80 in
6724 let n = tempfailureretry
(Unix.read fd
s 0) 80 in
6725 if conf
.redirectstderr
6727 Buffer.add_substring state
.errmsgs
(Bytes.to_string
s) 0 n;
6728 state
.newerrmsgs
<- true;
6729 state
.redisplay
<- true;
6732 prerr_string
(String.sub
(Bytes.to_string
s) 0 n);
6738 if !reeenterhist then (
6740 reeenterhist := false;
6744 if deadline
= infinity
6748 match state
.autoscroll
with
6749 | Some step
when step
!= 0 -> deadline1
6750 | _ -> if state
.ghyll
== noghyll
then infinity
else deadline1
6758 Config.save leavebirdseye;
6759 if hasunsavedchanges
()