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
);
296 G.postRedisplay "pipesel";
298 else doclose "pipesel pipe/w" w
;
299 doclose "pipesel pipe/r" r
;
303 let g opaque l
px py
=
304 if markunder opaque
px py conf
.paxmark
307 match getopaque l
.pageno
with
309 | Some opaque
-> pipesel opaque conf
.paxcmd
314 G.postRedisplay "paxunder";
315 if conf
.paxmark
= Mark_page
318 match getopaque l
.pageno
with
320 | Some opaque
-> clearmark opaque
) state
.layout
;
322 onppundermouse g x y (fun () -> showtext '
!'
"Whoopsie daisy");
326 match Unix.pipe
() with
328 showtext '
!'
(Printf.sprintf
"pipe failed: %s" (exntos exn
))
331 Ne.clo fd
(fun msg
->
332 showtext '
!'
(Printf.sprintf
"failed to close %s: %s" cap msg
)
336 try popen conf
.selcmd
[r
, 0; w
, -1]
339 (Printf.sprintf
"failed to execute %s: %s"
340 conf
.selcmd
(exntos exn
));
347 let l = String.length s
in
348 let bytes = Bytes.unsafe_of_string s
in
349 let n = tempfailureretry
(Unix.write w
bytes 0) l in
354 "failed to write %d characters to sel pipe, wrote %d"
359 (Printf.sprintf
"failed to write to sel pipe: %s"
364 clo "selstring pipe/r" r
;
365 clo "selstring pipe/w" w
;
368 let undertext = function
371 | Ulinkgoto
(pageno
, _
) -> Printf.sprintf
"%s: page %d" state
.path
(pageno
+1)
372 | Utext s
-> "font: " ^ s
373 | Uunexpected s
-> "unexpected: " ^ s
374 | Ulaunch s
-> "launch: " ^ s
375 | Unamed s
-> "named: " ^ s
376 | Uremote
(filename
, pageno
) ->
377 Printf.sprintf
"%s: page %d" filename
(pageno
+1)
378 | Uremotedest
(filename
, destname
) ->
379 Printf.sprintf
"%s: destination %S" filename destname
380 | Uannotation
(opaque
, slinkindex
) ->
381 "annotation: " ^ getannotcontents opaque slinkindex
384 let updateunder x y =
385 match getunder x y with
386 | Unone
-> Wsi.setcursor
Wsi.CURSOR_INHERIT
388 if conf
.underinfo
then showtext 'u'
("ri: " ^ uri
);
389 Wsi.setcursor
Wsi.CURSOR_INFO
390 | Ulinkgoto
(pageno
, _
) ->
392 then showtext 'p'
("age: " ^ string_of_int
(pageno
+1));
393 Wsi.setcursor
Wsi.CURSOR_INFO
395 if conf
.underinfo
then showtext '
f'
("ont: " ^ s
);
396 Wsi.setcursor
Wsi.CURSOR_TEXT
398 if conf
.underinfo
then showtext 'u'
("nexpected: " ^ s
);
399 Wsi.setcursor
Wsi.CURSOR_INHERIT
401 if conf
.underinfo
then showtext '
l'
("aunch: " ^ s
);
402 Wsi.setcursor
Wsi.CURSOR_INHERIT
404 if conf
.underinfo
then showtext '
n'
("amed: " ^ s
);
405 Wsi.setcursor
Wsi.CURSOR_INHERIT
406 | Uremote
(filename
, pageno
) ->
407 if conf
.underinfo
then showtext 'r'
408 (Printf.sprintf
"emote: %s (%d)" filename
(pageno
+1));
409 Wsi.setcursor
Wsi.CURSOR_INFO
410 | Uremotedest
(filename
, destname
) ->
411 if conf
.underinfo
then showtext 'r'
412 (Printf.sprintf
"emote destination: %s (%S)" filename destname
);
413 Wsi.setcursor
Wsi.CURSOR_INFO
415 if conf
.underinfo
then showtext 'a'
"nnotation";
416 Wsi.setcursor
Wsi.CURSOR_INFO
419 let showlinktype under =
420 if conf
.underinfo
&& under != Unone
421 then showtext ' '
@@ undertext under
424 let intentry_with_suffix text key
=
426 if key
>= 32 && key
< 127
430 match Char.lowercase
c with
432 let text = addchar
text c in
436 let text = addchar
text c in
440 state
.text <- Printf.sprintf
"invalid char (%d, `%c')" key
c;
445 let s = Bytes.create
4 in
446 let n = tempfailureretry
(Unix.read fd
s 0) 4 in
447 if n != 4 then error
"incomplete read(len) = %d" n;
448 let len = (Char.code
(Bytes.get
s 0) lsl 24)
449 lor (Char.code
(Bytes.get
s 1) lsl 16)
450 lor (Char.code
(Bytes.get
s 2) lsl 8)
451 lor (Char.code
(Bytes.get
s 3))
453 let s = Bytes.create
len in
454 let n = tempfailureretry
(Unix.read fd
s 0) len in
455 if n != len then error
"incomplete read(data) %d vs %d" n len;
460 let b = Buffer.create
16 in
461 Buffer.add_string
b "llll";
464 let s = Buffer.to_bytes
b in
465 let n = Bytes.length
s in
467 (* dolog "wcmd %S" (String.sub s 4 len); *)
468 Bytes.set
s 0 (Char.chr
((len lsr 24) land 0xff));
469 Bytes.set
s 1 (Char.chr
((len lsr 16) land 0xff));
470 Bytes.set
s 2 (Char.chr
((len lsr 8) land 0xff));
471 Bytes.set
s 3 (Char.chr
(len land 0xff));
472 let n'
= tempfailureretry
(Unix.write state
.ss
s 0) n in
473 if n'
!= n then error
"write failed %d vs %d" n'
n;
477 let nogeomcmds cmds
=
479 | s, [] -> emptystr
s
483 let layoutN ((columns
, coverA
, coverB
), b) y sh
=
484 let sh = sh - (hscrollh ()) in
485 let wadj = wadjsb () in
486 let rec fold accu
n =
487 if n = Array.length
b
490 let pdimno, dx, vy
, (_
, w
, h
, xoff
) = b.(n) in
493 || n = state
.pagecount
- coverB
494 || (n - coverA
) mod columns
= columns
- 1)
500 let pagey = max
0 (y - vy
) in
501 let pagedispy = if pagey > 0 then 0 else vy
- y in
502 let pagedispx, pagex
=
504 if n = coverA
- 1 || n = state
.pagecount
- coverB
505 then state
.x + (wadj + state
.winw
- w
) / 2
506 else dx + xoff
+ state
.x
513 let vw = wadj + state
.winw
- pagedispx in
514 let pw = w
- pagex
in
517 let pagevh = min
(h
- pagey) (sh - pagedispy) in
518 if pagevw > 0 && pagevh > 0
529 ; pagedispx = pagedispx
530 ; pagedispy = pagedispy
542 if Array.length
b = 0
544 else List.rev
(fold [] (page_of_y
y))
547 let layoutS (columns
, b) y sh =
548 let sh = sh - hscrollh () in
549 let wadj = wadjsb () in
550 let rec fold accu n =
551 if n = Array.length
b
554 let pdimno, px, vy
, (_
, pagew
, pageh
, xoff
) = b.(n) in
561 let x = xoff
+ state
.x in
562 let pagey = max
0 (y - vy
) in
563 let pagedispy = if pagey > 0 then 0 else vy
- y in
564 let pagedispx, pagex
=
578 let pagecolw = pagew
/columns
in
580 if pagecolw < state
.winw
581 then pagedispx + ((wadj + state
.winw
- pagecolw) / 2)
585 let vw = wadj + state
.winw
- pagedispx in
586 let pw = pagew
- pagex
in
589 let pagevw = min
pagevw pagecolw in
590 let pagevh = min
(pageh
- pagey) (sh - pagedispy) in
591 if pagevw > 0 && pagevh > 0
602 ; pagedispx = pagedispx
603 ; pagedispy = pagedispy
604 ; pagecol
= n mod columns
619 if nogeomcmds state
.geomcmds
621 match conf
.columns
with
622 | Csingle
b -> layoutN ((1, 0, 0), b) y sh
623 | Cmulti
c -> layoutN c y sh
624 | Csplit
s -> layoutS s y sh
629 let y = state
.y + incr
in
631 let y = min
y (state
.maxy
- (if conf
.maxhfit
then state
.winh
else 0)) in
636 let tilex = l.pagex
mod conf
.tilew
in
637 let tiley = l.pagey mod conf
.tileh
in
639 let col = l.pagex
/ conf
.tilew
in
640 let row = l.pagey / conf
.tileh
in
642 let xadj = xadjsb () in
643 let rec rowloop row y0 dispy h
=
647 let dh = conf
.tileh
- y0 in
649 let rec colloop col x0 dispx w
=
653 let dw = conf
.tilew
- x0 in
655 let dispx'
= xadj + dispx in
656 f col row dispx' dispy
x0 y0 dw dh;
657 colloop (col+1) 0 (dispx+dw) (w
-dw)
660 colloop col tilex l.pagedispx l.pagevw;
661 rowloop (row+1) 0 (dispy
+dh) (h
-dh)
664 if l.pagevw > 0 && l.pagevh > 0
665 then rowloop row tiley l.pagedispy l.pagevh;
668 let gettileopaque l col row =
670 l.pageno
, state
.gen
, conf
.colorspace
, conf
.angle
, l.pagew
, l.pageh
, col, row
672 try Some
(Hashtbl.find state
.tilemap
key)
673 with Not_found
-> None
676 let puttileopaque l col row gen colorspace angle opaque size elapsed
=
677 let key = l.pageno
, gen
, colorspace
, angle
, l.pagew
, l.pageh
, col, row in
678 Hashtbl.add state
.tilemap
key (opaque
, size
, elapsed
)
681 let filledrect x0 y0 x1 y1 =
682 GlArray.disable `texture_coord
;
683 Raw.sets_float state
.vraw ~pos
:0 [| x0; y0; x0; y1; x1; y0; x1; y1 |];
684 GlArray.vertex `two state
.vraw
;
685 GlArray.draw_arrays `triangle_strip ~first
:0 ~count
:4;
686 GlArray.enable `texture_coord
;
689 let linerect x0 y0 x1 y1 =
690 GlArray.disable `texture_coord
;
691 Raw.sets_float state
.vraw ~pos
:0 [| x0; y0; x0; y1; x1; y1; x1; y0 |];
692 GlArray.vertex `two state
.vraw
;
693 GlArray.draw_arrays `line_loop ~first
:0 ~count
:4;
694 GlArray.enable `texture_coord
;
697 let drawtiles l color
=
699 let wadj = wadjsb () in
701 let f col row x y tilex tiley w h
=
702 match gettileopaque l col row with
703 | Some
(opaque
, _
, t
) ->
704 let params = x, y, w
, h
, tilex, tiley in
706 then GlTex.env
(`mode `blend
);
707 drawtile
params opaque
;
709 then GlTex.env
(`mode `modulate
);
713 let s = Printf.sprintf
717 let w = measurestr fstate
.fontsize
s in
718 GlDraw.color
(0.0, 0.0, 0.0);
719 filledrect (float (x-2))
722 (float (y + fstate
.fontsize
+ 2));
723 GlDraw.color
(1.0, 1.0, 1.0);
724 drawstring fstate
.fontsize
x (y + fstate
.fontsize
- 1) s;
734 let lw = wadj + state
.winw
- x in
737 let lh = state
.winh
- y in
741 then GlTex.env
(`mode `blend
);
742 begin match state
.checkerstexid
with
744 Gl.enable `texture_2d
;
745 GlTex.bind_texture ~target
:`texture_2d id
;
749 and y1 = float (y+h
) in
751 let tw = float w /. 16.0
752 and th
= float h
/. 16.0 in
753 let tx0 = float tilex /. 16.0
754 and ty0
= float tiley /. 16.0 in
756 and ty1
= ty0
+. th
in
757 Raw.sets_float state
.vraw ~pos
:0
758 [| x0; y0; x0; y1; x1; y0; x1; y1 |];
759 Raw.sets_float state
.traw ~pos
:0
760 [| tx0; ty0
; tx0; ty1
; tx1; ty0
; tx1; ty1
|];
761 GlArray.vertex `two state
.vraw
;
762 GlArray.tex_coord `two state
.traw
;
763 GlArray.draw_arrays `triangle_strip ~first
:0 ~count
:4;
764 Gl.disable `texture_2d
;
767 GlDraw.color
(1.0, 1.0, 1.0);
768 filledrect (float x) (float y) (float (x+w)) (float (y+h
));
771 then GlTex.env
(`mode `modulate
);
772 if w > 128 && h
> fstate
.fontsize
+ 10
774 let c = if conf
.invert
then 1.0 else 0.0 in
775 GlDraw.color
(c, c, c);
778 then (col*conf
.tilew
, row*conf
.tileh
)
781 drawstring2 fstate
.fontsize
x y "Loading %d [%d,%d]" l.pageno
c r
;
790 let pagevisible layout n = List.exists
(fun l -> l.pageno
= n) layout;;
792 let tilevisible1 l x y =
794 and ax1
= l.pagex
+ l.pagevw
796 and ay1
= l.pagey + l.pagevh in
800 let bx1 = min
(bx0 + conf
.tilew
) l.pagew
801 and by1
= min
(by0
+ conf
.tileh
) l.pageh
in
803 let rx0 = max
ax0 bx0
804 and ry0
= max ay0 by0
805 and rx1
= min ax1
bx1
806 and ry1
= min ay1 by1
in
808 let nonemptyintersection = rx1
> rx0 && ry1
> ry0
in
812 let tilevisible layout n x y =
813 let rec findpageinlayout m
= function
814 | l :: rest
when l.pageno
= n ->
815 tilevisible1 l x y || (
816 match conf
.columns
with
817 | Csplit
(c, _
) when c > m
-> findpageinlayout (m
+1) rest
822 | _
:: rest
-> findpageinlayout 0 rest
825 findpageinlayout 0 layout;
828 let tileready l x y =
829 tilevisible1 l x y &&
830 gettileopaque l (x/conf
.tilew
) (y/conf
.tileh
) != None
833 let tilepage n p
layout =
834 let rec loop = function
838 let f col row _ _ _ _ _ _
=
839 if state
.currently
= Idle
841 match gettileopaque l col row with
844 let x = col*conf
.tilew
845 and y = row*conf
.tileh
in
847 let w = l.pagew
- x in
851 let h = l.pageh
- y in
856 then getpbo
w h conf
.colorspace
859 wcmd "tile %s %d %d %d %d %s"
860 (~
> p
) x y w h (~
> pbo);
863 l, p
, conf
.colorspace
, conf
.angle
,
864 state
.gen
, col, row, conf
.tilew
, conf
.tileh
873 if nogeomcmds state
.geomcmds
877 let preloadlayout y =
878 let y = if y < state
.winh
then 0 else y - state
.winh
in
879 let h = state
.winh
*3 in
885 if state
.currently
!= Idle
890 begin match getopaque l.pageno
with
892 wcmd "page %d %d" l.pageno
l.pagedimno
;
893 state
.currently
<- Loading
(l, state
.gen
);
895 tilepage l.pageno opaque pages
;
900 if nogeomcmds state
.geomcmds
906 if conf
.preload && state
.currently
= Idle
907 then load (preloadlayout state
.y);
910 let layoutready layout =
911 let rec fold all ls
=
914 let seen = ref false in
915 let allvisible = ref true in
916 let foo col row _ _ _ _ _ _
=
918 allvisible := !allvisible &&
919 begin match gettileopaque l col row with
925 fold (!seen && !allvisible) rest
928 let alltilesvisible = fold true layout in
933 let y = bound
y 0 state
.maxy
in
934 let y, layout, proceed
=
935 match conf
.maxwait
with
936 | Some time
when state
.ghyll
== noghyll
->
937 begin match state
.throttle
with
939 let layout = layout y state
.winh
in
940 let ready = layoutready layout in
944 state
.throttle
<- Some
(layout, y, now
());
946 else G.postRedisplay "gotoy showall (None)";
948 | Some
(_
, _
, started
) ->
949 let dt = now
() -. started
in
952 state
.throttle
<- None
;
953 let layout = layout y state
.winh
in
955 G.postRedisplay "maxwait";
962 let layout = layout y state
.winh
in
963 if not
!wtmode || layoutready layout
964 then G.postRedisplay "gotoy ready";
970 state
.layout <- layout;
971 begin match state
.mode
with
974 | Ltexact
(pageno
, linkno
) ->
975 let rec loop = function
977 state
.mode
<- LinkNav
(Ltgendir
0)
978 | l :: _
when l.pageno
= pageno
->
979 begin match getopaque pageno
with
980 | None
-> state
.mode
<- LinkNav
(Ltnotready
(pageno
, 0))
982 let x0, y0, x1, y1 = getlinkrect opaque linkno
in
983 if not
(x0 >= l.pagex
&& x1 <= l.pagex
+ l.pagevw
984 && y0 >= l.pagey && y1 <= l.pagey + l.pagevh)
985 then state
.mode
<- LinkNav
(Ltgendir
0)
987 | _
:: rest
-> loop rest
990 | Ltnotready _
| Ltgendir _
-> ()
996 begin match state
.mode
with
997 | Birdseye
(conf
, leftx
, pageno
, hooverpageno
, anchor
) ->
998 if not
(pagevisible layout pageno
)
1000 match state
.layout with
1003 state
.mode
<- Birdseye
(
1004 conf
, leftx
, l.pageno
, hooverpageno
, anchor
1009 | Ltnotready
(_
, dir
)
1012 let rec loop = function
1015 match getopaque l.pageno
with
1016 | None
-> Ltnotready
(l.pageno
, dir
)
1021 then LDfirstvisible
(l.pagex
, l.pagey, dir
)
1023 if dir
> 0 then LDfirst
else LDlast
1029 | Lnotfound
-> loop rest
1031 showlinktype (getlink opaque
n);
1032 Ltexact
(l.pageno
, n)
1036 state
.mode
<- LinkNav
linknav
1044 state
.ghyll
<- noghyll
;
1047 let mx, my
= state
.mpos
in
1052 let conttiling pageno opaque
=
1053 tilepage pageno opaque
1054 (if conf
.preload then preloadlayout state
.y else state
.layout)
1057 let gotoy_and_clear_text y =
1058 if not conf
.verbose
then state
.text <- E.s;
1062 let getanchory (n, top
, dtop
) =
1063 let y, h = getpageyh
n in
1064 if conf
.presentation
1066 let ips = calcips
h in
1067 y + truncate
(top
*.float h -. dtop
*.float ips) + ips;
1069 y + truncate
(top
*.float h -. dtop
*.float conf
.interpagespace
)
1072 let gotoanchor anchor
=
1073 gotoy (getanchory anchor
);
1077 cbput state
.hists
.nav
(getanchor
());
1081 let anchor = cbgetc state
.hists
.nav dir
in
1085 let gotoghyll1 single
y =
1086 let scroll f n a
b =
1087 (* http://devmaster.net/forums/topic/9796-ease-in-ease-out-algorithm/ *)
1089 let s x = 3.0*.x**2.0 -. 2.0*.x**3.0 in
1091 then s (float f /. float a
)
1094 then 1.0 -. s ((float (f-b) /. float (n-b)))
1100 let ins = float a
*. 0.5
1101 and outs
= float (n-b) *. 0.5 in
1103 ins +. outs
+. float ones
1105 let rec set nab
y sy
=
1106 let (_N
, _A
, _B
), y =
1109 let scl = if y > sy
then 2 else -2 in
1110 let _N, _
, _
= nab
in
1111 (_N,0,_N), y+conf
.scrollstep
*scl
1113 let sum = summa
_N _A _B
in
1114 let dy = float (y - sy
) in
1118 then state
.ghyll
<- noghyll
1121 let s = scroll n _N _A _B
in
1122 let y1 = y1 +. ((s *. dy) /. sum) in
1123 gotoy_and_clear_text (truncate
y1);
1124 state
.ghyll
<- gf (n+1) y1;
1128 | Some
y'
when single
-> set nab
y' state
.y
1129 | Some
y'
-> set (_N/2, 1, 1) y' state
.y
1131 gf 0 (float state
.y)
1134 match conf
.ghyllscroll
with
1135 | Some nab
when not conf
.presentation
->
1136 if state
.ghyll
== noghyll
1137 then set nab
y state
.y
1138 else state
.ghyll
(Some
y)
1140 gotoy_and_clear_text y
1143 let gotoghyll = gotoghyll1 false;;
1145 let gotopage n top
=
1146 let y, h = getpageyh
n in
1147 let y = y + (truncate
(top
*. float h)) in
1151 let gotopage1 n top
=
1152 let y = getpagey
n in
1157 let invalidate s f =
1162 match state
.geomcmds
with
1163 | ps
, [] when emptystr ps
->
1165 state
.geomcmds
<- s, [];
1168 state
.geomcmds
<- ps
, [s, f];
1170 | ps
, (s'
, _
) :: rest
when s'
= s ->
1171 state
.geomcmds
<- ps
, ((s, f) :: rest
);
1174 state
.geomcmds
<- ps
, ((s, f) :: cmds
);
1178 Hashtbl.iter
(fun _ opaque
->
1179 wcmd "freepage %s" (~
> opaque
);
1181 Hashtbl.clear state
.pagemap
;
1185 if not
(Queue.is_empty state
.tilelru
)
1187 Queue.iter
(fun (k
, p
, s) ->
1188 wcmd "freetile %s" (~
> p
);
1189 state
.memused
<- state
.memused
- s;
1190 Hashtbl.remove state
.tilemap k
;
1192 state
.uioh#infochanged Memused
;
1193 Queue.clear state
.tilelru
;
1199 let h = truncate
(float h*.conf
.zoom
) in
1200 let d = conf
.interpagespace
lsl (if conf
.presentation
then 1 else 0) in
1204 let opendoc path password
=
1206 state
.password
<- password
;
1207 state
.gen
<- state
.gen
+ 1;
1208 state
.docinfo
<- [];
1209 state
.outlines
<- [||];
1212 setaalevel conf
.aalevel
;
1214 if emptystr state
.origin
1218 Wsi.settitle
("llpp " ^
(mbtoutf8
(Filename.basename
titlepath)));
1219 wcmd "open %d %d %s\000%s\000" (btod
!wtmode) (btod
!cxack) path password
;
1220 invalidate "reqlayout"
1222 wcmd "reqlayout %d %d %d %s\000"
1223 conf
.angle
(FMTE.to_int conf
.fitmodel
)
1224 (stateh state
.winh
) state
.nameddest
1229 state
.anchor <- getanchor
();
1230 opendoc state
.path state
.password
;
1234 let c = c *. conf
.colorscale
in
1238 let scalecolor2 (r
, g, b) =
1239 (r
*. conf
.colorscale
, g *. conf
.colorscale
, b *. conf
.colorscale
);
1242 let docolumns columns
=
1243 let wadj = wadjsb () in
1246 let a = Array.make state
.pagecount
(-1, -1, -1, (-1, -1, -1, -1)) in
1247 let wadj = wadjsb () in
1248 let rec loop pageno
pdimno pdim
y ph pdims
=
1249 if pageno
= state
.pagecount
1252 let pdimno, ((_
, w, h, xoff
) as pdim
), pdims
=
1254 | ((pageno'
, _
, _
, _
) as pdim
) :: rest
when pageno'
= pageno
->
1255 pdimno+1, pdim
, rest
1259 let x = max
0 (((wadj + state
.winw
- w) / 2) - xoff
) in
1261 (if conf
.presentation
1262 then (if pageno
= 0 then calcips
h else calcips ph
+ calcips
h)
1263 else (if pageno
= 0 then 0 else conf
.interpagespace
)
1266 a.(pageno
) <- (pdimno, x, y, pdim
);
1267 loop (pageno
+1) pdimno pdim
(y + h) h pdims
1269 loop 0 ~
-1 (-1,-1,-1,-1) 0 0 state
.pdims
;
1270 conf
.columns
<- Csingle
a;
1272 | Cmulti
((columns
, coverA
, coverB
), _
) ->
1273 let a = Array.make state
.pagecount
(-1, -1, -1, (-1, -1, -1, -1)) in
1274 let rec loop pageno
pdimno pdim
x y rowh pdims
=
1275 let rec fixrow m
= if m
= pageno
then () else
1276 let (pdimno, x, y, ((_
, _
, h, _
) as pdim
)) = a.(m
) in
1279 let y = y + (rowh
- h) / 2 in
1280 a.(m
) <- (pdimno, x, y, pdim
);
1284 if pageno
= state
.pagecount
1285 then fixrow (((pageno
- 1) / columns
) * columns
)
1287 let pdimno, ((_
, w, h, xoff
) as pdim
), pdims
=
1289 | ((pageno'
, _
, _
, _
) as pdim
) :: rest
when pageno'
= pageno
->
1290 pdimno+1, pdim
, rest
1295 if pageno
= coverA
- 1 || pageno
= state
.pagecount
- coverB
1297 let x = (wadj + state
.winw
- w) / 2 in
1299 if conf
.presentation
then calcips
h else conf
.interpagespace
in
1300 x, y + ips + rowh
, h
1303 if (pageno
- coverA
) mod columns
= 0
1305 let x = max
0 (wadj + state
.winw
- state
.w) / 2 in
1307 if conf
.presentation
1309 let ips = calcips
h in
1310 y + (if pageno
= 0 then 0 else calcips rowh
+ ips)
1312 y + (if pageno
= 0 then 0 else conf
.interpagespace
)
1316 else x, y, max rowh
h
1320 if pageno
> 1 && (pageno
- coverA
) mod columns
= 0
1323 if pageno
= columns
&& conf
.presentation
1325 let ips = calcips rowh
in
1326 for i
= 0 to pred columns
1328 let (pdimno, x, y, pdim
) = a.(i
) in
1329 a.(i
) <- (pdimno, x, y+ips, pdim
)
1335 fixrow (pageno
- columns
);
1340 a.(pageno
) <- (pdimno, x, y, pdim
);
1341 let x = x + w + xoff
*2 + conf
.interpagespace
in
1342 loop (pageno
+1) pdimno pdim
x y rowh' pdims
1344 loop 0 ~
-1 (-1,-1,-1,-1) 0 0 0 state
.pdims
;
1345 conf
.columns
<- Cmulti
((columns
, coverA
, coverB
), a);
1348 let a = Array.make
(state
.pagecount
*c) (-1, -1, -1, (-1, -1, -1, -1)) in
1349 let rec loop pageno
pdimno pdim
y pdims
=
1350 if pageno
= state
.pagecount
1353 let pdimno, ((_
, w, h, _
) as pdim
), pdims
=
1355 | ((pageno'
, _
, _
, _
) as pdim
) :: rest
when pageno'
= pageno
->
1356 pdimno+1, pdim
, rest
1361 let rec loop1 n x y =
1362 if n = c then y else (
1363 a.(pageno
*c + n) <- (pdimno, x, y, pdim
);
1364 loop1 (n+1) (x+cw) (y + h + conf
.interpagespace
)
1367 let y = loop1 0 0 y in
1368 loop (pageno
+1) pdimno pdim
y pdims
1370 loop 0 ~
-1 (-1,-1,-1,-1) 0 state
.pdims
;
1371 conf
.columns
<- Csplit
(c, a);
1375 docolumns conf
.columns
;
1376 state
.maxy
<- calcheight
();
1377 if state
.reprf
== noreprf
1379 match state
.mode
with
1380 | Birdseye
(_
, _
, pageno
, _
, _
) ->
1381 let y, h = getpageyh pageno
in
1382 let top = (state
.winh
- h) / 2 in
1383 gotoy (max
0 (y - top))
1386 | LinkNav _
-> gotoanchor state
.anchor
1390 state
.reprf
<- noreprf
;
1395 GlDraw.viewport ~
x:0 ~
y:0 ~
w:w ~
h:h;
1396 let firsttime = state
.geomcmds
== firstgeomcmds
in
1397 if not
firsttime && nogeomcmds state
.geomcmds
1398 then state
.anchor <- getanchor
();
1401 let w = wadjsb () + (truncate
(float w *. conf
.zoom
)) in
1404 setfontsize fstate
.fontsize
;
1405 GlMat.mode `modelview
;
1406 GlMat.load_identity
();
1408 GlMat.mode `projection
;
1409 GlMat.load_identity
();
1410 GlMat.rotate ~
x:1.0 ~angle
:180.0 ();
1411 GlMat.translate ~
x:~
-.1.0 ~
y:~
-.1.0 ();
1412 GlMat.scale3
(2.0 /. float state
.winw
, 2.0 /. float state
.winh
, 1.0);
1417 else float state
.x /. float state
.w
1419 invalidate "geometry"
1423 then state
.x <- truncate
(relx *. float w);
1425 match conf
.columns
with
1427 | Cmulti
((c, _
, _
), _
) -> (w - (c-1)*conf
.interpagespace
) / c
1428 | Csplit
(c, _
) -> w * c
1430 wcmd "geometry %d %d %d"
1431 w (stateh h) (FMTE.to_int conf
.fitmodel
)
1436 let len = String.length state
.text in
1437 let x0 = xadjsb () in
1440 match state
.mode
with
1441 | Textentry _
| View
| LinkNav _
->
1442 let h, _
, _
= state
.uioh#scrollpw
in
1447 filledrect x (float (state
.winh
- (fstate
.fontsize
+ 4) - hscrollh))
1448 (x+.w) (float (state
.winh
- hscrollh))
1451 let w = float (wadjsb () + state
.winw
- 1) in
1452 if state
.progress
>= 0.0 && state
.progress
< 1.0
1454 GlDraw.color
(0.3, 0.3, 0.3);
1455 let w1 = w *. state
.progress
in
1457 GlDraw.color
(0.0, 0.0, 0.0);
1458 rect (float x0+.w1) (float x0+.w-.w1)
1461 GlDraw.color
(0.0, 0.0, 0.0);
1465 GlDraw.color
(1.0, 1.0, 1.0);
1466 drawstring fstate
.fontsize
1467 (if conf
.leftscroll
then x0 + 2 else x0 + if len > 0 then 8 else 2)
1468 (state
.winh
- hscrollh - 5) s;
1471 match state
.mode
with
1472 | Textentry
((prefix
, text, _
, _
, _
, _
), _
) ->
1476 Printf.sprintf
"%s%s_ [%s]" prefix
text state
.text
1478 Printf.sprintf
"%s%s_" prefix
text
1484 | LinkNav _
-> state
.text
1489 if not
(istextentry state
.mode
) && state
.uioh#eformsgs
1491 let s1 = "(press 'e' to review error messasges)" in
1492 if nonemptystr
s then s ^
" " ^
s1 else s1
1502 let len = Queue.length state
.tilelru
in
1504 match state
.throttle
with
1507 then preloadlayout state
.y
1509 | Some
(layout, _
, _
) ->
1513 if state
.memused
<= conf
.memlimit
1518 let (k
, p
, s) as lruitem
= Queue.pop state
.tilelru
in
1519 let n, gen
, colorspace
, angle
, pagew
, pageh
, col, row = k
in
1520 let (_
, pw, ph
, _
) = getpagedim
n in
1523 && colorspace
= conf
.colorspace
1524 && angle
= conf
.angle
1528 let x = col*conf
.tilew
1529 and y = row*conf
.tileh
in
1530 tilevisible (Lazy.force_val
layout) n x y
1532 then Queue.push lruitem state
.tilelru
1535 wcmd "freetile %s" (~
> p
);
1536 state
.memused
<- state
.memused
- s;
1537 state
.uioh#infochanged Memused
;
1538 Hashtbl.remove state
.tilemap k
;
1546 let onpagerect pageno
f =
1548 match conf
.columns
with
1549 | Cmulti
(_
, b) -> b
1551 | Csplit
(_
, b) -> b
1553 if pageno
>= 0 && pageno
< Array.length
b
1555 let (_
, _
, _
, (w, h, _
, _
)) = b.(pageno
) in
1559 let gotopagexy1 pageno
x y =
1560 let _,w1,h1
,leftx
= getpagedim pageno
in
1561 let top = y /. (float h1
) in
1562 let left = x /. (float w1) in
1563 let py, w, h = getpageywh pageno
in
1564 let wh = state
.winh
- hscrollh () in
1565 let x = left *. (float w) in
1566 let x = leftx
+ state
.x + truncate
x in
1567 let wadj = wadjsb () in
1569 if x < 0 || x >= wadj + state
.winw
1573 let pdy = truncate
(top *. float h) in
1574 let y'
= py + pdy in
1575 let dy = y'
- state
.y in
1577 if x != state
.x || not
(dy > 0 && dy < wh)
1579 if conf
.presentation
1581 if abs
(py - y'
) > wh
1588 if state
.x != sx || state
.y != sy
1593 let ww = wadj + state
.winw
in
1595 and qy
= pdy / wh in
1597 and y = py + qy
* wh in
1598 let x = if -x + ww > w1 then -(w1-ww) else x
1599 and y'
= if y + wh > state
.maxy
then state
.maxy
- wh else y in
1601 if conf
.presentation
1603 if abs
(py - y'
) > wh
1613 gotoy_and_clear_text y;
1615 else gotoy_and_clear_text state
.y;
1618 let gotopagexy pageno
x y =
1619 match state
.mode
with
1620 | Birdseye
_ -> gotopage pageno
0.0
1623 | LinkNav
_ -> gotopagexy1 pageno
x y
1626 let getpassword () =
1627 let passcmd = getenvwithdef
"LLPP_ASKPASS" conf
.passcmd in
1631 match Unix.open_process_in
passcmd with
1632 | (exception exn
) ->
1635 "getpassword: open_process_in failed: %s" (exntos exn
));
1638 let s = try input_line ic
with End_of_file
-> E.s in
1640 match Unix.close_process_in ic
with
1641 | (exception exn
) ->
1643 (Printf.sprintf
"getpassword: close_process_in failed: %s"
1652 (* dolog "%S" cmds; *)
1653 let cl = splitatspace cmds
in
1655 try Scanf.sscanf
s fmt
f
1657 dolog
"error processing '%S': %s" cmds
(exntos exn
);
1660 let addoutline outline
=
1661 match state
.currently
with
1662 | Outlining outlines
->
1663 state
.currently
<- Outlining
(outline
:: outlines
)
1664 | Idle
-> state
.currently
<- Outlining
[outline
]
1667 dolog
"invalid outlining state";
1668 logcurrently state
.currently
1672 state
.uioh#infochanged Pdim
;
1675 | "clearrects" :: [] ->
1676 state
.rects
<- state
.rects1
;
1677 G.postRedisplay "clearrects";
1679 | "continue" :: args
:: [] ->
1680 let n = scan args
"%u" (fun n -> n) in
1681 state
.pagecount
<- n;
1682 begin match state
.currently
with
1684 state
.currently
<- Idle
;
1685 state
.outlines
<- Array.of_list
(List.rev
l)
1691 let cur, cmds
= state
.geomcmds
in
1693 then failwith
"umpossible";
1695 begin match List.rev cmds
with
1697 state
.geomcmds
<- E.s, [];
1698 state
.throttle
<- None
;
1702 state
.geomcmds
<- s, List.rev rest
;
1704 if conf
.maxwait
= None
&& not
!wtmode
1705 then G.postRedisplay "continue";
1707 | "msg" :: args
:: [] ->
1710 | "vmsg" :: args
:: [] ->
1712 then showtext ' ' args
1714 | "emsg" :: args
:: [] ->
1715 Buffer.add_string state
.errmsgs args
;
1716 state
.newerrmsgs
<- true;
1717 G.postRedisplay "error message"
1719 | "progress" :: args
:: [] ->
1720 let progress, text =
1723 f, String.sub args pos
(String.length args
- pos
))
1726 state
.progress <- progress;
1727 G.postRedisplay "progress"
1729 | "firstmatch" :: args
:: [] ->
1730 let pageno, c, x0, y0, x1, y1, x2
, y2
, x3
, y3
=
1731 scan args
"%u %d %f %f %f %f %f %f %f %f"
1732 (fun p
c x0 y0 x1 y1 x2 y2 x3 y3
->
1733 (p
, c, x0, y0, x1, y1, x2
, y2
, x3
, y3
))
1735 let xoff = float (xadjsb ()) in
1739 and x3
= x3
+. xoff in
1740 let y = (getpagey
pageno) + truncate
y0 in
1743 state
.rects1
<- [pageno, c, (x0, y0, x1, y1, x2
, y2
, x3
, y3
)]
1745 | "match" :: args
:: [] ->
1746 let pageno, c, x0, y0, x1, y1, x2
, y2
, x3
, y3
=
1747 scan args
"%u %d %f %f %f %f %f %f %f %f"
1748 (fun p
c x0 y0 x1 y1 x2 y2 x3 y3
->
1749 (p
, c, x0, y0, x1, y1, x2
, y2
, x3
, y3
))
1751 let xoff = float (xadjsb ()) in
1755 and x3
= x3
+. xoff in
1757 (pageno, c, (x0, y0, x1, y1, x2
, y2
, x3
, y3
)) :: state
.rects1
1759 | "page" :: args
:: [] ->
1760 let pageopaques, t
= scan args
"%s %f" (fun p t
-> p
, t
) in
1761 let pageopaque = ~
< pageopaques in
1762 begin match state
.currently
with
1763 | Loading
(l, gen
) ->
1764 vlog "page %d took %f sec" l.pageno t
;
1765 Hashtbl.replace state
.pagemap
(l.pageno, gen
) pageopaque;
1766 begin match state
.throttle
with
1768 let preloadedpages =
1770 then preloadlayout state
.y
1775 List.fold_left
(fun s l -> IntSet.add
l.pageno s)
1776 IntSet.empty
preloadedpages
1779 Hashtbl.fold (fun ((pageno, _) as key) opaque
accu ->
1780 if not
(IntSet.mem
pageno set)
1782 wcmd "freepage %s" (~
> opaque
);
1788 List.iter
(Hashtbl.remove state
.pagemap
) evictedpages;
1791 state
.currently
<- Idle
;
1794 tilepage l.pageno pageopaque state
.layout;
1796 load preloadedpages;
1797 let visible = pagevisible state
.layout l.pageno in
1800 match state
.mode
with
1801 | LinkNav
(Ltnotready
(pageno, dir
)) ->
1802 if pageno = l.pageno
1807 then LDfirstvisible
(l.pagex
, l.pagey, dir
)
1809 if dir
> 0 then LDfirst
else LDlast
1812 findlink
pageopaque ld
1817 showlinktype (getlink
pageopaque n);
1818 state
.mode
<- LinkNav
(Ltexact
(l.pageno, n))
1820 | LinkNav
(Ltgendir
_)
1821 | LinkNav
(Ltexact
_)
1827 if visible && layoutready state
.layout
1829 G.postRedisplay "page";
1833 | Some
(layout, _, _) ->
1834 state
.currently
<- Idle
;
1835 tilepage l.pageno pageopaque layout;
1842 dolog
"Inconsistent loading state";
1843 logcurrently state
.currently
;
1847 | "tile" :: args
:: [] ->
1848 let (x, y, opaques
, size
, t
) =
1849 scan args
"%u %u %s %u %f"
1850 (fun x y p size t
-> (x, y, p
, size
, t
))
1852 let opaque = ~
< opaques
in
1853 begin match state
.currently
with
1854 | Tiling
(l, pageopaque, cs
, angle
, gen
, col, row, tilew
, tileh
) ->
1855 vlog "tile %d [%d,%d] took %f sec" l.pageno col row t
;
1858 if tilew
!= conf
.tilew
|| tileh
!= conf
.tileh
1860 wcmd "freetile %s" (~
> opaque);
1861 state
.currently
<- Idle
;
1865 puttileopaque l col row gen cs angle
opaque size t
;
1866 state
.memused
<- state
.memused
+ size
;
1867 state
.uioh#infochanged Memused
;
1869 Queue.push
((l.pageno, gen
, cs
, angle
, l.pagew
, l.pageh
, col, row),
1870 opaque, size
) state
.tilelru
;
1873 match state
.throttle
with
1874 | None
-> state
.layout
1875 | Some
(layout, _, _) -> layout
1878 state
.currently
<- Idle
;
1880 && conf
.colorspace
= cs
1881 && conf
.angle
= angle
1882 && tilevisible layout l.pageno x y
1883 then conttiling l.pageno pageopaque;
1885 begin match state
.throttle
with
1887 preload state
.layout;
1889 && conf
.colorspace
= cs
1890 && conf
.angle
= angle
1891 && tilevisible state
.layout l.pageno x y
1892 && (not
!wtmode || layoutready state
.layout)
1893 then G.postRedisplay "tile nothrottle";
1895 | Some
(layout, y, _) ->
1896 let ready = layoutready layout in
1900 state
.layout <- layout;
1901 state
.throttle
<- None
;
1902 G.postRedisplay "throttle";
1911 dolog
"Inconsistent tiling state";
1912 logcurrently state
.currently
;
1916 | "pdim" :: args
:: [] ->
1917 let (n, w, h, _) as pdim
=
1918 scan args
"%u %u %u %u" (fun n w h x -> n, w, h, x)
1921 match conf
.fitmodel
with
1923 | FitPage
| FitProportional
->
1924 match conf
.columns
with
1925 | Csplit
_ -> (n, w, h, 0)
1926 | Csingle
_ | Cmulti
_ -> pdim
1928 state
.uioh#infochanged Pdim
;
1929 state
.pdims
<- pdim :: state
.pdims
1931 | "o" :: args
:: [] ->
1932 let (l, n, t
, h, pos
) =
1933 scan args
"%u %u %d %u %n"
1934 (fun l n t
h pos
-> l, n, t
, h, pos
)
1936 let s = String.sub args pos
(String.length args
- pos
) in
1937 addoutline (s, l, Oanchor
(n, float t
/. float h, 0.0))
1939 | "ou" :: args
:: [] ->
1940 let (l, len, pos
) = scan args
"%u %u %n" (fun l len pos
-> l, len, pos
) in
1941 let s = String.sub args pos
len in
1942 let pos2 = pos
+ len + 1 in
1943 let uri = String.sub args
pos2 (String.length args
- pos2) in
1944 addoutline (s, l, Ouri
uri)
1946 | "on" :: args
:: [] ->
1947 let (l, pos
) = scan args
"%u %n" (fun l pos
-> l, pos
) in
1948 let s = String.sub args pos
(String.length args
- pos
) in
1949 addoutline (s, l, Onone
)
1951 | "a" :: args
:: [] ->
1953 scan args
"%u %d %d" (fun n l t
-> n, l, t
)
1955 state
.reprf
<- (fun () -> gotopagexy n (float l) (float t
))
1957 | "info" :: args
:: [] ->
1958 let pos = nindex args '
\t'
in
1959 if pos >= 0 && String.sub args
0 pos = "Title"
1961 let s = String.sub args
(pos+1) @@ String.length args
- pos - 1 in
1964 state
.docinfo
<- (1, args
) :: state
.docinfo
1966 | "infoend" :: [] ->
1967 state
.uioh#infochanged Docinfo
;
1968 state
.docinfo
<- List.rev state
.docinfo
1972 then Wsi.settitle
"Wrong password";
1973 let password = getpassword () in
1975 then error
"document is password protected"
1976 else opendoc state
.path
password
1979 error
"unknown cmd `%S'" cmds
1984 let action = function
1985 | HCprev
-> cbget cb ~
-1
1986 | HCnext
-> cbget cb
1
1987 | HCfirst
-> cbget cb ~
-(cb
.rc)
1988 | HClast
-> cbget cb
(cb
.len - 1 - cb
.rc)
1989 and cancel
() = cb
.rc <- rc
1993 let search pattern forward
=
1994 match conf
.columns
with
1996 showtext '
!'
"searching does not work properly in split columns mode"
1999 if nonemptystr pattern
2002 match state
.layout with
2005 l.pageno, (l.pagey + if forward
then 0 else 0*l.pagevh)
2007 wcmd "search %d %d %d %d,%s\000"
2008 (btod conf
.icase
) pn py (btod forward
) pattern
;
2011 let intentry 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;
2027 let linknentry text key =
2029 if key >= 32 && key < 127
2035 let text = addchar
text c in
2039 state
.text <- Printf.sprintf
"invalid char (%d, `%c')" key c;
2047 let l = String.length
s in
2048 let rec loop pos n = if pos = l then n else
2049 let m = Char.code
s.[pos] - (if pos = 0 && l > 1 then 96 else 97) in
2050 loop (pos+1) (n*26 + m)
2053 let rec loop n = function
2056 match getopaque l.pageno with
2057 | None
-> loop n rest
2059 let m = getlinkcount
opaque in
2062 let under = getlink
opaque n in
2065 else loop (n-m) rest
2067 loop n state
.layout;
2071 let textentry text key =
2072 if key land 0xff00 = 0xff00
2074 else TEcont
(text ^ toutf8
key)
2077 let reqlayout angle fitmodel
=
2078 match state
.throttle
with
2080 if nogeomcmds state
.geomcmds
2081 then state
.anchor <- getanchor
();
2082 conf
.angle
<- angle
mod 360;
2085 match state
.mode
with
2086 | LinkNav
_ -> state
.mode
<- View
2091 conf
.fitmodel
<- fitmodel
;
2092 invalidate "reqlayout"
2094 wcmd "reqlayout %d %d %d"
2095 conf
.angle
(FMTE.to_int conf
.fitmodel
) (stateh state
.winh
)
2100 let settrim trimmargins trimfuzz
=
2101 if nogeomcmds state
.geomcmds
2102 then state
.anchor <- getanchor
();
2103 conf
.trimmargins
<- trimmargins
;
2104 conf
.trimfuzz
<- trimfuzz
;
2105 let x0, y0, x1, y1 = trimfuzz
in
2106 invalidate "settrim"
2108 wcmd "settrim %d %d %d %d %d" (btod conf
.trimmargins
) x0 y0 x1 y1);
2113 match state
.throttle
with
2115 let zoom = max
0.0001 zoom in
2116 if zoom <> conf
.zoom
2118 state
.prevzoom
<- (conf
.zoom, state
.x);
2120 reshape state
.winw state
.winh
;
2121 state
.text <- Printf.sprintf
"zoom is now %-5.2f" (zoom *. 100.0);
2124 | Some
(layout, y, started
) ->
2126 match conf
.maxwait
with
2130 let dt = now
() -. started
in
2138 let setcolumns mode columns coverA coverB
=
2139 state
.prevcolumns
<- Some
(conf
.columns
, conf
.zoom);
2143 then showtext '
!'
"split mode doesn't work in bird's eye"
2145 conf
.columns
<- Csplit
(-columns
, E.a);
2153 conf
.columns
<- Csingle
E.a;
2158 conf
.columns
<- Cmulti
((columns
, coverA
, coverB
), E.a);
2162 reshape state
.winw state
.winh
;
2165 let resetmstate () =
2166 state
.mstate
<- Mnone
;
2167 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
2170 let enterbirdseye () =
2171 let zoom = float conf
.thumbw
/. float state
.winw
in
2172 let birdseyepageno =
2173 let cy = state
.winh
/ 2 in
2177 let rec fold best
= function
2180 let d = cy - (l.pagedispy + l.pagevh/2)
2181 and dbest
= cy - (best
.pagedispy + best
.pagevh/2) in
2182 if abs
d < abs dbest
2189 state
.mode
<- Birdseye
(
2190 { conf
with zoom = conf
.zoom }, state
.x, birdseyepageno, -1, getanchor
()
2194 conf
.presentation
<- false;
2195 conf
.interpagespace
<- 10;
2196 conf
.hlinks
<- false;
2197 conf
.fitmodel
<- FitPage
;
2199 conf
.maxwait
<- None
;
2201 match conf
.beyecolumns
with
2204 Cmulti
((c, 0, 0), E.a)
2205 | None
-> Csingle
E.a
2209 state
.text <- Printf.sprintf
"birds eye mode on (zoom %3.1f%%)"
2214 reshape state
.winw state
.winh
;
2217 let leavebirdseye (c, leftx
, pageno, _, anchor) goback
=
2219 conf
.zoom <- c.zoom;
2220 conf
.presentation
<- c.presentation
;
2221 conf
.interpagespace
<- c.interpagespace
;
2222 conf
.maxwait
<- c.maxwait
;
2223 conf
.hlinks
<- c.hlinks
;
2224 conf
.fitmodel
<- c.fitmodel
;
2225 conf
.beyecolumns
<- (
2226 match conf
.columns
with
2227 | Cmulti
((c, _, _), _) -> Some
c
2229 | Csplit
_ -> failwith
"leaving bird's eye split mode"
2232 match c.columns
with
2233 | Cmulti
(c, _) -> Cmulti
(c, E.a)
2234 | Csingle
_ -> Csingle
E.a
2235 | Csplit
(c, _) -> Csplit
(c, E.a)
2239 state
.text <- Printf.sprintf
"birds eye mode off (zoom %3.1f%%)"
2242 reshape state
.winw state
.winh
;
2243 state
.anchor <- if goback
then anchor else (pageno, 0.0, 1.0);
2247 let togglebirdseye () =
2248 match state
.mode
with
2249 | Birdseye vals
-> leavebirdseye vals
true
2250 | View
-> enterbirdseye ()
2255 let upbirdseye incr
(conf
, leftx
, pageno, hooverpageno
, anchor) =
2256 let pageno = max
0 (pageno - incr
) in
2257 let rec loop = function
2258 | [] -> gotopage1 pageno 0
2259 | l :: _ when l.pageno = pageno ->
2260 if l.pagedispy >= 0 && l.pagey = 0
2261 then G.postRedisplay "upbirdseye"
2262 else gotopage1 pageno 0
2263 | _ :: rest
-> loop rest
2267 state
.mode
<- Birdseye
(conf
, leftx
, pageno, hooverpageno
, anchor)
2270 let downbirdseye incr
(conf
, leftx
, pageno, hooverpageno
, anchor) =
2271 let pageno = min
(state
.pagecount
- 1) (pageno + incr
) in
2272 state
.mode
<- Birdseye
(conf
, leftx
, pageno, hooverpageno
, anchor);
2273 let rec loop = function
2275 let y, h = getpageyh
pageno in
2276 let dy = (y - state
.y) - (state
.winh
- h - conf
.interpagespace
) in
2278 | l :: _ when l.pageno = pageno ->
2279 if l.pagevh != l.pageh
2280 then gotoy (clamp (l.pageh
- l.pagevh + conf
.interpagespace
))
2281 else G.postRedisplay "downbirdseye"
2282 | _ :: rest
-> loop rest
2288 let optentry mode
_ key =
2289 let btos b = if b then "on" else "off" in
2290 if key >= 32 && key < 127
2292 let c = Char.chr
key in
2296 try conf
.scrollstep
<- int_of_string
s with exc
->
2297 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2299 TEswitch
("scroll step: ", E.s, None
, intentry, ondone, true)
2304 conf
.autoscrollstep
<- boundastep state
.winh
(int_of_string
s);
2305 if state
.autoscroll
<> None
2306 then state
.autoscroll
<- Some conf
.autoscrollstep
2308 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2310 TEswitch
("auto scroll step: ", E.s, None
, intentry, ondone, true)
2315 let n, a, b = multicolumns_of_string
s in
2316 setcolumns mode
n a b;
2318 state
.text <- Printf.sprintf
"bad columns `%s': %s" s (exntos exc
)
2320 TEswitch
("columns: ", E.s, None
, textentry, ondone, true)
2325 let zoom = float (int_of_string
s) /. 100.0 in
2328 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2330 TEswitch
("zoom: ", E.s, None
, intentry, ondone, true)
2335 conf
.thumbw
<- bound
(int_of_string
s) 2 4096;
2337 Printf.sprintf
"thumbnail width is set to %d" conf
.thumbw
;
2338 begin match mode
with
2340 leavebirdseye beye
false;
2347 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2349 TEswitch
("thumbnail width: ", E.s, None
, intentry, ondone, true)
2354 Some
(int_of_string
s)
2356 state
.text <- Printf.sprintf
"bad integer `%s': %s"
2360 | Some angle
-> reqlayout angle conf
.fitmodel
2363 TEswitch
("rotation: ", E.s, None
, intentry, ondone, true)
2366 conf
.icase
<- not conf
.icase
;
2367 TEdone
("case insensitive search " ^
(btos conf
.icase
))
2370 conf
.preload <- not conf
.preload;
2372 TEdone
("preload " ^
(btos conf
.preload))
2375 conf
.verbose
<- not conf
.verbose
;
2376 TEdone
("verbose " ^
(btos conf
.verbose
))
2379 conf
.debug
<- not conf
.debug
;
2380 TEdone
("debug " ^
(btos conf
.debug
))
2383 conf
.maxhfit
<- not conf
.maxhfit
;
2384 state
.maxy
<- calcheight
();
2385 TEdone
("maxhfit " ^
(btos conf
.maxhfit
))
2388 conf
.crophack
<- not conf
.crophack
;
2389 TEdone
("crophack " ^
btos conf
.crophack
)
2393 match conf
.maxwait
with
2395 conf
.maxwait
<- Some infinity
;
2396 "always wait for page to complete"
2398 conf
.maxwait
<- None
;
2399 "show placeholder if page is not ready"
2404 conf
.underinfo
<- not conf
.underinfo
;
2405 TEdone
("underinfo " ^
btos conf
.underinfo
)
2408 conf
.savebmarks
<- not conf
.savebmarks
;
2409 TEdone
("persistent bookmarks " ^
btos conf
.savebmarks
)
2415 match state
.layout with
2420 conf
.interpagespace
<- int_of_string
s;
2421 docolumns conf
.columns
;
2422 state
.maxy
<- calcheight
();
2423 let y = getpagey
pageno in
2426 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2428 TEswitch
("vertical margin: ", E.s, None
, intentry, ondone, true)
2432 match conf
.fitmodel
with
2433 | FitProportional
-> FitWidth
2434 | FitWidth
| FitPage
-> FitProportional
2436 reqlayout conf
.angle
fm;
2437 TEdone
("proportional display " ^
btos (fm == FitProportional
))
2440 settrim (not conf
.trimmargins
) conf
.trimfuzz
;
2441 TEdone
("trim margins " ^
btos conf
.trimmargins
)
2444 conf
.invert
<- not conf
.invert
;
2445 TEdone
("invert colors " ^
btos conf
.invert
)
2449 cbput state
.hists
.sel
s;
2452 TEswitch
("selection command: ", E.s, Some
(onhist state
.hists
.sel
),
2453 textentry, ondone, true)
2457 then conf
.pax
<- Some
(ref (0.0, 0, 0))
2458 else conf
.pax
<- None
;
2459 TEdone
("PAX " ^
btos (conf
.pax
!= None
))
2462 state
.text <- Printf.sprintf
"bad option %d `%c'" key c;
2468 class type lvsource
= object
2469 method getitemcount
: int
2470 method getitem
: int -> (string * int)
2471 method hasaction
: int -> bool
2479 method getactive
: int
2480 method getfirst
: int
2482 method getminfo
: (int * int) array
2485 class virtual lvsourcebase
= object
2486 val mutable m_active
= 0
2487 val mutable m_first
= 0
2488 val mutable m_pan
= 0
2489 method getactive
= m_active
2490 method getfirst
= m_first
2491 method getpan
= m_pan
2492 method getminfo
: (int * int) array
= E.a
2495 let textentrykeyboard
2496 key _mask
((c, text, opthist
, onkey
, ondone, cancelonempty
), onleave
) =
2498 if key >= 0xffb0 && key <= 0xffb9
2499 then key - 0xffb0 + 48 else key
2502 state
.mode
<- Textentry
(te
, onleave
);
2505 G.postRedisplay "textentrykeyboard enttext";
2507 let histaction cmd
=
2510 | Some
(action, _) ->
2511 state
.mode
<- Textentry
(
2512 (c, action cmd
, opthist
, onkey
, ondone, cancelonempty
), onleave
2514 G.postRedisplay "textentry histaction"
2518 if emptystr
text && cancelonempty
2521 G.postRedisplay "textentrykeyboard after cancel";
2524 let s = withoutlastutf8
text in
2525 enttext (c, s, opthist
, onkey
, ondone, cancelonempty
)
2527 | @enter
| @kpenter
->
2530 G.postRedisplay "textentrykeyboard after confirm"
2532 | @up
| @kpup
-> histaction HCprev
2533 | @down
| @kpdown
-> histaction HCnext
2534 | @home
| @kphome
-> histaction HCfirst
2535 | @jend
| @kpend
-> histaction HClast
2540 begin match opthist
with
2542 | Some
(_, onhistcancel
) -> onhistcancel
()
2546 G.postRedisplay "textentrykeyboard after cancel2"
2549 enttext (c, E.s, opthist
, onkey
, ondone, cancelonempty
)
2552 | @delete
| @kpdelete
-> ()
2555 && key land 0xff00 != 0xff00 (* keyboard *)
2556 && key land 0xfe00 != 0xfe00 (* xkb *)
2557 && key land 0xfd00 != 0xfd00 (* 3270 *)
2559 begin match onkey
text key with
2563 G.postRedisplay "textentrykeyboard after confirm2";
2566 enttext (c, text, opthist
, onkey
, ondone, cancelonempty
);
2570 G.postRedisplay "textentrykeyboard after cancel3"
2573 state
.mode
<- Textentry
(te
, onleave
);
2574 G.postRedisplay "textentrykeyboard switch";
2578 vlog "unhandled key %s" (Wsi.keyname
key)
2581 let firstof first active
=
2582 if first
> active
|| abs
(first
- active
) > fstate
.maxrows
- 1
2583 then max
0 (active
- (fstate
.maxrows
/2))
2587 let calcfirst first active
=
2590 let rows = active
- first
in
2591 if rows > fstate
.maxrows
then active
- fstate
.maxrows
else first
2595 let scrollph y maxy
=
2596 let sh = float (maxy
+ state
.winh
) /. float state
.winh
in
2597 let sh = float state
.winh
/. sh in
2598 let sh = max
sh (float conf
.scrollh
) in
2600 let percent = float y /. float maxy
in
2601 let position = (float state
.winh
-. sh) *. percent in
2604 if position +. sh > float state
.winh
2605 then float state
.winh
-. sh
2611 let coe s = (s :> uioh
);;
2613 class listview ~zebra ~helpmode ~
(source
:lvsource
) ~trusted ~modehash
=
2615 val m_pan
= source#getpan
2616 val m_first
= source#getfirst
2617 val m_active
= source#getactive
2619 val m_prev_uioh
= state
.uioh
2621 method private elemunder
y =
2625 let n = y / (fstate
.fontsize
+1) in
2626 if m_first
+ n < source#getitemcount
2628 if source#hasaction
(m_first
+ n)
2629 then Some
(m_first
+ n)
2636 GlFunc.blend_func ~src
:`src_alpha ~dst
:`one_minus_src_alpha
;
2637 GlDraw.color
(0., 0., 0.) ~alpha
:0.85;
2638 filledrect 0. 0. (float state
.winw
) (float state
.winh
);
2639 GlDraw.color
(1., 1., 1.);
2640 Gl.enable `texture_2d
;
2641 let fs = fstate
.fontsize
in
2643 let hw = (wadjsb () + xadjsb () + state
.winw
)/3 in
2644 let ww = fstate
.wwidth
in
2645 let tabw = 17.0*.ww in
2646 let itemcount = source#getitemcount
in
2647 let minfo = source#getminfo
in
2650 then float (xadjsb ()), float (state
.winw
- 1)
2651 else 0.0, float (state
.winw
- conf
.scrollbw
- 1)
2653 let xadj = xadjsb () in
2655 if (row - m_first
) > fstate
.maxrows
2658 if row >= 0 && row < itemcount
2660 let (s, level
) = source#getitem
row in
2661 let y = (row - m_first
) * nfs in
2663 (if conf
.leftscroll
then float xadj else 5.0)
2664 +. (float (level
+ m_pan
)) *. ww in
2667 (let c = if row land 1 = 0 then 1.0 else 0.92 in (c,c,c));
2671 Gl.disable `texture_2d
;
2672 let alpha = if source#hasaction
row then 0.9 else 0.3 in
2673 GlDraw.color
(1., 1., 1.) ~
alpha;
2674 linerect (x0 +. 1.) (float (y + 1)) (x1) (float (y + fs + 3));
2675 Gl.enable `texture_2d
;
2678 if zebra
&& row land 1 = 1
2682 GlDraw.color
(c,c,c);
2683 let drawtabularstring s =
2685 let x'
= truncate
(x0 +. x) in
2686 let pos = nindex
s '
\000'
in
2688 then drawstring1 fs x'
(y+nfs) s
2690 let s1 = String.sub
s 0 pos
2691 and s2
= String.sub
s (pos+1) (String.length
s - pos - 1) in
2696 let s'
= withoutlastutf8
s in
2697 let s = s' ^
"@Uellipsis" in
2698 let w = measurestr
fs s in
2699 if float x'
+. w +. ww < float (hw + x'
)
2704 if float x'
+. ww +. measurestr
fs s1 > float (hw + x'
)
2708 ignore
(drawstring1 fs x'
(y+nfs) s1);
2709 drawstring1 fs (hw + x'
) (y+nfs) s2
2713 let x = if helpmode
&& row > 0 then x +. ww else x in
2714 let tabpos = nindex
s '
\t'
in
2717 let len = String.length
s - tabpos - 1 in
2718 let s1 = String.sub
s 0 tabpos
2719 and s2
= String.sub
s (tabpos + 1) len in
2720 let nx = drawstr x s1 in
2722 let x = x +. (max
tabw sw) in
2725 let len = String.length
s - 2 in
2726 if len > 0 && s.[0] = '
\xc2'
&& s.[1] = '
\xb7'
2728 let s = String.sub
s 2 len in
2729 let x = if not helpmode
then x +. ww else x in
2730 GlDraw.color
(1.2, 1.2, 1.2);
2731 let vinc = drawstring1 (fs+fs/4)
2732 (truncate
(x -. ww)) (y+nfs) s in
2733 GlDraw.color
(1., 1., 1.);
2734 vinc +. (float fs *. 0.8)
2740 ignore
(drawtabularstring s);
2746 GlDraw.color
(1.0, 1.0, 1.0) ~
alpha:0.5;
2747 let xadj = float (xadjsb () + 5) in
2749 if (row - m_first
) > fstate
.maxrows
2752 if row >= 0 && row < itemcount
2754 let (s, level
) = source#getitem
row in
2755 let pos0 = nindex
s '
\000'
in
2756 let y = (row - m_first
) * nfs in
2757 let x = float (level
+ m_pan
) *. ww in
2758 let (first
, last
) = minfo.(row) in
2760 if pos0 > 0 && first
> pos0
2761 then String.sub
s (pos0+1) (first
-pos0-1)
2762 else String.sub
s 0 first
2764 let suffix = String.sub
s first
(last
- first
) in
2765 let w1 = measurestr fstate
.fontsize
prefix in
2766 let w2 = measurestr fstate
.fontsize
suffix in
2767 let x = x +. if conf
.leftscroll
then xadj else 5.0 in
2768 let x = if pos0 > 0 && first
> pos0 then x +. float hw else x in
2770 and y0 = float (y+2) in
2772 and y1 = float (y+fs+3) in
2773 filledrect x0 y0 x1 y1;
2778 Gl.disable `texture_2d
;
2779 if Array.length
minfo > 0 then loop m_first
;
2782 method updownlevel incr
=
2783 let len = source#getitemcount
in
2785 if m_active
>= 0 && m_active
< len
2786 then snd
(source#getitem m_active
)
2790 if i
= len then i
-1 else if i
= -1 then 0 else
2791 let _, l = source#getitem i
in
2792 if l != curlevel then i
else flow (i
+incr
)
2794 let active = flow m_active
in
2795 let first = calcfirst m_first
active in
2796 G.postRedisplay "outline updownlevel";
2797 {< m_active
= active; m_first
= first >}
2799 method private key1
key mask
=
2800 let set1 active first qsearch
=
2801 coe {< m_active
= active; m_first
= first; m_qsearch
= qsearch
>}
2803 let search active pattern incr
=
2804 let active = if active = -1 then m_first
else active in
2807 if n >= 0 && n < source#getitemcount
2809 let s, _ = source#getitem
n in
2811 (try ignore
(Str.search_forward re
s 0); true
2812 with Not_found
-> false)
2814 else loop (n + incr
)
2821 let re = Str.regexp_case_fold pattern
in
2827 let itemcount = source#getitemcount
in
2828 let find start incr
=
2830 if i
= -1 || i
= itemcount
2833 if source#hasaction i
2835 else find (i
+ incr
)
2840 let set active first =
2841 let first = bound
first 0 (itemcount - fstate
.maxrows
) in
2843 coe {< m_active
= active; m_first
= first; m_qsearch
= E.s >}
2846 let isvisible first n = n >= first && n - first <= fstate
.maxrows
in
2848 let incr1 = if incr
> 0 then 1 else -1 in
2849 if isvisible m_first m_active
2852 let next = m_active
+ incr
in
2854 if next < 0 || next >= itemcount
2856 else find next incr1
2858 if abs
(m_active
- next) > fstate
.maxrows
2864 let first = m_first
+ incr
in
2865 let first = bound
first 0 (itemcount - fstate
.maxrows
) in
2867 let next = m_active
+ incr
in
2868 let next = bound
next 0 (itemcount - 1) in
2875 if isvisible first next
2882 let first = min
next m_first
in
2884 if abs
(next - first) > fstate
.maxrows
2890 let first = m_first
+ incr
in
2891 let first = bound
first 0 (itemcount - 1) in
2893 let next = m_active
+ incr
in
2894 let next = bound
next 0 (itemcount - 1) in
2895 let next = find next incr1 in
2897 if next = -1 || abs
(m_active
- first) > fstate
.maxrows
2899 let active = if m_active
= -1 then next else m_active
in
2904 if isvisible first active
2910 G.postRedisplay "listview navigate";
2914 | (@r
|@s) when Wsi.withctrl mask
->
2915 let incr = if key = @r
then -1 else 1 in
2917 match search (m_active
+ incr) m_qsearch
incr with
2919 state
.text <- m_qsearch ^
" [not found]";
2922 state
.text <- m_qsearch
;
2923 active, firstof m_first
active
2925 G.postRedisplay "listview ctrl-r/s";
2926 set1 active first m_qsearch
;
2928 | @insert
when Wsi.withctrl mask
->
2929 if m_active
>= 0 && m_active
< source#getitemcount
2931 let s, _ = source#getitem m_active
in
2937 if emptystr m_qsearch
2940 let qsearch = withoutlastutf8 m_qsearch
in
2944 G.postRedisplay "listview empty qsearch";
2945 set1 m_active m_first
E.s;
2949 match search m_active
qsearch ~
-1 with
2951 state
.text <- qsearch ^
" [not found]";
2954 state
.text <- qsearch;
2955 active, firstof m_first
active
2957 G.postRedisplay "listview backspace qsearch";
2958 set1 active first qsearch
2961 | key when (key != 0 && key land 0xff00 != 0xff00) ->
2962 let pattern = m_qsearch ^ toutf8
key in
2964 match search m_active
pattern 1 with
2966 state
.text <- pattern ^
" [not found]";
2969 state
.text <- pattern;
2970 active, firstof m_first
active
2972 G.postRedisplay "listview qsearch add";
2973 set1 active first pattern;
2977 if emptystr m_qsearch
2979 G.postRedisplay "list view escape";
2982 source#exit ~uioh
:(coe self
)
2983 ~cancel
:true ~
active:m_active ~
first:m_first ~pan
:m_pan
2985 | None
-> m_prev_uioh
2990 G.postRedisplay "list view kill qsearch";
2991 coe {< m_qsearch
= E.s >}
2994 | @enter
| @kpenter
->
2996 let self = {< m_qsearch
= E.s >} in
2998 G.postRedisplay "listview enter";
2999 if m_active
>= 0 && m_active
< source#getitemcount
3001 source#exit ~uioh
:(coe self) ~cancel
:false
3002 ~
active:m_active ~
first:m_first ~pan
:m_pan
;
3005 source#exit ~uioh
:(coe self) ~cancel
:true
3006 ~
active:m_active ~
first:m_first ~pan
:m_pan
;
3009 begin match opt with
3010 | None
-> m_prev_uioh
3014 | @delete
| @kpdelete
->
3017 | @up
| @kpup
-> navigate ~
-1
3018 | @down
| @kpdown
-> navigate 1
3019 | @prior
| @kpprior
-> navigate ~
-(fstate
.maxrows
)
3020 | @next | @kpnext
-> navigate fstate
.maxrows
3022 | @right
| @kpright
->
3024 G.postRedisplay "listview right";
3025 coe {< m_pan
= m_pan
- 1 >}
3027 | @left | @kpleft
->
3029 G.postRedisplay "listview left";
3030 coe {< m_pan
= m_pan
+ 1 >}
3032 | @home
| @kphome
->
3033 let active = find 0 1 in
3034 G.postRedisplay "listview home";
3038 let first = max
0 (itemcount - fstate
.maxrows
) in
3039 let active = find (itemcount - 1) ~
-1 in
3040 G.postRedisplay "listview end";
3043 | key when (key = 0 || key land 0xff00 = 0xff00) ->
3047 dolog
"listview unknown key %#x" key; coe self
3049 method key key mask
=
3050 match state
.mode
with
3051 | Textentry te
-> textentrykeyboard key mask te
; coe self
3054 | LinkNav
_ -> self#key1
key mask
3056 method button button down
x y _ =
3059 | 1 when x > state
.winw
- conf
.scrollbw
->
3060 G.postRedisplay "listview scroll";
3063 let _, position, sh = self#
scrollph in
3064 if y > truncate
position && y < truncate
(position +. sh)
3066 state
.mstate
<- Mscrolly
;
3070 let s = float (max
0 (y - conf
.scrollh
)) /. float state
.winh
in
3071 let first = truncate
(s *. float source#getitemcount
) in
3072 let first = min source#getitemcount
first in
3073 Some
(coe {< m_first
= first; m_active
= first >})
3075 state
.mstate
<- Mnone
;
3079 begin match self#elemunder
y with
3081 G.postRedisplay "listview click";
3082 source#exit ~uioh
:(coe {< m_active
= n >})
3083 ~cancel
:false ~
active:n ~
first:m_first ~pan
:m_pan
3087 | n when (n == 4 || n == 5) && not down
->
3088 let len = source#getitemcount
in
3090 if n = 5 && m_first
+ fstate
.maxrows
>= len
3094 let first = m_first
+ (if n == 4 then -1 else 1) in
3095 bound
first 0 (len - 1)
3097 G.postRedisplay "listview wheel";
3098 Some
(coe {< m_first
= first >})
3099 | n when (n = 6 || n = 7) && not down
->
3100 let inc = if n = 7 then -1 else 1 in
3101 G.postRedisplay "listview hwheel";
3102 Some
(coe {< m_pan
= m_pan
+ inc >})
3107 | None
-> m_prev_uioh
3110 method multiclick
_ x y = self#button
1 true x y
3113 match state
.mstate
with
3115 let s = float (max
0 (y - conf
.scrollh
)) /. float state
.winh
in
3116 let first = truncate
(s *. float source#getitemcount
) in
3117 let first = min source#getitemcount
first in
3118 G.postRedisplay "listview motion";
3119 coe {< m_first
= first; m_active
= first >}
3127 method pmotion
x y =
3128 if x < state
.winw
- conf
.scrollbw
3131 match self#elemunder
y with
3132 | None
-> Wsi.setcursor
Wsi.CURSOR_INHERIT
; m_active
3133 | Some
n -> Wsi.setcursor
Wsi.CURSOR_INFO
; n
3137 then (G.postRedisplay "listview pmotion"; {< m_active
= n >})
3142 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
3146 method infochanged
_ = ()
3148 method scrollpw
= (0, 0.0, 0.0)
3150 let nfs = fstate
.fontsize
+ 1 in
3151 let y = m_first
* nfs in
3152 let itemcount = source#getitemcount
in
3153 let maxi = max
0 (itemcount - fstate
.maxrows
) in
3154 let maxy = maxi * nfs in
3155 let p, h = scrollph y maxy in
3158 method modehash
= modehash
3159 method eformsgs
= false
3160 method alwaysscrolly
= true
3163 class outlinelistview ~zebra ~source
=
3164 let settext autonarrow
s =
3167 let ss = source#statestr
in
3171 else "{" ^
ss ^
"} [" ^
s ^
"]"
3172 else state
.text <- s
3178 ~source
:(source
:> lvsource
)
3180 ~modehash
:(findkeyhash conf
"outline")
3183 val m_autonarrow
= false
3185 method! key key mask
=
3187 if emptystr state
.text
3189 else fstate
.maxrows - 2
3191 let calcfirst first active =
3194 let rows = active - first in
3195 if rows > maxrows then active - maxrows else first
3199 let active = m_active
+ incr in
3200 let active = bound
active 0 (source#getitemcount
- 1) in
3201 let first = calcfirst m_first
active in
3202 G.postRedisplay "outline navigate";
3203 coe {< m_active
= active; m_first
= first >}
3205 let navscroll first =
3207 let dist = m_active
- first in
3213 else first + maxrows
3216 G.postRedisplay "outline navscroll";
3217 coe {< m_first
= first; m_active
= active >}
3219 let ctrl = Wsi.withctrl mask
in
3224 then (source#denarrow
; E.s)
3226 let pattern = source#renarrow
in
3227 if nonemptystr m_qsearch
3228 then (source#narrow m_qsearch
; m_qsearch
)
3232 settext (not m_autonarrow
) text;
3233 G.postRedisplay "toggle auto narrowing";
3234 coe {< m_first
= 0; m_active
= 0; m_autonarrow
= not m_autonarrow
>}
3236 | @slash
when emptystr m_qsearch
&& not m_autonarrow
->
3238 G.postRedisplay "toggle auto narrowing";
3239 coe {< m_first
= 0; m_active
= 0; m_autonarrow
= true >}
3242 source#narrow m_qsearch
;
3244 then source#add_narrow_pattern m_qsearch
;
3245 G.postRedisplay "outline ctrl-n";
3246 coe {< m_first
= 0; m_active
= 0 >}
3249 let active = source#calcactive
(getanchor
()) in
3250 let first = firstof m_first
active in
3251 G.postRedisplay "outline ctrl-s";
3252 coe {< m_first
= first; m_active
= active >}
3255 G.postRedisplay "outline ctrl-u";
3256 if m_autonarrow
&& nonemptystr m_qsearch
3258 ignore
(source#renarrow
);
3259 settext m_autonarrow
E.s;
3260 coe {< m_first
= 0; m_active
= 0; m_qsearch
= E.s >}
3263 source#del_narrow_pattern
;
3264 let pattern = source#renarrow
in
3266 if emptystr
pattern then E.s else "Narrowed to " ^
pattern
3268 settext m_autonarrow
text;
3269 coe {< m_first
= 0; m_active
= 0; m_qsearch
= E.s >}
3273 let first = max
0 (m_active
- (fstate
.maxrows / 2)) in
3274 G.postRedisplay "outline ctrl-l";
3275 coe {< m_first
= first >}
3277 | @tab
when m_autonarrow
->
3278 if nonemptystr m_qsearch
3280 G.postRedisplay "outline list view tab";
3281 source#add_narrow_pattern m_qsearch
;
3283 coe {< m_qsearch
= E.s >}
3287 | @escape
when m_autonarrow
->
3288 if nonemptystr m_qsearch
3289 then source#add_narrow_pattern m_qsearch
;
3292 | @enter
| @kpenter
when m_autonarrow
->
3293 if nonemptystr m_qsearch
3294 then source#add_narrow_pattern m_qsearch
;
3297 | key when m_autonarrow
&& (key != 0 && key land 0xff00 != 0xff00) ->
3298 let pattern = m_qsearch ^ toutf8
key in
3299 G.postRedisplay "outlinelistview autonarrow add";
3300 source#narrow
pattern;
3301 settext true pattern;
3302 coe {< m_first
= 0; m_active
= 0; m_qsearch
= pattern >}
3304 | key when m_autonarrow
&& key = @backspace
->
3305 if emptystr m_qsearch
3308 let pattern = withoutlastutf8 m_qsearch
in
3309 G.postRedisplay "outlinelistview autonarrow backspace";
3310 ignore
(source#renarrow
);
3311 source#narrow
pattern;
3312 settext true pattern;
3313 coe {< m_first
= 0; m_active
= 0; m_qsearch
= pattern >}
3315 | @delete
| @kpdelete
->
3316 source#remove m_active
;
3317 G.postRedisplay "outline delete";
3318 let active = max
0 (m_active
-1) in
3319 coe {< m_first
= firstof m_first
active;
3320 m_active
= active >}
3322 | @up
| @kpup
when ctrl ->
3323 navscroll (max
0 (m_first
- 1))
3325 | @down
| @kpdown
when ctrl ->
3326 navscroll (min
(source#getitemcount
- 1) (m_first
+ 1))
3328 | @up
| @kpup
-> navigate ~
-1
3329 | @down
| @kpdown
-> navigate 1
3330 | @prior
| @kpprior
-> navigate ~
-(fstate
.maxrows)
3331 | @next | @kpnext
-> navigate fstate
.maxrows
3333 | @right
| @kpright
->
3337 G.postRedisplay "outline ctrl right";
3338 {< m_pan
= m_pan
+ 1 >}
3340 else self#updownlevel
1
3344 | @left | @kpleft
->
3348 G.postRedisplay "outline ctrl left";
3349 {< m_pan
= m_pan
- 1 >}
3351 else self#updownlevel ~
-1
3355 | @home
| @kphome
->
3356 G.postRedisplay "outline home";
3357 coe {< m_first
= 0; m_active
= 0 >}
3360 let active = source#getitemcount
- 1 in
3361 let first = max
0 (active - fstate
.maxrows) in
3362 G.postRedisplay "outline end";
3363 coe {< m_active
= active; m_first
= first >}
3365 | _ -> super#
key key mask
3368 let genhistoutlines =
3369 let order ty
(p1
, c1
, _, _, _) (p2
, c2
, _, _, _) =
3371 | `lastvisit
-> compare c1
.lastvisit c2
.lastvisit
3372 | `path
-> compare p2 p1
3373 | `file
-> compare
(Filename.basename p2
) (Filename.basename p1
)
3375 let e1 = emptystr c1
.title
3376 and e2
= emptystr c2
.title
in
3378 then compare
(Filename.basename p2
) (Filename.basename p1
)
3381 else compare c1
.title c2
.title
3383 let showfullpath = ref false in
3386 let s = if orderty
= t
then "[@Uradical] " ^
s else "[ ] " ^
s in
3387 s, 0, Oaction
(fun () -> Config.historder
:= t
; reeenterhist := true)
3389 let list = ref [] in
3390 if Config.gethist
list
3394 (fun accu (path
, c, b, x, a) ->
3395 let hist = (path
, (c, b, x, a)) in
3396 let s = if !showfullpath then path
else Filename.basename path
in
3397 let base = mbtoutf8
s in
3398 (base ^
"\000" ^
c.title
, 1, Ohistory
hist) :: accu
3400 [ setorty "Sort by time of last visit" `lastvisit
;
3401 setorty "Sort by file name" `file
;
3402 setorty "Sort by path" `path
;
3403 setorty "Sort by title" `title
;
3404 (if !showfullpath then "@Uradical "
3405 else " ") ^
"Show full path", 0, Oaction
(fun () ->
3406 showfullpath := not
!showfullpath; reeenterhist := true)
3407 ] (List.sort
(order orderty
) !list)
3413 let gotohist (path
, (c, bookmarks
, x, anchor)) =
3414 Config.save
leavebirdseye;
3415 state
.anchor <- anchor;
3417 state
.bookmarks
<- bookmarks
;
3418 state
.origin
<- E.s;
3420 let x0, y0, x1, y1 = conf
.trimfuzz
in
3421 wcmd "trimset %d %d %d %d %d" (btod conf
.trimmargins
) x0 y0 x1 y1;
3425 let makecheckers () =
3426 (* Based on lablGL-1.04/LablGlut/examples/lablGL/checker.ml which had
3428 converted by Issac Trotts. July 25, 2002 *)
3429 let image = GlPix.create `ubyte ~format
:`luminance ~width
:2 ~height
:2 in
3430 Raw.sets_string
(GlPix.to_raw
image) ~
pos:0 "\255\200\200\255";
3431 let id = GlTex.gen_texture
() in
3432 GlTex.bind_texture ~target
:`texture_2d
id;
3433 GlPix.store
(`unpack_alignment
1);
3434 GlTex.image2d
image;
3435 List.iter
(GlTex.parameter ~target
:`texture_2d
)
3436 [ `mag_filter `nearest
; `min_filter `nearest
];
3440 let setcheckers enabled
=
3441 match state
.checkerstexid
with
3443 if enabled
then state
.checkerstexid
<- Some
(makecheckers ())
3445 | Some checkerstexid
->
3448 GlTex.delete_texture checkerstexid
;
3449 state
.checkerstexid
<- None
;
3453 let describe_location () =
3454 let fn = page_of_y state
.y in
3455 let ln = page_of_y
(state
.y + state
.winh
- hscrollh () - 1) in
3456 let maxy = state
.maxy - (if conf
.maxhfit
then state
.winh
else 0) in
3460 else (100. *. (float state
.y /. float maxy))
3464 Printf.sprintf
"page %d of %d [%.2f%%]"
3465 (fn+1) state
.pagecount
percent
3468 "pages %d-%d of %d [%.2f%%]"
3469 (fn+1) (ln+1) state
.pagecount
percent
3472 let setpresentationmode v
=
3473 let n = page_of_y state
.y in
3474 state
.anchor <- (n, 0.0, 1.0);
3475 conf
.presentation
<- v
;
3476 if conf
.fitmodel
= FitPage
3477 then reqlayout conf
.angle conf
.fitmodel
;
3482 let btos b = if b then "@Uradical" else E.s in
3483 let showextended = ref false in
3484 let leave mode
_ = state
.mode
<- mode
in
3487 val mutable m_first_time
= true
3488 val mutable m_l
= []
3489 val mutable m_a
= E.a
3490 val mutable m_prev_uioh
= nouioh
3491 val mutable m_prev_mode
= View
3493 inherit lvsourcebase
3495 method reset prev_mode prev_uioh
=
3496 m_a
<- Array.of_list
(List.rev m_l
);
3498 m_prev_mode
<- prev_mode
;
3499 m_prev_uioh
<- prev_uioh
;
3503 if n >= Array.length m_a
3507 | _, _, _, Action
_ -> m_active
<- n
3508 | _, _, _, Noaction
-> loop (n+1)
3511 m_first_time
<- false;
3514 method int name get
set =
3516 (name
, `
int get
, 1, Action
(
3519 try set (int_of_string
s)
3521 state
.text <- Printf.sprintf
"bad integer `%s': %s"
3525 let te = name ^
": ", E.s, None
, intentry, ondone, true in
3526 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3530 method int_with_suffix name get
set =
3532 (name
, `intws get
, 1, Action
(
3535 try set (int_of_string_with_suffix
s)
3537 state
.text <- Printf.sprintf
"bad integer `%s': %s"
3542 name ^
": ", E.s, None
, intentry_with_suffix, ondone, true
3544 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3548 method bool ?
(offset
=1) ?
(btos=btos) name get
set =
3550 (name
, `
bool (btos, get
), offset
, Action
(
3557 method color name get
set =
3559 (name
, `color get
, 1, Action
(
3561 let invalid = (nan
, nan
, nan
) in
3564 try color_of_string
s
3566 state
.text <- Printf.sprintf
"bad color `%s': %s"
3573 let te = name ^
": ", E.s, None
, textentry, ondone, true in
3574 state
.text <- color_to_string
(get
());
3575 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3579 method string name get
set =
3581 (name
, `
string get
, 1, Action
(
3583 let ondone s = set s in
3584 let te = name ^
": ", E.s, None
, textentry, ondone, true in
3585 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3589 method colorspace name get
set =
3591 (name
, `
string get
, 1, Action
(
3595 inherit lvsourcebase
3598 m_active
<- CSTE.to_int conf
.colorspace
;
3601 method getitemcount
=
3602 Array.length
CSTE.names
3605 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3606 ignore
(uioh
, first, pan
);
3607 if not cancel
then set active;
3609 method hasaction
_ = true
3613 let modehash = findkeyhash conf
"info" in
3614 coe (new listview ~zebra
:false ~helpmode
:false
3615 ~
source ~trusted
:true ~
modehash)
3618 method paxmark name get
set =
3620 (name
, `
string get
, 1, Action
(
3624 inherit lvsourcebase
3627 m_active
<- MTE.to_int conf
.paxmark
;
3630 method getitemcount
= Array.length
MTE.names
3631 method getitem
n = (MTE.names
.(n), 0)
3632 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3633 ignore
(uioh
, first, pan
);
3634 if not cancel
then set active;
3636 method hasaction
_ = true
3640 let modehash = findkeyhash conf
"info" in
3641 coe (new listview ~zebra
:false ~helpmode
:false
3642 ~
source ~trusted
:true ~
modehash)
3645 method fitmodel name get
set =
3647 (name
, `
string get
, 1, Action
(
3651 inherit lvsourcebase
3654 m_active
<- FMTE.to_int conf
.fitmodel
;
3657 method getitemcount
= Array.length
FMTE.names
3658 method getitem
n = (FMTE.names
.(n), 0)
3659 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3660 ignore
(uioh
, first, pan
);
3661 if not cancel
then set active;
3663 method hasaction
_ = true
3667 let modehash = findkeyhash conf
"info" in
3668 coe (new listview ~zebra
:false ~helpmode
:false
3669 ~
source ~trusted
:true ~
modehash)
3672 method caption
s offset
=
3673 m_l
<- (s, `empty
, offset
, Noaction
) :: m_l
3675 method caption2
s f offset
=
3676 m_l
<- (s, `
string f, offset
, Noaction
) :: m_l
3678 method getitemcount
= Array.length m_a
3681 let tostr = function
3682 | `
int f -> string_of_int
(f ())
3683 | `intws
f -> string_with_suffix_of_int
(f ())
3685 | `color
f -> color_to_string
(f ())
3686 | `
bool (btos, f) -> btos (f ())
3689 let name, t
, offset
, _ = m_a
.(n) in
3690 ((let s = tostr t
in
3692 then Printf.sprintf
"%s\t%s" name s
3696 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3701 match m_a
.(active) with
3702 | _, _, _, Action
f -> f uioh
3703 | _, _, _, Noaction
-> uioh
3714 method hasaction
n =
3716 | _, _, _, Action
_ -> true
3717 | _, _, _, Noaction
-> false
3720 let rec fillsrc prevmode prevuioh
=
3721 let sep () = src#caption
E.s 0 in
3722 let colorp name get
set =
3724 (fun () -> color_to_string
(get
()))
3727 let c = color_of_string
v in
3730 state
.text <- Printf.sprintf
"bad color `%s': %s" v (exntos exn
)
3733 let oldmode = state
.mode
in
3734 let birdseye = isbirdseye state
.mode
in
3736 src#caption
(if birdseye then "Setup (Bird's eye)" else "Setup") 0;
3738 src#
bool "presentation mode"
3739 (fun () -> conf
.presentation
)
3740 (fun v -> setpresentationmode v);
3742 src#
bool "ignore case in searches"
3743 (fun () -> conf
.icase
)
3744 (fun v -> conf
.icase
<- v);
3747 (fun () -> conf
.preload)
3748 (fun v -> conf
.preload <- v);
3750 src#
bool "highlight links"
3751 (fun () -> conf
.hlinks
)
3752 (fun v -> conf
.hlinks
<- v);
3754 src#
bool "under info"
3755 (fun () -> conf
.underinfo
)
3756 (fun v -> conf
.underinfo
<- v);
3758 src#
bool "persistent bookmarks"
3759 (fun () -> conf
.savebmarks
)
3760 (fun v -> conf
.savebmarks
<- v);
3762 src#fitmodel
"fit model"
3763 (fun () -> FMTE.to_string conf
.fitmodel
)
3764 (fun v -> reqlayout conf
.angle
(FMTE.of_int
v));
3766 src#
bool "trim margins"
3767 (fun () -> conf
.trimmargins
)
3768 (fun v -> settrim v conf
.trimfuzz
; fillsrc prevmode prevuioh
);
3770 src#
bool "persistent location"
3771 (fun () -> conf
.jumpback
)
3772 (fun v -> conf
.jumpback
<- v);
3775 src#
int "inter-page space"
3776 (fun () -> conf
.interpagespace
)
3778 conf
.interpagespace
<- n;
3779 docolumns conf
.columns
;
3781 match state
.layout with
3786 state
.maxy <- calcheight
();
3787 let y = getpagey
pageno in
3792 (fun () -> conf
.pagebias
)
3793 (fun v -> conf
.pagebias
<- v);
3795 src#
int "scroll step"
3796 (fun () -> conf
.scrollstep
)
3797 (fun n -> conf
.scrollstep
<- n);
3799 src#
int "horizontal scroll step"
3800 (fun () -> conf
.hscrollstep
)
3801 (fun v -> conf
.hscrollstep
<- v);
3803 src#
int "auto scroll step"
3805 match state
.autoscroll
with
3807 | _ -> conf
.autoscrollstep
)
3809 let n = boundastep state
.winh
n in
3810 if state
.autoscroll
<> None
3811 then state
.autoscroll
<- Some
n;
3812 conf
.autoscrollstep
<- n);
3815 (fun () -> truncate
(conf
.zoom *. 100.))
3816 (fun v -> setzoom ((float v) /. 100.));
3819 (fun () -> conf
.angle
)
3820 (fun v -> reqlayout v conf
.fitmodel
);
3822 src#
int "scroll bar width"
3823 (fun () -> conf
.scrollbw
)
3826 reshape state
.winw state
.winh
;
3829 src#
int "scroll handle height"
3830 (fun () -> conf
.scrollh
)
3831 (fun v -> conf
.scrollh
<- v;);
3833 src#
int "thumbnail width"
3834 (fun () -> conf
.thumbw
)
3836 conf
.thumbw
<- min
4096 v;
3839 leavebirdseye beye
false;
3846 let mode = state
.mode in
3847 src#
string "columns"
3849 match conf
.columns
with
3851 | Cmulti
(multi
, _) -> multicolumns_to_string multi
3852 | Csplit
(count
, _) -> "-" ^ string_of_int count
3855 let n, a, b = multicolumns_of_string
v in
3856 setcolumns mode n a b);
3859 src#caption
"Pixmap cache" 0;
3860 src#int_with_suffix
"size (advisory)"
3861 (fun () -> conf
.memlimit
)
3862 (fun v -> conf
.memlimit
<- v);
3865 (fun () -> Printf.sprintf
"%s bytes, %d tiles"
3866 (string_with_suffix_of_int state
.memused
)
3867 (Hashtbl.length state
.tilemap
)) 1;
3870 src#caption
"Layout" 0;
3871 src#caption2
"Dimension"
3873 Printf.sprintf
"%dx%d (virtual %dx%d)"
3874 state
.winw state
.winh
3879 src#caption2
"Position" (fun () ->
3880 Printf.sprintf
"%dx%d" state
.x state
.y
3883 src#caption2
"Position" (fun () -> describe_location ()) 1
3887 src#
bool ~offset
:0 ~
btos:(fun v -> if v then "(on)" else "(off)")
3888 "Save these parameters as global defaults at exit"
3889 (fun () -> conf
.bedefault
)
3890 (fun v -> conf
.bedefault
<- v)
3894 let btos b = if b then "@Ulguillemet" else "@Urguillemet" in
3895 src#
bool ~offset
:0 ~
btos "Extended parameters"
3896 (fun () -> !showextended)
3897 (fun v -> showextended := v; fillsrc prevmode prevuioh
);
3901 (fun () -> conf
.checkers
)
3902 (fun v -> conf
.checkers
<- v; setcheckers v);
3903 src#
bool "update cursor"
3904 (fun () -> conf
.updatecurs
)
3905 (fun v -> conf
.updatecurs
<- v);
3906 src#
bool "scroll-bar on the left"
3907 (fun () -> conf
.leftscroll
)
3908 (fun v -> conf
.leftscroll
<- v);
3910 (fun () -> conf
.verbose
)
3911 (fun v -> conf
.verbose
<- v);
3912 src#
bool "invert colors"
3913 (fun () -> conf
.invert
)
3914 (fun v -> conf
.invert
<- v);
3916 (fun () -> conf
.maxhfit
)
3917 (fun v -> conf
.maxhfit
<- v);
3918 src#
bool "redirect stderr"
3919 (fun () -> conf
.redirectstderr)
3920 (fun v -> conf
.redirectstderr <- v; redirectstderr ());
3922 (fun () -> conf
.pax
!= None
)
3925 then conf
.pax
<- Some
(ref (now
(), 0, 0))
3926 else conf
.pax
<- None
);
3927 src#
string "uri launcher"
3928 (fun () -> conf
.urilauncher
)
3929 (fun v -> conf
.urilauncher
<- v);
3930 src#
string "path launcher"
3931 (fun () -> conf
.pathlauncher
)
3932 (fun v -> conf
.pathlauncher
<- v);
3933 src#
string "tile size"
3934 (fun () -> Printf.sprintf
"%dx%d" conf
.tilew conf
.tileh
)
3937 let w, h = Scanf.sscanf
v "%dx%d" (fun w h -> w, h) in
3938 conf
.tilew
<- max
64 w;
3939 conf
.tileh
<- max
64 h;
3942 state
.text <- Printf.sprintf
"bad tile size `%s': %s"
3945 src#
int "texture count"
3946 (fun () -> conf
.texcount
)
3949 then conf
.texcount
<- v
3950 else showtext '
!'
" Failed to set texture count please retry later"
3952 src#
int "slice height"
3953 (fun () -> conf
.sliceheight
)
3955 conf
.sliceheight
<- v;
3956 wcmd "sliceh %d" conf
.sliceheight
;
3958 src#
int "anti-aliasing level"
3959 (fun () -> conf
.aalevel
)
3961 conf
.aalevel
<- bound
v 0 8;
3962 state
.anchor <- getanchor
();
3963 opendoc state
.path state
.password;
3965 src#
string "page scroll scaling factor"
3966 (fun () -> string_of_float conf
.pgscale)
3969 let s = float_of_string
v in
3972 state
.text <- Printf.sprintf
3973 "bad page scroll scaling factor `%s': %s" v (exntos exn
)
3976 src#
int "ui font size"
3977 (fun () -> fstate
.fontsize
)
3978 (fun v -> setfontsize (bound
v 5 100));
3979 src#
int "hint font size"
3980 (fun () -> conf
.hfsize
)
3981 (fun v -> conf
.hfsize
<- bound
v 5 100);
3982 colorp "background color"
3983 (fun () -> conf
.bgcolor
)
3984 (fun v -> conf
.bgcolor
<- v);
3985 src#
bool "crop hack"
3986 (fun () -> conf
.crophack
)
3987 (fun v -> conf
.crophack
<- v);
3988 src#
string "trim fuzz"
3989 (fun () -> irect_to_string conf
.trimfuzz
)
3992 conf
.trimfuzz
<- irect_of_string
v;
3994 then settrim true conf
.trimfuzz
;
3996 state
.text <- Printf.sprintf
"bad irect `%s': %s" v (exntos exn
)
3998 src#
string "throttle"
4000 match conf
.maxwait
with
4001 | None
-> "show place holder if page is not ready"
4004 then "wait for page to fully render"
4006 "wait " ^ string_of_float
time
4007 ^
" seconds before showing placeholder"
4011 let f = float_of_string
v in
4013 then conf
.maxwait
<- None
4014 else conf
.maxwait
<- Some
f
4016 state
.text <- Printf.sprintf
"bad time `%s': %s" v (exntos exn
)
4018 src#
string "ghyll scroll"
4020 match conf
.ghyllscroll
with
4022 | Some nab
-> ghyllscroll_to_string nab
4025 try conf
.ghyllscroll
<- ghyllscroll_of_string
v
4027 state
.text <- Printf.sprintf
"bad ghyll `%s': %s" v (exntos exn
)
4029 src#
string "selection command"
4030 (fun () -> conf
.selcmd
)
4031 (fun v -> conf
.selcmd
<- v);
4032 src#
string "synctex command"
4033 (fun () -> conf
.stcmd
)
4034 (fun v -> conf
.stcmd
<- v);
4035 src#
string "pax command"
4036 (fun () -> conf
.paxcmd
)
4037 (fun v -> conf
.paxcmd
<- v);
4038 src#
string "ask password command"
4039 (fun () -> conf
.passcmd)
4040 (fun v -> conf
.passcmd <- v);
4041 src#
string "save path command"
4042 (fun () -> conf
.savecmd
)
4043 (fun v -> conf
.savecmd
<- v);
4044 src#colorspace
"color space"
4045 (fun () -> CSTE.to_string conf
.colorspace
)
4047 conf
.colorspace
<- CSTE.of_int
v;
4051 src#paxmark
"pax mark method"
4052 (fun () -> MTE.to_string conf
.paxmark
)
4053 (fun v -> conf
.paxmark
<- MTE.of_int
v);
4057 (fun () -> conf
.usepbo
)
4058 (fun v -> conf
.usepbo
<- v);
4059 src#
bool "mouse wheel scrolls pages"
4060 (fun () -> conf
.wheelbypage
)
4061 (fun v -> conf
.wheelbypage
<- v);
4062 src#
bool "open remote links in a new instance"
4063 (fun () -> conf
.riani
)
4064 (fun v -> conf
.riani
<- v);
4068 src#caption
"Document" 0;
4069 List.iter
(fun (_, s) -> src#caption
s 1) state
.docinfo
;
4070 src#caption2
"Pages"
4071 (fun () -> string_of_int state
.pagecount
) 1;
4072 src#caption2
"Dimensions"
4073 (fun () -> string_of_int
(List.length state
.pdims
)) 1;
4077 src#caption
"Trimmed margins" 0;
4078 src#caption2
"Dimensions"
4079 (fun () -> string_of_int
(List.length state
.pdims
)) 1;
4083 src#caption
"OpenGL" 0;
4084 src#caption
(Printf.sprintf
"Vendor\t%s" (GlMisc.get_string `vendor
)) 1;
4085 src#caption
(Printf.sprintf
"Renderer\t%s" (GlMisc.get_string `renderer
)) 1;
4088 src#caption
"Location" 0;
4089 if nonemptystr state
.origin
4090 then src#caption
("Orign\t" ^ mbtoutf8 state
.origin
) 1;
4091 src#caption
("Path\t" ^ mbtoutf8 state
.path
) 1;
4093 src#reset prevmode prevuioh
;
4098 let prevmode = state
.mode
4099 and prevuioh
= state
.uioh in
4100 fillsrc prevmode prevuioh
;
4101 let source = (src :> lvsource
) in
4102 let modehash = findkeyhash conf
"info" in
4103 state
.uioh <- coe (object (self)
4104 inherit listview ~zebra
:false ~helpmode
:false
4105 ~
source ~trusted
:true ~
modehash as super
4106 val mutable m_prevmemused
= 0
4107 method! infochanged
= function
4109 if m_prevmemused
!= state
.memused
4111 m_prevmemused
<- state
.memused
;
4112 G.postRedisplay "memusedchanged";
4114 | Pdim
-> G.postRedisplay "pdimchanged"
4115 | Docinfo
-> fillsrc prevmode prevuioh
4117 method! key key mask
=
4118 if not
(Wsi.withctrl mask
)
4121 | @left | @kpleft
-> coe (self#updownlevel ~
-1)
4122 | @right
| @kpright
-> coe (self#updownlevel
1)
4123 | _ -> super#
key key mask
4124 else super#
key key mask
4126 G.postRedisplay "info";
4132 inherit lvsourcebase
4133 method getitemcount
= Array.length state
.help
4135 let s, l, _ = state
.help
.(n) in
4138 method exit ~
uioh ~cancel ~
active ~
first ~pan
=
4142 match state
.help
.(active) with
4143 | _, _, Action
f -> Some
(f uioh)
4144 | _, _, Noaction
-> Some
uioh
4153 method hasaction
n =
4154 match state
.help
.(n) with
4155 | _, _, Action
_ -> true
4156 | _, _, Noaction
-> false
4162 let modehash = findkeyhash conf
"help" in
4164 state
.uioh <- coe (new listview
4165 ~zebra
:false ~helpmode
:true
4166 ~
source ~trusted
:true ~
modehash);
4167 G.postRedisplay "help";
4173 inherit lvsourcebase
4174 val mutable m_items
= E.a
4176 method getitemcount
= 1 + Array.length m_items
4181 else m_items
.(n-1), 0
4183 method exit ~
uioh ~cancel ~
active ~
first ~pan
=
4188 then Buffer.clear state
.errmsgs
;
4195 method hasaction
n =
4199 state
.newerrmsgs
<- false;
4200 let l = Str.split newlinere
(Buffer.contents state
.errmsgs
) in
4201 m_items
<- Array.of_list
l
4210 let source = (msgsource :> lvsource
) in
4211 let modehash = findkeyhash conf
"listview" in
4212 state
.uioh <- coe (object
4213 inherit listview ~zebra
:false ~helpmode
:false
4214 ~
source ~trusted
:false ~
modehash as super
4217 then msgsource#reset
;
4220 G.postRedisplay "msgs";
4224 let editor = getenvwithdef
"EDITOR" E.s in
4228 let tmppath = Filename.temp_file
"llpp" "note" in
4231 let oc = open_out
tmppath in
4235 let execstr = editor ^
" " ^
tmppath in
4237 match Unix.system
execstr with
4238 | (exception exn
) ->
4240 Printf.sprintf
"Unix.system(%S) failed: %s" execstr (exntos exn
);
4242 | Unix.WEXITED
0 -> filelines
tmppath
4245 Printf.sprintf
"editor process(%s) exited abnormally: %d"
4248 | Unix.WSIGNALED
n ->
4250 Printf.sprintf
"editor process(%s) was killed by signal %d"
4253 | Unix.WSTOPPED
n ->
4255 Printf.sprintf
"editor(%s) process was stopped by signal %d"
4259 match Unix.unlink
tmppath with
4260 | (exception exn
) ->
4262 Printf.sprintf
"failed to ulink %S: %s"
4263 tmppath (exntos exn
);
4268 let enterannotmode opaque slinkindex
=
4271 inherit lvsourcebase
4272 val mutable m_text
= E.s
4273 val mutable m_items
= E.a
4275 method getitemcount
= Array.length m_items
4278 let label, _func
= m_items
.(n) in
4281 method exit ~
uioh ~cancel ~
active ~
first ~pan
=
4282 ignore
(uioh, first, pan
);
4285 let _label, func
= m_items
.(active) in
4290 method hasaction
n = not
@@ emptystr
@@ fst m_items
.(n)
4293 let rec split accu b i
=
4295 if p = String.length
s
4296 then (String.sub
s b (p-b), unit) :: accu
4298 if (i
> 70 && s.[p] = ' '
) || s.[p] = '
\r'
|| s.[p] = '
\n'
4300 let ss = if i
= 0 then E.s else String.sub
s b i
in
4301 split ((ss, unit)::accu) (p+1) 0
4306 wcmd "freepage %s" (~
> opaque);
4308 Hashtbl.fold (fun key opaque'
accu ->
4309 if opaque'
= opaque'
4310 then key :: accu else accu) state
.pagemap
[]
4312 List.iter
(Hashtbl.remove state
.pagemap
) keys;
4317 delannot
opaque slinkindex
;
4320 let edit inline
() =
4325 modannot
opaque slinkindex
s;
4331 let mode = state
.mode in
4334 ("annotation: ", m_text
, None
, textentry, update, true),
4335 fun _ -> state
.mode <- mode);
4339 let s = getusertext m_text
in
4344 ( "[Copy]", fun () -> selstring m_text
)
4345 :: ("[Delete]", dele)
4346 :: ("[Edit]", edit true)
4348 :: split [] 0 0 |> List.rev
|> Array.of_list
4355 let s = getannotcontents
opaque slinkindex
in
4358 let source = (msgsource :> lvsource
) in
4359 let modehash = findkeyhash conf
"listview" in
4360 state
.uioh <- coe (object
4361 inherit listview ~zebra
:false ~helpmode
:false
4362 ~
source ~trusted
:false ~
modehash
4364 G.postRedisplay "enterannotmode";
4367 let gotounder under =
4368 let getpath filename
=
4370 if nonemptystr filename
4372 if Filename.is_relative filename
4374 let dir = Filename.dirname state
.path in
4376 if Filename.is_implicit
dir
4377 then Filename.concat
(Sys.getcwd
()) dir
4380 Filename.concat
dir filename
4384 if Sys.file_exists
path
4389 | Ulinkgoto
(pageno, top) ->
4393 gotopage1 pageno top;
4399 | Uremote
(filename
, pageno) ->
4400 let path = getpath filename
in
4405 let command = Printf.sprintf
"%s -page %d %S" !selfexec pageno path in
4406 try addpid
@@ popen
command []
4408 Printf.eprintf
"failed to execute `%s': %s\n" command (exntos exn
);
4411 let anchor = getanchor
() in
4412 let ranchor = state
.path, state
.password, anchor, state
.origin
in
4413 state
.origin
<- E.s;
4414 state
.anchor <- (pageno, 0.0, 0.0);
4415 state
.ranchors
<- ranchor :: state
.ranchors
;
4418 else showtext '
!'
("Could not find " ^ filename
)
4420 | Uremotedest
(filename
, destname
) ->
4421 let path = getpath filename
in
4426 let command = !selfexec ^
" " ^
path ^
" -dest " ^ destname
in
4427 try addpid
@@ popen
command []
4430 "failed to execute `%s': %s\n" command (exntos exn
);
4433 let anchor = getanchor
() in
4434 let ranchor = state
.path, state
.password, anchor, state
.origin
in
4435 state
.origin
<- E.s;
4436 state
.nameddest
<- destname
;
4437 state
.ranchors
<- ranchor :: state
.ranchors
;
4440 else showtext '
!'
("Could not find " ^ filename
)
4442 | Uunexpected
_ | Ulaunch
_ | Unamed
_ | Utext
_ | Unone
-> ()
4443 | Uannotation
(opaque, slinkindex
) -> enterannotmode opaque slinkindex
4446 let gotooutline (_, _, kind
) =
4450 let (pageno, y, _) = anchor in
4452 (if conf
.presentation
then (pageno, y, 1.0) else anchor)
4456 | Ouri
uri -> gotounder (Ulinkuri
uri)
4457 | Olaunch cmd
-> gotounder (Ulaunch cmd
)
4458 | Oremote remote
-> gotounder (Uremote remote
)
4459 | Ohistory
hist -> gotohist hist
4460 | Oremotedest remotedest
-> gotounder (Uremotedest remotedest
)
4464 let outlinesource sourcetype
=
4466 inherit lvsourcebase
4467 val mutable m_items
= E.a
4468 val mutable m_minfo
= E.a
4469 val mutable m_orig_items
= E.a
4470 val mutable m_orig_minfo
= E.a
4471 val mutable m_narrow_patterns
= []
4472 val mutable m_hadremovals
= false
4473 val mutable m_gen
= -1
4475 method getitemcount
=
4476 Array.length m_items
+ (if m_hadremovals
then 1 else 0)
4479 if n == Array.length m_items
&& m_hadremovals
4481 ("[Confirm removal]", 0)
4483 let s, n, _ = m_items
.(n) in
4486 method exit ~
uioh ~cancel ~
active ~
first ~pan
=
4487 ignore
(uioh, first);
4488 let confrimremoval = m_hadremovals
&& active = Array.length m_items
in
4490 if m_narrow_patterns
= []
4491 then m_orig_items
, m_orig_minfo
4492 else m_items
, m_minfo
4496 if not
confrimremoval
4498 gotooutline m_items
.(active);
4503 state
.bookmarks
<- Array.to_list m_items
;
4504 m_orig_items
<- m_items
;
4505 m_orig_minfo
<- m_minfo
;
4515 method hasaction
_ = true
4518 if Array.length m_items
!= Array.length m_orig_items
4521 match m_narrow_patterns
with
4523 | many
-> String.concat
"@Uellipsis" (List.rev many
)
4525 "Narrowed to " ^
s ^
" (ctrl-u to restore)"
4529 match m_narrow_patterns
with
4532 | head
:: _ -> "@Uellipsis" ^ head
4534 method narrow
pattern =
4535 let reopt = try Some
(Str.regexp_case_fold
pattern) with _ -> None
in
4539 let rec loop accu minfo n =
4542 m_items
<- Array.of_list
accu;
4543 m_minfo
<- Array.of_list
minfo;
4546 let (s, _, t
) as o = m_items
.(n) in
4549 | Oaction
_ -> o :: accu, (0, 0) :: minfo
4550 | Onone
| Oanchor
_ | Ouri
_ | Olaunch
_
4551 | Oremote
_ | Oremotedest
_ | Ohistory
_ ->
4553 try Str.search_forward
re s 0
4554 with Not_found
-> -1
4557 then o :: accu, (first, Str.match_end
()) :: minfo
4560 loop accu minfo (n-1)
4562 loop [] [] (Array.length m_items
- 1)
4564 method! getminfo
= m_minfo
4568 match sourcetype
with
4569 | `bookmarks
-> Array.of_list state
.bookmarks
4570 | `outlines
-> state
.outlines
4571 | `history
-> genhistoutlines !Config.historder
4573 m_minfo
<- m_orig_minfo
;
4574 m_items
<- m_orig_items
4577 if sourcetype
= `bookmarks
4579 if m >= 0 && m < Array.length m_items
4581 m_hadremovals
<- true;
4582 m_items
<- Array.init
(Array.length m_items
- 1) (fun n ->
4583 let n = if n >= m then n+1 else n in
4588 method add_narrow_pattern
pattern =
4589 m_narrow_patterns
<- pattern :: m_narrow_patterns
4591 method del_narrow_pattern
=
4592 match m_narrow_patterns
with
4593 | _ :: rest
-> m_narrow_patterns
<- rest
4598 match m_narrow_patterns
with
4599 | pattern :: [] -> self#narrow
pattern; pattern
4601 List.fold_left
(fun accu pattern ->
4602 self#narrow
pattern;
4603 pattern ^
"@Uellipsis" ^
accu) E.s list
4605 method calcactive
anchor =
4606 let rely = getanchory anchor in
4607 let rec loop n best bestd
=
4608 if n = Array.length m_items
4611 let _, _, kind
= m_items
.(n) in
4614 let orely = getanchory anchor in
4615 let d = abs
(orely - rely) in
4618 else loop (n+1) best bestd
4619 | Onone
| Oremote
_ | Olaunch
_
4620 | Oremotedest
_ | Ouri
_ | Ohistory
_ | Oaction
_ ->
4621 loop (n+1) best bestd
4625 method reset
anchor items =
4626 m_hadremovals
<- false;
4627 if state
.gen
!= m_gen
4629 m_orig_items
<- items;
4631 m_narrow_patterns
<- [];
4633 m_orig_minfo
<- E.a;
4637 if items != m_orig_items
4639 m_orig_items
<- items;
4640 if m_narrow_patterns
== []
4641 then m_items
<- items;
4644 let active = self#calcactive
anchor in
4646 m_first
<- firstof m_first
active
4650 let enterselector sourcetype
=
4652 let source = outlinesource sourcetype
in
4655 match sourcetype
with
4656 | `bookmarks
-> Array.of_list state
.bookmarks
4657 | `
outlines -> state
.outlines
4658 | `history
-> genhistoutlines !Config.historder
4660 if Array.length
outlines = 0
4662 showtext ' ' errmsg
;
4665 state
.text <- source#greetmsg
;
4666 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
4667 let anchor = getanchor
() in
4668 source#reset
anchor outlines;
4670 coe (new outlinelistview ~zebra
:(sourcetype
=`history
) ~
source);
4671 G.postRedisplay "enter selector";
4675 let enteroutlinemode =
4676 let f = enterselector `
outlines in
4677 fun () -> f "Document has no outline";
4680 let enterbookmarkmode =
4681 let f = enterselector `bookmarks
in
4682 fun () -> f "Document has no bookmarks (yet)";
4685 let enterhistmode () = enterselector `history
"No history (yet)";;
4687 let quickbookmark ?title
() =
4688 match state
.layout with
4694 let tm = Unix.localtime
(now
()) in
4695 Printf.sprintf
"Quick (page %d) (bookmarked at %d/%d/%d %d:%d)"
4699 (tm.Unix.tm_year
+ 1900)
4702 | Some
title -> title
4704 state
.bookmarks
<- (title, 0, Oanchor
(getanchor1
l)) :: state
.bookmarks
4707 let setautoscrollspeed step goingdown
=
4708 let incr = max
1 ((abs step
) / 2) in
4709 let incr = if goingdown
then incr else -incr in
4710 let astep = boundastep state
.winh
(step
+ incr) in
4711 state
.autoscroll
<- Some
astep;
4715 match conf
.columns
with
4717 | Csingle
_ | Cmulti
_ -> state
.x != 0 || conf
.zoom > 1.0
4720 let panbound x = bound
x (-state
.w) (wadjsb () + state
.winw
);;
4722 let existsinrow pageno (columns
, coverA
, coverB
) p =
4723 let last = ((pageno - coverA
) mod columns
) + columns
in
4724 let rec any = function
4727 if l.pageno = coverA
- 1 || l.pageno = state
.pagecount
- coverB
4731 then (if l.pageno = last then false else any rest
)
4739 match state
.layout with
4741 let pageno = page_of_y state
.y in
4742 gotoghyll (getpagey
(pageno+1))
4744 match conf
.columns
with
4746 if conf
.presentation
&& rest
== [] && l.pageh
> l.pagey + l.pagevh
4748 let y = clamp (pgscale state
.winh
) in
4751 let pageno = min
(l.pageno+1) (state
.pagecount
-1) in
4752 gotoghyll (getpagey
pageno)
4753 | Cmulti
((c, _, _) as cl, _) ->
4754 if conf
.presentation
4755 && (existsinrow l.pageno cl
4756 (fun l -> l.pageh
> l.pagey + l.pagevh))
4758 let y = clamp (pgscale state
.winh
) in
4761 let pageno = min
(l.pageno+c) (state
.pagecount
-1) in
4762 gotoghyll (getpagey
pageno)
4764 if l.pageno < state
.pagecount
- 1 || l.pagecol
< n - 1
4766 let pagey, pageh
= getpageyh
l.pageno in
4767 let pagey = pagey + pageh
* l.pagecol
in
4768 let ips = if l.pagecol
= 0 then 0 else conf
.interpagespace
in
4769 gotoghyll (pagey + pageh
+ ips)
4773 match state
.layout with
4775 let pageno = page_of_y state
.y in
4776 gotoghyll (getpagey
(pageno-1))
4778 match conf
.columns
with
4780 if conf
.presentation
&& l.pagey != 0
4782 gotoghyll (clamp (pgscale ~
-(state
.winh
)))
4784 let pageno = max
0 (l.pageno-1) in
4785 gotoghyll (getpagey
pageno)
4786 | Cmulti
((c, _, coverB
) as cl, _) ->
4787 if conf
.presentation
&&
4788 (existsinrow l.pageno cl (fun l -> l.pagey != 0))
4790 gotoghyll (clamp (pgscale ~
-(state
.winh
)))
4793 if l.pageno = state
.pagecount
- coverB
4797 let pageno = max
0 (l.pageno-decr) in
4798 gotoghyll (getpagey
pageno)
4806 let pageno = max
0 (l.pageno-1) in
4807 let pagey, pageh
= getpageyh
pageno in
4810 let pagey, pageh
= getpageyh
l.pageno in
4811 pagey + pageh
* (l.pagecol
-1) - conf
.interpagespace
4817 if emptystr conf
.savecmd
4818 then error
"don't know where to save modified document"
4820 let command = Str.global_replace percentsre state
.path conf
.savecmd
in
4821 match Unix.open_process_in
command with
4822 | (exception exn
) ->
4824 (Printf.sprintf
"savecmd open_process_in failed: %s"
4827 let path = try input_line ic
with End_of_file
-> E.s in
4829 match Unix.close_process_in ic
with
4830 | (exception exn
) ->
4831 error
"error obtaining save path: %s" (exntos exn
)
4834 let tmp = path ^
".tmp" in
4836 Unix.rename
tmp path;
4839 let viewkeyboard key mask
=
4841 let mode = state
.mode in
4842 state
.mode <- Textentry
(te, fun _ -> state
.mode <- mode);
4845 G.postRedisplay "view:enttext"
4847 let ctrl = Wsi.withctrl mask
in
4849 if key >= 0xffb0 && key < 0xffb9 then key - 0xffb0 + 48 else key
4855 if hasunsavedchanges
()
4859 if conf
.angle
mod 360 = 0 && not
(isbirdseye state
.mode)
4861 state
.mode <- LinkNav
(Ltgendir
0);
4864 else showtext '
!'
"Keyboard link navigation does not work under rotation"
4867 begin match state
.mstate
with
4870 G.postRedisplay "kill rect";
4873 | Mscrolly
| Mscrollx
4876 begin match state
.mode with
4879 G.postRedisplay "esc leave linknav"
4883 match state
.ranchors
with
4885 | (path, password, anchor, origin
) :: rest
->
4886 state
.ranchors
<- rest
;
4887 state
.anchor <- anchor;
4888 state
.origin
<- origin
;
4889 state
.nameddest
<- E.s;
4890 opendoc path password
4895 gotoghyll (getnav ~
-1)
4906 Hashtbl.iter
(fun _ opaque -> clearmark
opaque) state
.pagemap
;
4907 G.postRedisplay "dehighlight";
4909 | @slash
| @question
->
4910 let ondone isforw
s =
4911 cbput state
.hists
.pat
s;
4912 state
.searchpattern
<- s;
4915 let s = String.make
1 (Char.chr
key) in
4916 enttext (s, E.s, Some
(onhist state
.hists
.pat
),
4917 textentry, ondone (key = @slash
), true)
4919 | @plus
| @kpplus
| @equals
when ctrl ->
4920 let incr = if conf
.zoom +. 0.01 > 0.1 then 0.1 else 0.01 in
4921 setzoom (conf
.zoom +. incr)
4923 | @plus
| @kpplus
->
4926 try int_of_string
s with exc
->
4927 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
);
4933 state
.text <- "page bias is now " ^ string_of_int
n;
4936 enttext ("page bias: ", E.s, None
, intentry, ondone, true)
4938 | @minus
| @kpminus
when ctrl ->
4939 let decr = if conf
.zoom -. 0.1 < 0.1 then 0.01 else 0.1 in
4940 setzoom (max
0.01 (conf
.zoom -. decr))
4942 | @minus
| @kpminus
->
4943 let ondone msg
= state
.text <- msg
in
4945 "option [acfhilpstvxACFPRSZTISM]: ", E.s, None
,
4946 optentry state
.mode, ondone, true
4957 | (@1 | @2) when ctrl && conf
.fitmodel
!= FitPage
-> (* ctrl-1/2 *)
4959 match conf
.columns
with
4960 | Csingle
_ | Cmulti
_ -> 1
4961 | Csplit
(n, _) -> n
4963 let h = state
.winh
-
4964 conf
.interpagespace
lsl (if conf
.presentation
then 1 else 0)
4966 let zoom = zoomforh state
.winw
h (vscrollw ()) cols in
4967 if zoom > 0.0 && (key = 50 || zoom < 1.0)
4972 match conf
.fitmodel
with
4973 | FitWidth
-> FitProportional
4974 | FitProportional
-> FitPage
4975 | FitPage
-> FitWidth
4977 state
.text <- "fit model: " ^
FMTE.to_string
fm;
4978 reqlayout conf
.angle
fm
4986 | (48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57)
4987 when not
ctrl -> (* 0..9 *)
4990 try int_of_string
s with exc
->
4991 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
);
4997 cbput state
.hists
.pag
(string_of_int
n);
4998 gotopage1 (n + conf
.pagebias
- 1) 0;
5001 let pageentry text key =
5002 match Char.unsafe_chr
key with
5003 | '
g'
-> TEdone
text
5004 | _ -> intentry text key
5006 let text = String.make
1 (Char.chr
key) in
5007 enttext (":", text, Some
(onhist state
.hists
.pag
),
5008 pageentry, ondone, true)
5011 conf
.scrollb
<- if conf
.scrollb
= 0 then (scrollbvv
lor scrollbhv
) else 0;
5012 reshape state
.winw state
.winh
;
5015 state
.bzoom
<- not state
.bzoom
;
5017 showtext ' '
("block zoom " ^
if state
.bzoom
then "on" else "off")
5020 conf
.hlinks
<- not conf
.hlinks
;
5021 state
.text <- "highlightlinks " ^
if conf
.hlinks
then "on" else "off";
5022 G.postRedisplay "toggle highlightlinks";
5025 state
.glinks
<- true;
5026 let mode = state
.mode in
5027 state
.mode <- Textentry
(
5028 (":", E.s, None
, linknentry, linkndone gotounder, false),
5030 state
.glinks
<- false;
5034 G.postRedisplay "view:linkent(F)"
5037 state
.glinks
<- true;
5038 let mode = state
.mode in
5039 state
.mode <- Textentry
(
5041 ":", E.s, None
, linknentry, linkndone (fun under ->
5042 selstring (undertext under);
5046 state
.glinks
<- false;
5050 G.postRedisplay "view:linkent"
5053 begin match state
.autoscroll
with
5055 conf
.autoscrollstep
<- step
;
5056 state
.autoscroll
<- None
5058 if conf
.autoscrollstep
= 0
5059 then state
.autoscroll
<- Some
1
5060 else state
.autoscroll
<- Some conf
.autoscrollstep
5067 setpresentationmode (not conf
.presentation
);
5068 showtext ' '
("presentation mode " ^
5069 if conf
.presentation
then "on" else "off");
5072 if List.mem
Wsi.Fullscreen state
.winstate
5073 then Wsi.reshape conf
.cwinw conf
.cwinh
5074 else Wsi.fullscreen
()
5077 search state
.searchpattern
false
5080 search state
.searchpattern
true
5083 begin match state
.layout with
5086 gotoghyll (getpagey
l.pageno)
5092 | @delete
| @kpdelete
-> (* delete *)
5096 showtext ' '
(describe_location ());
5099 begin match state
.layout with
5102 Wsi.reshape (l.pagew
+ vscrollw ()) l.pageh
;
5107 enterbookmarkmode ()
5115 | @e when Buffer.length state
.errmsgs
> 0 ->
5120 match state
.layout with
5125 (s, 0, Oanchor
(getanchor1
l)) :: state
.bookmarks
5128 enttext ("bookmark: ", E.s, None
, textentry, ondone, true)
5132 showtext ' '
"Quick bookmark added";
5135 begin match state
.layout with
5137 let rect = getpdimrect
l.pagedimno
in
5141 (truncate
(1.8 *. (rect.(1) -. rect.(0))),
5142 truncate
(1.2 *. (rect.(3) -. rect.(0))))
5144 (truncate
(rect.(1) -. rect.(0)),
5145 truncate
(rect.(3) -. rect.(0)))
5147 let w = truncate
((float w)*.conf
.zoom)
5148 and h = truncate
((float h)*.conf
.zoom) in
5151 state
.anchor <- getanchor
();
5152 Wsi.reshape (w + vscrollw ()) (h + conf
.interpagespace
)
5154 G.postRedisplay "z";
5159 | @x -> state
.roam
()
5162 reqlayout (conf
.angle
+
5163 (if key = @Gt
then 30 else -30)) conf
.fitmodel
5167 bound
(conf
.colorscale
+. (if key = 93 then 0.1 else -0.1)) 0.0 1.0
5169 G.postRedisplay "brightness";
5171 | @c when state
.mode = View
->
5176 let m = (wadjsb () + state
.winw
- state
.w) / 2 in
5178 gotoy_and_clear_text state
.y
5182 match state
.prevcolumns
with
5183 | None
-> (1, 0, 0), 1.0
5184 | Some
(columns
, z
) ->
5187 | Csplit
(c, _) -> -c, 0, 0
5188 | Cmulti
((c, a, b), _) -> c, a, b
5189 | Csingle
_ -> 1, 0, 0
5193 setcolumns View
c a b;
5196 | @down
| @up
when ctrl && Wsi.withshift mask
->
5197 let zoom, x = state
.prevzoom
in
5201 | @k
| @up
| @kpup
->
5202 begin match state
.autoscroll
with
5204 begin match state
.mode with
5205 | Birdseye beye
-> upbirdseye 1 beye
5210 then gotoy_and_clear_text (clamp ~
-(state
.winh
/2))
5212 if not
(Wsi.withshift mask
) && conf
.presentation
5214 else gotoghyll1 true (clamp (-conf
.scrollstep
))
5218 setautoscrollspeed n false
5221 | @j
| @down
| @kpdown
->
5222 begin match state
.autoscroll
with
5224 begin match state
.mode with
5225 | Birdseye beye
-> downbirdseye 1 beye
5230 then gotoy_and_clear_text (clamp (state
.winh
/2))
5232 if not
(Wsi.withshift mask
) && conf
.presentation
5234 else gotoghyll1 true (clamp (conf
.scrollstep
))
5238 setautoscrollspeed n true
5241 | @left | @right
| @kpleft
| @kpright
when not
(Wsi.withalt mask
) ->
5247 else conf
.hscrollstep
5249 let dx = if key = @left || key = @kpleft
then dx else -dx in
5250 state
.x <- panbound (state
.x + dx);
5251 gotoy_and_clear_text state
.y
5254 G.postRedisplay "left/right"
5257 | @prior
| @kpprior
->
5261 match state
.layout with
5263 | l :: _ -> state
.y - l.pagey
5265 clamp (pgscale (-state
.winh
))
5269 | @next | @kpnext
->
5273 match List.rev state
.layout with
5275 | l :: _ -> getpagey
l.pageno
5277 clamp (pgscale state
.winh
)
5281 | @g | @home
| @kphome
->
5284 | @G
| @jend
| @kpend
->
5286 gotoghyll (clamp state
.maxy)
5288 | @right
| @kpright
when Wsi.withalt mask
->
5289 gotoghyll (getnav 1)
5290 | @left | @kpleft
when Wsi.withalt mask
->
5291 gotoghyll (getnav ~
-1)
5296 | @v when conf
.debug
->
5299 match getopaque l.pageno with
5302 let x0, y0, x1, y1 = pagebbox
opaque in
5303 let a,b = float x0, float y0 in
5304 let c,d = float x1, float y0 in
5305 let e,f = float x1, float y1 in
5306 let h,j
= float x0, float y1 in
5307 let rect = (a,b,c,d,e,f,h,j
) in
5309 state
.rects
<- (l.pageno, l.pageno mod 3, rect) :: state
.rects
;
5311 G.postRedisplay "v";
5314 let mode = state
.mode in
5315 let cmd = ref E.s in
5316 let onleave = function
5317 | Cancel
-> state
.mode <- mode
5320 match getopaque l.pageno with
5321 | Some
opaque -> pipesel opaque !cmd
5322 | None
-> ()) state
.layout;
5326 cbput state
.hists
.sel
s;
5330 "| ", !cmd, Some
(onhist state
.hists
.sel
), textentry, ondone, true
5332 G.postRedisplay "|";
5333 state
.mode <- Textentry
(te, onleave);
5336 vlog "huh? %s" (Wsi.keyname
key)
5339 let linknavkeyboard key mask
linknav =
5340 let getpage pageno =
5341 let rec loop = function
5343 | l :: _ when l.pageno = pageno -> Some
l
5344 | _ :: rest
-> loop rest
5345 in loop state
.layout
5347 let doexact (pageno, n) =
5348 match getopaque pageno, getpage pageno with
5349 | Some
opaque, Some
l ->
5350 if key = @enter
|| key = @kpenter
5352 let under = getlink
opaque n in
5353 G.postRedisplay "link gotounder";
5360 Some
(findlink
opaque LDfirst
), -1
5363 Some
(findlink
opaque LDlast
), 1
5366 Some
(findlink
opaque (LDleft
n)), -1
5369 Some
(findlink
opaque (LDright
n)), 1
5372 Some
(findlink
opaque (LDup
n)), -1
5375 Some
(findlink
opaque (LDdown
n)), 1
5380 begin match findpwl
l.pageno dir with
5384 state
.mode <- LinkNav
(Ltgendir
dir);
5385 let y, h = getpageyh
pageno in
5388 then y + h - state
.winh
5393 begin match getopaque pageno, getpage pageno with
5394 | Some
opaque, Some
_ ->
5396 let ld = if dir > 0 then LDfirst
else LDlast
in
5399 begin match link with
5401 showlinktype (getlink
opaque m);
5402 state
.mode <- LinkNav
(Ltexact
(pageno, m));
5403 G.postRedisplay "linknav jpage";
5404 | Lnotfound
-> notfound dir
5410 begin match opt with
5411 | Some Lnotfound
-> pwl l dir;
5412 | Some
(Lfound
m) ->
5416 let _, y0, _, y1 = getlinkrect
opaque m in
5418 then gotopage1 l.pageno y0
5420 let d = fstate
.fontsize
+ 1 in
5421 if y1 - l.pagey > l.pagevh - d
5422 then gotopage1 l.pageno (y1 - state
.winh
- hscrollh () + d)
5423 else G.postRedisplay "linknav";
5425 showlinktype (getlink
opaque m);
5426 state
.mode <- LinkNav
(Ltexact
(l.pageno, m));
5429 | None
-> viewkeyboard key mask
5431 | _ -> viewkeyboard key mask
5436 G.postRedisplay "leave linknav"
5440 | Ltgendir
_ | Ltnotready
_ -> viewkeyboard key mask
5441 | Ltexact exact
-> doexact exact
5444 let keyboard key mask
=
5445 if (key = 103 && Wsi.withctrl mask
) && not
(istextentry state
.mode)
5446 then wcmd "interrupt"
5447 else state
.uioh <- state
.uioh#
key key mask
5450 let birdseyekeyboard key mask
5451 ((oconf
, leftx
, pageno, hooverpageno
, anchor) as beye
) =
5453 match conf
.columns
with
5455 | Cmulti
((c, _, _), _) -> c
5456 | Csplit
_ -> failwith
"bird's eye split mode"
5458 let pgh layout = List.fold_left
5459 (fun m l -> max
l.pageh
m) state
.winh
layout in
5461 | @l when Wsi.withctrl mask
->
5462 let y, h = getpageyh
pageno in
5463 let top = (state
.winh
- h) / 2 in
5464 gotoy (max
0 (y - top))
5465 | @enter
| @kpenter
-> leavebirdseye beye
false
5466 | @escape
-> leavebirdseye beye
true
5467 | @up
-> upbirdseye incr beye
5468 | @down
-> downbirdseye incr beye
5469 | @left -> upbirdseye 1 beye
5470 | @right
-> downbirdseye 1 beye
5473 begin match state
.layout with
5477 state
.mode <- Birdseye
(
5478 oconf
, leftx
, l.pageno, hooverpageno
, anchor
5480 gotopage1 l.pageno 0;
5483 let layout = layout (state
.y-state
.winh
) (pgh state
.layout) in
5485 | [] -> gotoy (clamp (-state
.winh
))
5487 state
.mode <- Birdseye
(
5488 oconf
, leftx
, l.pageno, hooverpageno
, anchor
5490 gotopage1 l.pageno 0
5493 | [] -> gotoy (clamp (-state
.winh
))
5497 begin match List.rev state
.layout with
5499 let layout = layout (state
.y + (pgh state
.layout)) state
.winh
in
5500 begin match layout with
5502 let incr = l.pageh
- l.pagevh in
5507 oconf
, leftx
, state
.pagecount
- 1, hooverpageno
, anchor
5509 G.postRedisplay "birdseye pagedown";
5511 else gotoy (clamp (incr + conf
.interpagespace
*2));
5515 Birdseye
(oconf
, leftx
, l.pageno, hooverpageno
, anchor);
5516 gotopage1 l.pageno 0;
5519 | [] -> gotoy (clamp state
.winh
)
5523 state
.mode <- Birdseye
(oconf
, leftx
, 0, hooverpageno
, anchor);
5527 let pageno = state
.pagecount
- 1 in
5528 state
.mode <- Birdseye
(oconf
, leftx
, pageno, hooverpageno
, anchor);
5529 if not
(pagevisible state
.layout pageno)
5532 match List.rev state
.pdims
with
5534 | (_, _, h, _) :: _ -> h
5536 gotoy (max
0 (getpagey
pageno - (state
.winh
- h - conf
.interpagespace
)))
5537 else G.postRedisplay "birdseye end";
5539 | _ -> viewkeyboard key mask
5544 match state
.mode with
5545 | Textentry
_ -> scalecolor 0.4
5547 | View
-> scalecolor 1.0
5548 | Birdseye
(_, _, pageno, hooverpageno
, _) ->
5549 if l.pageno = hooverpageno
5552 if l.pageno = pageno
5554 let c = scalecolor 1.0 in
5556 GlDraw.line_width
3.0;
5557 let dispx = xadjsb () + l.pagedispx in
5559 (float (dispx-1)) (float (l.pagedispy-1))
5560 (float (dispx+l.pagevw+1))
5561 (float (l.pagedispy+l.pagevh+1))
5563 GlDraw.line_width
1.0;
5572 let postdrawpage l linkindexbase
=
5573 match getopaque l.pageno with
5575 if tileready l l.pagex
l.pagey
5577 let x = l.pagedispx - l.pagex
+ xadjsb ()
5578 and y = l.pagedispy - l.pagey in
5580 match conf
.columns
with
5581 | Csingle
_ | Cmulti
_ ->
5582 (if conf
.hlinks
then 1 else 0)
5584 && not
(isbirdseye state
.mode) then 2 else 0)
5588 match state
.mode with
5589 | Textentry
((_, s, _, _, _, _), _) when state
.glinks
-> s
5595 postprocess
opaque hlmask x y (linkindexbase
, s, conf
.hfsize
);
5600 let scrollindicator () =
5601 let sbw, ph
, sh = state
.uioh#
scrollph in
5602 let sbh, pw, sw = state
.uioh#scrollpw
in
5607 else ((state
.winw
- sbw), state
.winw
, 0)
5610 GlDraw.color (0.64, 0.64, 0.64);
5611 filledrect (float x0) 0. (float x1) (float state
.winh
);
5613 (float hx0
) (float (state
.winh
- sbh))
5614 (float (hx0
+ wadjsb () + state
.winw
)) (float state
.winh
)
5616 GlDraw.color (0.0, 0.0, 0.0);
5618 filledrect (float x0) ph
(float x1) (ph
+. sh);
5619 let pw = pw +. float hx0
in
5620 filledrect pw (float (state
.winh
- sbh)) (pw +. sw) (float state
.winh
);
5624 match state
.mstate
with
5625 | Mnone
| Mscrolly
| Mscrollx
| Mpan
_ | Mzoom
_ | Mzoomrect
_ ->
5628 | Msel
((x0, y0), (x1, y1)) ->
5629 let identify opaque l px py = Some
(opaque, l.pageno, px, py) in
5630 let o0,n0
,px0
,py0
= onppundermouse identify x0 y0 (~
< E.s, -1, 0, 0) in
5631 let _o1,n1
,px1
,py1
= onppundermouse identify x1 y1 (~
< E.s, -1, 0, 0) in
5632 if n0
!= -1 && n0
= n1
then seltext
o0 (px0
, py0
, px1
, py1
);
5635 let showrects = function [] -> () | rects
->
5637 GlDraw.color (0.0, 0.0, 1.0) ~
alpha:0.5;
5638 GlFunc.blend_func ~
src:`src_alpha ~dst
:`one_minus_src_alpha
;
5640 (fun (pageno, c, (x0, y0, x1, y1, x2
, y2
, x3
, y3
)) ->
5642 if l.pageno = pageno
5644 let dx = float (l.pagedispx - l.pagex
) in
5645 let dy = float (l.pagedispy - l.pagey) in
5646 GlDraw.color (0.0, 0.0, 1.0 /. float c) ~
alpha:0.5;
5647 Raw.sets_float state
.vraw ~
pos:0
5652 GlArray.vertex `two state
.vraw
;
5653 GlArray.draw_arrays `triangle_strip ~
first:0 ~count
:4;
5662 GlClear.color (scalecolor2 conf
.bgcolor
);
5663 GlClear.clear
[`
color];
5664 List.iter
drawpage state
.layout;
5666 match state
.mode with
5667 | LinkNav
(Ltexact
(pageno, linkno
)) ->
5668 begin match getopaque pageno with
5670 let dx = xadjsb () in
5671 let x0, y0, x1, y1 = getlinkrect
opaque linkno
in
5672 let x0 = x0 + dx and x1 = x1 + dx in
5679 | None
-> state
.rects
5681 | LinkNav
(Ltgendir
_) | LinkNav
(Ltnotready
_)
5684 | View
-> state
.rects
5687 let rec postloop linkindexbase
= function
5689 let linkindexbase = linkindexbase + postdrawpage l linkindexbase in
5690 postloop linkindexbase rest
5694 postloop 0 state
.layout;
5696 begin match state
.mstate
with
5697 | Mzoomrect
((x0, y0), (x1, y1)) ->
5699 GlDraw.color (0.3, 0.3, 0.3) ~
alpha:0.5;
5700 GlFunc.blend_func ~
src:`src_alpha ~dst
:`one_minus_src_alpha
;
5701 filledrect (float x0) (float y0) (float x1) (float y1);
5705 | Mscrolly
| Mscrollx
5714 let zoomrect x y x1 y1 =
5717 and y0 = min
y y1 in
5718 gotoy (state
.y + y0);
5719 state
.anchor <- getanchor
();
5720 let zoom = (float state
.w) /. float (x1 - x0) in
5723 let adjw = wadjsb () + state
.winw
in
5725 then (adjw - state
.w) / 2
5728 match conf
.fitmodel
with
5729 | FitWidth
| FitProportional
-> simple ()
5731 match conf
.columns
with
5733 onppundermouse (fun _ l _ _ -> Some
l.pagedispx) x0 y0 x0
5734 | Cmulti
_ | Csingle
_ -> simple ()
5736 state
.x <- (state
.x + margin) - x0;
5741 let annot inline
x y =
5742 match unproject x y with
5743 | Some
(opaque, n, ux
, uy
) ->
5745 addannot
opaque ux uy
text;
5746 wcmd "freepage %s" (~
> opaque);
5747 Hashtbl.remove state
.pagemap
(n, state
.gen
);
5753 let ondone s = add s in
5754 let mode = state
.mode in
5755 state
.mode <- Textentry
(
5756 ("annotation: ", E.s, None
, textentry, ondone, true),
5757 fun _ -> state
.mode <- mode);
5760 G.postRedisplay "annot"
5763 let s = getusertext E.s in
5764 let l = Str.split newlinere
s in
5772 let g opaque l px py =
5773 match rectofblock
opaque px py with
5775 let x0 = a.(0) -. 20. in
5776 let x1 = a.(1) +. 20. in
5777 let y0 = a.(2) -. 20. in
5778 let zoom = (float state
.w) /. (x1 -. x0) in
5779 let pagey = getpagey
l.pageno in
5780 gotoy_and_clear_text (pagey + truncate
y0);
5781 state
.anchor <- getanchor
();
5782 let margin = (state
.w - l.pagew
)/2 in
5783 state
.x <- -truncate
x0 - margin;
5788 match conf
.columns
with
5790 showtext '
!'
"block zooming does not work properly in split columns mode"
5791 | Cmulti
_ | Csingle
_ -> onppundermouse g x y ()
5795 let winw = wadjsb () + state
.winw - 1 in
5796 let s = float x /. float winw in
5797 let destx = truncate
(float (state
.w + winw) *. s) in
5798 state
.x <- winw - destx;
5799 gotoy_and_clear_text state
.y;
5800 state
.mstate
<- Mscrollx
;
5804 let s = float y /. float state
.winh
in
5805 let desty = truncate
(float (state
.maxy - state
.winh
) *. s) in
5806 gotoy_and_clear_text desty;
5807 state
.mstate
<- Mscrolly
;
5810 let viewmulticlick clicks
x y mask
=
5811 let g opaque l px py =
5819 if markunder
opaque px py mark
5823 match getopaque l.pageno with
5825 | Some
opaque -> pipesel opaque cmd
5827 state
.roam
<- (fun () -> dopipe conf
.paxcmd
);
5828 if not
(Wsi.withctrl mask
) then dopipe conf
.selcmd
;
5833 G.postRedisplay "viewmulticlick";
5834 onppundermouse g x y (fun () -> showtext '
!'
"Nothing to select") ();
5838 match conf
.columns
with
5840 | Csingle
_ | Cmulti
_ -> conf
.angle
mod 360 = 0
5843 let viewmouse button down
x y mask
=
5845 | n when (n == 4 || n == 5) && not down
->
5846 if Wsi.withctrl mask
5848 match state
.mstate
with
5849 | Mzoom
(oldn
, i
) ->
5857 if conf
.zoom +. 0.01 > 0.1 then 0.1 else 0.01
5859 if conf
.zoom -. 0.1 < 0.1 then -0.01 else -0.1
5861 let zoom = conf
.zoom -. incr in
5863 state
.mstate
<- Mzoom
(n, 0);
5865 state
.mstate
<- Mzoom
(n, i
+1);
5867 else state
.mstate
<- Mzoom
(n, 0)
5871 | Mscrolly
| Mscrollx
5873 | Mnone
-> state
.mstate
<- Mzoom
(n, 0)
5876 match state
.autoscroll
with
5877 | Some step
-> setautoscrollspeed step
(n=4)
5879 if conf
.wheelbypage
|| conf
.presentation
5888 then -conf
.scrollstep
5889 else conf
.scrollstep
5891 let incr = incr * 2 in
5892 let y = clamp incr in
5893 gotoy_and_clear_text y
5896 | n when (n = 6 || n = 7) && not down
&& canpan () ->
5898 panbound (state
.x + (if n = 7 then -2 else 2) * conf
.hscrollstep
);
5899 gotoy_and_clear_text state
.y
5901 | 1 when Wsi.withshift mask
->
5902 state
.mstate
<- Mnone
;
5905 match unproject x y with
5906 | Some
(_, pageno, ux
, uy
) ->
5907 let cmd = Printf.sprintf
5909 conf
.stcmd state
.path pageno ux uy
5911 addpid
@@ popen
cmd []
5915 | 1 when Wsi.withctrl mask
->
5918 Wsi.setcursor
Wsi.CURSOR_CROSSHAIR
;
5919 state
.mstate
<- Mpan
(x, y)
5922 state
.mstate
<- Mnone
5927 if Wsi.withshift mask
5929 annot (not
(Wsi.withctrl mask
)) x y;
5930 G.postRedisplay "addannot"
5934 Wsi.setcursor
Wsi.CURSOR_CYCLE
;
5935 state
.mstate
<- Mzoomrect
(p, p)
5938 match state
.mstate
with
5939 | Mzoomrect
((x0, y0), _) ->
5940 if abs
(x-x0) > 10 && abs
(y - y0) > 10
5941 then zoomrect x0 y0 x y
5944 G.postRedisplay "kill accidental zoom rect";
5948 | Mscrolly
| Mscrollx
5954 | 1 when x > state
.winw - vscrollw () ->
5957 let _, position, sh = state
.uioh#
scrollph in
5958 if y > truncate
position && y < truncate
(position +. sh)
5959 then state
.mstate
<- Mscrolly
5962 state
.mstate
<- Mnone
5964 | 1 when y > state
.winh
- hscrollh () ->
5967 let _, position, sw = state
.uioh#scrollpw
in
5968 if x > truncate
position && x < truncate
(position +. sw)
5969 then state
.mstate
<- Mscrollx
5972 state
.mstate
<- Mnone
5974 | 1 when state
.bzoom
-> if not down
then zoomblock x y
5977 let dest = if down
then getunder x y else Unone
in
5978 begin match dest with
5981 | Uremote
_ | Uremotedest
_
5982 | Uunexpected
_ | Ulaunch
_ | Unamed
_ ->
5985 | Unone
when down
->
5986 Wsi.setcursor
Wsi.CURSOR_CROSSHAIR
;
5987 state
.mstate
<- Mpan
(x, y);
5989 | Uannotation
(opaque, slinkindex
) -> enterannotmode opaque slinkindex
5991 | Unone
| Utext
_ ->
5996 state
.mstate
<- Msel
((x, y), (x, y));
5997 G.postRedisplay "mouse select";
6001 match state
.mstate
with
6004 | Mzoom
_ | Mscrollx
| Mscrolly
->
6005 state
.mstate
<- Mnone
6007 | Mzoomrect
((x0, y0), _) ->
6011 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
6012 state
.mstate
<- Mnone
6014 | Msel
((x0, y0), (x1, y1)) ->
6015 let rec loop = function
6019 let a0 = l.pagedispy in
6020 let a1 = a0 + l.pagevh in
6021 let b0 = l.pagedispx in
6022 let b1 = b0 + l.pagevw in
6023 ((y0 >= a0 && y0 <= a1) || (y1 >= a0 && y1 <= a1))
6024 && ((x0 >= b0 && x0 <= b1) || (x1 >= b0 && x1 <= b1))
6028 match getopaque l.pageno with
6031 match Unix.pipe
() with
6035 "can not create sel pipe: %s"
6039 Ne.clo fd
(fun msg
->
6040 dolog
"%s close failed: %s" what msg
)
6043 try popen
cmd [r
, 0; w, -1]
6045 dolog
"can not execute %S: %s"
6053 G.postRedisplay "copysel";
6055 else clo "Msel pipe/w" w;
6056 clo "Msel pipe/r" r
;
6058 dosel conf
.selcmd
();
6059 state
.roam
<- dosel conf
.paxcmd
;
6071 let birdseyemouse button down
x y mask
6072 (conf
, leftx
, _, hooverpageno
, anchor) =
6075 let rec loop = function
6078 if y > l.pagedispy && y < l.pagedispy + l.pagevh
6079 && x > l.pagedispx && x < l.pagedispx + l.pagevw
6081 leavebirdseye (conf
, leftx
, l.pageno, hooverpageno
, anchor) false;
6087 | _ -> viewmouse button down
x y mask
6093 method key key mask
=
6094 begin match state
.mode with
6095 | Textentry
textentry -> textentrykeyboard key mask
textentry
6096 | Birdseye
birdseye -> birdseyekeyboard key mask
birdseye
6097 | View
-> viewkeyboard key mask
6098 | LinkNav
linknav -> linknavkeyboard key mask
linknav
6102 method button button bstate
x y mask
=
6103 begin match state
.mode with
6105 | View
-> viewmouse button bstate
x y mask
6106 | Birdseye beye
-> birdseyemouse button bstate
x y mask beye
6111 method multiclick clicks
x y mask
=
6112 begin match state
.mode with
6114 | View
-> viewmulticlick clicks
x y mask
6121 begin match state
.mode with
6123 | View
| Birdseye
_ | LinkNav
_ ->
6124 match state
.mstate
with
6125 | Mzoom
_ | Mnone
-> ()
6130 state
.mstate
<- Mpan
(x, y);
6132 then state
.x <- panbound (state
.x + dx);
6134 gotoy_and_clear_text y
6137 state
.mstate
<- Msel
(a, (x, y));
6138 G.postRedisplay "motion select";
6141 let y = min state
.winh
(max
0 y) in
6145 let x = min state
.winw (max
0 x) in
6148 | Mzoomrect
(p0
, _) ->
6149 state
.mstate
<- Mzoomrect
(p0
, (x, y));
6150 G.postRedisplay "motion zoomrect";
6154 method pmotion
x y =
6155 begin match state
.mode with
6156 | Birdseye
(conf
, leftx
, pageno, hooverpageno
, anchor) ->
6157 let rec loop = function
6159 if hooverpageno
!= -1
6161 state
.mode <- Birdseye
(conf
, leftx
, pageno, -1, anchor);
6162 G.postRedisplay "pmotion birdseye no hoover";
6165 if y > l.pagedispy && y < l.pagedispy + l.pagevh
6166 && x > l.pagedispx && x < l.pagedispx + l.pagevw
6168 state
.mode <- Birdseye
(conf
, leftx
, pageno, l.pageno, anchor);
6169 G.postRedisplay "pmotion birdseye hoover";
6179 match state
.mstate
with
6180 | Mpan
_ | Msel
_ | Mzoom
_ | Mscrolly
| Mscrollx
| Mzoomrect
_ -> ()
6188 let past, _, _ = !r
in
6190 let delta = now -. past in
6193 else r
:= (now, x, y)
6197 method infochanged
_ = ()
6200 let maxy = state
.maxy - (if conf
.maxhfit
then state
.winh
else 0) in
6203 then 0.0, float state
.winh
6204 else scrollph state
.y maxy
6209 let winw = wadjsb () + state
.winw in
6210 let fwinw = float winw in
6212 let sw = fwinw /. float state
.w in
6213 let sw = fwinw *. sw in
6214 max
sw (float conf
.scrollh
)
6217 let maxx = state
.w + winw in
6218 let x = winw - state
.x in
6219 let percent = float x /. float maxx in
6220 (fwinw -. sw) *. percent
6222 hscrollh (), position, sw
6226 match state
.mode with
6227 | LinkNav
_ -> "links"
6228 | Textentry
_ -> "textentry"
6229 | Birdseye
_ -> "birdseye"
6232 findkeyhash conf
modename
6234 method eformsgs
= true
6235 method alwaysscrolly
= false
6238 let adderrmsg src msg
=
6239 Buffer.add_string state
.errmsgs msg
;
6240 state
.newerrmsgs
<- true;
6244 let adderrfmt src fmt
=
6245 Format.ksprintf
(fun s -> adderrmsg src s) fmt
;
6249 let cl = splitatspace cmds
in
6251 try Scanf.sscanf
s fmt
f
6253 adderrfmt "remote exec"
6254 "error processing '%S': %s\n" cmds
(exntos exn
)
6257 | "reload" :: [] -> reload ()
6258 | "goto" :: args
:: [] ->
6259 scan args
"%u %f %f"
6261 let cmd, _ = state
.geomcmds
in
6263 then gotopagexy pageno x y
6266 gotopagexy pageno x y;
6269 state
.reprf
<- f state
.reprf
6271 | "goto1" :: args
:: [] -> scan args
"%u %f" gotopage
6272 | "gotor" :: args
:: [] ->
6274 (fun filename
pageno -> gotounder (Uremote
(filename
, pageno)))
6275 | "gotord" :: args
:: [] ->
6277 (fun filename
dest -> gotounder (Uremotedest
(filename
, dest)))
6278 | "rect" :: args
:: [] ->
6279 scan args
"%u %u %f %f %f %f"
6280 (fun pageno color x0 y0 x1 y1 ->
6281 onpagerect pageno (fun w h ->
6282 let _,w1,h1
,_ = getpagedim
pageno in
6283 let sw = float w1 /. float w
6284 and sh = float h1
/. float h in
6288 and y1s
= y1 *. sh in
6289 let rect = (x0s,y0s
,x1s
,y0s
,x1s
,y1s
,x0s,y1s
) in
6291 state
.rects <- (pageno, color, rect) :: state
.rects;
6292 G.postRedisplay "rect";
6295 | "activatewin" :: [] -> Wsi.activatewin
()
6296 | "quit" :: [] -> raise Quit
6298 adderrfmt "remote command"
6299 "error processing remote command: %S\n" cmds
;
6303 let scratch = Bytes.create
80 in
6304 let buf = Buffer.create
80 in
6307 try Some
(Unix.read fd
scratch 0 80)
6309 | Unix.Unix_error
(Unix.EAGAIN
, _, _) -> None
6310 | Unix.Unix_error
(Unix.EINTR
, _, _) -> tempfr ()
6313 match tempfr () with
6319 if Buffer.length
buf > 0
6321 let s = Buffer.contents
buf in
6331 let pos = Bytes.index_from
scratch ppos '
\n'
in
6332 if pos >= n then -1 else pos
6333 with Not_found
-> -1
6337 Buffer.add_subbytes
buf scratch ppos
(nlpos-ppos
);
6338 let s = Buffer.contents
buf in
6344 Buffer.add_subbytes
buf scratch ppos
(n-ppos
);
6350 let remoteopen path =
6351 try Some
(Unix.openfile
path [Unix.O_NONBLOCK
; Unix.O_RDONLY
] 0o0)
6353 adderrfmt "remoteopen" "error opening %S: %s" path (exntos exn
);
6358 let gcconfig = ref E.s in
6359 let trimcachepath = ref E.s in
6360 let rcmdpath = ref E.s in
6361 let pageno = ref None
in
6362 let rootwid = ref 0 in
6363 let openlast = ref false in
6364 let nofc = ref false in
6365 selfexec := Sys.executable_name
;
6368 [("-p", Arg.String
(fun s -> state
.password <- s),
6369 "<password> Set password");
6373 Config.fontpath
:= s;
6374 selfexec := !selfexec ^
" -f " ^
Filename.quote
s;
6376 "<path> Set path to the user interface font");
6380 selfexec := !selfexec ^
" -c " ^
Filename.quote
s;
6381 Config.confpath
:= s),
6382 "<path> Set path to the configuration file");
6384 ("-last", Arg.Set
openlast, " Open last document");
6386 ("-page", Arg.Int
(fun pageno1
-> pageno := Some
(pageno1
-1)),
6387 "<page-number> Jump to page");
6389 ("-tcf", Arg.String
(fun s -> trimcachepath := s),
6390 "<path> Set path to the trim cache file");
6392 ("-dest", Arg.String
(fun s -> state
.nameddest
<- s),
6393 "<named-destination> Set named destination");
6395 ("-wtmode", Arg.Set
wtmode, " Operate in wt mode");
6396 ("-cxack", Arg.Set
cxack, " Cut corners");
6398 ("-remote", Arg.String
(fun s -> rcmdpath := s),
6399 "<path> Set path to the remote commands source");
6401 ("-origin", Arg.String
(fun s -> state
.origin
<- s),
6402 "<original-path> Set original path");
6404 ("-gc", Arg.Set_string
gcconfig,
6405 "<script-path> Collect garbage with the help of a script");
6407 ("-nofc", Arg.Set
nofc, " Do not use fontconfig");
6409 ("-v", Arg.Unit
(fun () ->
6411 "%s\nconfiguration path: %s\n"
6415 exit
0), " Print version and exit");
6417 ("-embed", Arg.Set_int
rootwid,
6418 "<window-id> Embed into window")
6421 (fun s -> state
.path <- s)
6422 ("Usage: " ^
Sys.argv
.(0) ^
" [options] some.pdf\nOptions:")
6425 then selfexec := !selfexec ^
" -wtmode";
6427 let histmode = emptystr state
.path && not
!openlast in
6429 if not
(Config.load !openlast)
6430 then prerr_endline
"failed to load configuration";
6431 begin match !pageno with
6432 | Some
pageno -> state
.anchor <- (pageno, 0.0, 0.0)
6436 if not
(emptystr
!gcconfig)
6439 match Unix.socketpair
Unix.PF_UNIX
Unix.SOCK_STREAM
0 with
6441 error
"gc socketpair failed: %s" (exntos exn
)
6444 match addpid
@@ popen
!gcconfig [(c, 0); (c, 1)] with
6446 error
"failed to popen gc script: %s" (exntos exn
);
6452 let wsfd, winw, winh
= Wsi.init
(object (self)
6453 val mutable m_clicks
= 0
6454 val mutable m_click_x
= 0
6455 val mutable m_click_y
= 0
6456 val mutable m_lastclicktime
= infinity
6458 method private cleanup =
6459 state
.roam
<- noroam
;
6460 Hashtbl.iter
(fun _ opaque -> clearmark
opaque) state
.pagemap
6461 method expose
= G.postRedisplay"expose"
6465 | Wsi.Unobscured
-> "unobscured"
6466 | Wsi.PartiallyObscured
-> "partiallyobscured"
6467 | Wsi.FullyObscured
-> "fullyobscured"
6469 vlog "visibility change %s" name
6470 method display = display ()
6471 method map mapped
= vlog "mappped %b" mapped
6472 method reshape w h =
6475 method mouse
b d x y m =
6476 if d && canselect ()
6478 (* http://blogs.msdn.com/b/oldnewthing/archive/2004/10/18/243925.aspx *)
6484 if abs
x - m_click_x
> 10
6485 || abs
y - m_click_y
> 10
6486 || abs_float
(t -. m_lastclicktime
) > 0.3
6488 m_clicks
<- m_clicks
+ 1;
6489 m_lastclicktime
<- t;
6493 G.postRedisplay "cleanup";
6494 state
.uioh <- state
.uioh#button
b d x y m;
6496 else state
.uioh <- state
.uioh#multiclick m_clicks
x y m
6501 m_lastclicktime
<- infinity
;
6502 state
.uioh <- state
.uioh#button
b d x y m
6506 state
.uioh <- state
.uioh#button
b d x y m
6509 state
.mpos
<- (x, y);
6510 state
.uioh <- state
.uioh#motion
x y
6511 method pmotion
x y =
6512 state
.mpos
<- (x, y);
6513 state
.uioh <- state
.uioh#pmotion
x y
6515 let mascm = m land (
6516 Wsi.altmask
+ Wsi.shiftmask
+ Wsi.ctrlmask
+ Wsi.metamask
6519 let x = state
.x and y = state
.y in
6521 if x != state
.x || y != state
.y then self#
cleanup
6523 match state
.keystate
with
6525 let km = k
, mascm in
6528 let modehash = state
.uioh#
modehash in
6529 try Hashtbl.find modehash km
6531 try Hashtbl.find (findkeyhash conf
"global") km
6532 with Not_found
-> KMinsrt
(k
, m)
6534 | KMinsrt
(k
, m) -> keyboard k
m
6535 | KMinsrl
l -> List.iter
(fun (k
, m) -> keyboard k
m) l
6536 | KMmulti
(l, r
) -> state
.keystate
<- KSinto
(l, r
)
6538 | KSinto
((k'
, m'
) :: [], insrt
) when k'
=k
&& m'
land mascm = m'
->
6539 List.iter
(fun (k
, m) -> keyboard k
m) insrt
;
6540 state
.keystate
<- KSnone
6541 | KSinto
((k'
, m'
) :: keys, insrt
) when k'
=k
&& m'
land mascm = m'
->
6542 state
.keystate
<- KSinto
(keys, insrt
)
6543 | KSinto
_ -> state
.keystate
<- KSnone
6546 state
.mpos
<- (x, y);
6547 state
.uioh <- state
.uioh#pmotion
x y
6548 method leave = state
.mpos
<- (-1, -1)
6549 method winstate wsl
= state
.winstate
<- wsl
6550 method quit
= raise Quit
6551 end) !rootwid conf
.cwinw conf
.cwinh platform
in
6556 List.exists
GlMisc.check_extension
6557 [ "GL_ARB_texture_rectangle"
6558 ; "GL_EXT_texture_recangle"
6559 ; "GL_NV_texture_rectangle" ]
6561 then (prerr_endline
"OpenGL does not suppport rectangular textures"; exit
1);
6564 let r = GlMisc.get_string `renderer
in
6565 let p = "Mesa DRI Intel(" in
6566 let l = String.length
p in
6567 String.length
r > l && String.sub
r 0 l = p
6570 defconf
.sliceheight
<- 1024;
6571 defconf
.texcount
<- 32;
6572 defconf
.usepbo
<- true;
6576 match Unix.socketpair
Unix.PF_UNIX
Unix.SOCK_STREAM
0 with
6578 Printf.eprintf
"socketpair failed: %s" (exntos exn
);
6586 setcheckers conf
.checkers
;
6588 if conf
.redirectstderr
6592 (Buffer.to_bytes state
.errmsgs
)
6593 (match state
.errfd
with
6595 let s = Bytes.create
(80*24) in
6598 let r, _, _ = Unix.select
[fd
] [] [] 0.0 in
6600 then Unix.read fd
s 0 (Bytes.length
s)
6606 else Bytes.sub
s 0 n
6610 try ignore
(Unix.write state
.stderr
s 0 (Bytes.length
s))
6611 with exn
-> print_endline
(exntos exn
)
6616 conf
.angle
, conf
.fitmodel
, (conf
.trimmargins
, conf
.trimfuzz
),
6617 conf
.texcount
, conf
.sliceheight
, conf
.mustoresize
, conf
.colorspace
,
6618 !Config.fontpath
, !trimcachepath,
6619 GlMisc.check_extension
"GL_ARB_pixel_buffer_object",
6622 List.iter
GlArray.enable
[`texture_coord
; `vertex
];
6628 Wsi.settitle
"llpp (history)";
6632 state
.text <- "Opening " ^
(mbtoutf8 state
.path);
6633 opendoc state
.path state
.password;
6638 Sys.set_signal
Sys.sighup
(Sys.Signal_handle
(fun _ -> reload ()));
6641 if nonemptystr
!rcmdpath
6642 then remoteopen !rcmdpath
6647 let rec loop deadline
=
6649 if not
(ispidsetempty
())
6651 match Unix.waitpid
[Unix.WNOHANG
] 0 with
6652 | (exception exn
) -> dolog
"Unix.waitpid: %s" @@ exntos exn
6655 begin match status
with
6656 | Unix.WEXITED
_ | Unix.WSIGNALED
_ -> delpid
pid
6657 | Unix.WSTOPPED
_ -> ()
6663 match state
.errfd
with
6664 | None
-> [state
.ss; state
.wsfd]
6665 | Some fd
-> [state
.ss; state
.wsfd; fd
]
6670 | Some fd
-> fd
:: r
6674 state
.redisplay
<- false;
6681 if deadline
= infinity
6683 else max
0.0 (deadline
-. now)
6688 try Unix.select
r [] [] timeout
6689 with Unix.Unix_error
(Unix.EINTR
, _, _) -> [], [], []
6695 if state
.ghyll
== noghyll
6697 match state
.autoscroll
with
6698 | Some step
when step
!= 0 ->
6699 let y = state
.y + step
in
6703 else if y >= state
.maxy then 0 else y
6706 if state
.mode = View
6707 then state
.text <- E.s;
6710 else deadline
+. 0.01
6715 let rec checkfds = function
6717 | fd
:: rest
when fd
= state
.ss ->
6718 let cmd = readcmd state
.ss in
6722 | fd
:: rest
when fd
= state
.wsfd ->
6726 | fd
:: rest
when Some fd
= !optrfd ->
6727 begin match remote fd
with
6728 | None
-> optrfd := remoteopen !rcmdpath;
6729 | opt -> optrfd := opt
6734 let s = Bytes.create
80 in
6735 let n = tempfailureretry
(Unix.read fd
s 0) 80 in
6736 if conf
.redirectstderr
6738 Buffer.add_substring state
.errmsgs
(Bytes.to_string
s) 0 n;
6739 state
.newerrmsgs
<- true;
6740 state
.redisplay
<- true;
6743 prerr_string
(String.sub
(Bytes.to_string
s) 0 n);
6749 if !reeenterhist then (
6751 reeenterhist := false;
6755 if deadline
= infinity
6759 match state
.autoscroll
with
6760 | Some step
when step
!= 0 -> deadline1
6761 | _ -> if state
.ghyll
== noghyll
then infinity
else deadline1
6769 Config.save leavebirdseye;
6770 if hasunsavedchanges
()