6 external init
: Unix.file_descr
-> params
-> unit = "ml_init";;
7 external seltext
: opaque
-> (int * int * int * int) -> unit = "ml_seltext";;
8 external hassel
: opaque
-> bool = "ml_hassel";;
9 external copysel
: Unix.file_descr
-> opaque
-> unit = "ml_copysel";;
10 external getpdimrect
: int -> float array
= "ml_getpdimrect";;
11 external whatsunder
: opaque
-> int -> int -> under
= "ml_whatsunder";;
12 external markunder
: opaque
-> int -> int -> mark
-> bool = "ml_markunder";;
13 external clearmark
: opaque
-> unit = "ml_clearmark";;
14 external zoomforh
: int -> int -> int -> int -> float = "ml_zoom_for_height";;
15 external drawstr
: int -> int -> int -> string -> float = "ml_draw_string";;
16 external measurestr
: int -> string -> float = "ml_measure_string";;
17 external postprocess
:
18 opaque
-> int -> int -> int -> (int * string * int) -> int
20 external pagebbox
: opaque
-> (int * int * int * int) = "ml_getpagebox";;
21 external setaalevel
: int -> unit = "ml_setaalevel";;
22 external realloctexts
: int -> bool = "ml_realloctexts";;
23 external findlink
: opaque
-> linkdir
-> link
= "ml_findlink";;
24 external getlink
: opaque
-> int -> under
= "ml_getlink";;
25 external getlinkrect
: opaque
-> int -> irect
= "ml_getlinkrect";;
26 external getlinkcount
: opaque
-> int = "ml_getlinkcount";;
27 external findpwl
: int -> int -> pagewithlinks
= "ml_find_page_with_links";;
28 external getpbo
: width
-> height
-> colorspace
-> opaque
= "ml_getpbo";;
29 external freepbo
: opaque
-> unit = "ml_freepbo";;
30 external unmappbo
: opaque
-> unit = "ml_unmappbo";;
31 external pbousable
: unit -> bool = "ml_pbo_usable";;
32 external unproject
: opaque
-> int -> int -> (int * int) option
34 external drawtile
: tileparams
-> opaque
-> unit = "ml_drawtile";;
35 external rectofblock
: opaque
-> int -> int -> float array
option
37 external begintiles
: unit -> unit = "ml_begintiles";;
38 external endtiles
: unit -> unit = "ml_endtiles";;
39 external addannot
: opaque
-> int -> int -> string -> unit = "ml_addannot";;
40 external modannot
: opaque
-> slinkindex
-> string -> unit = "ml_modannot";;
41 external delannot
: opaque
-> slinkindex
-> unit = "ml_delannot";;
42 external hasunsavedchanges
: unit -> bool = "ml_hasunsavedchanges";;
43 external savedoc
: string -> unit = "ml_savedoc";;
44 external getannotcontents
: opaque
-> slinkindex
-> string
45 = "ml_getannotcontents";;
47 let reeenterhist = ref false;;
48 let selfexec = ref E.s
;;
50 let drawstring size x y s
=
52 Gl.enable `texture_2d
;
53 GlFunc.blend_func ~src
:`src_alpha ~dst
:`one_minus_src_alpha
;
54 ignore
(drawstr size x y s
);
56 Gl.disable `texture_2d
;
59 let drawstring1 size x y s
=
63 let drawstring2 size x y fmt
=
64 Printf.kprintf
(drawstring size
(x
+1) (y
+size
+1)) fmt
68 dolog
"l %d dim=%d {" l
.pageno l
.pagedimno
;
69 dolog
" WxH %dx%d" l
.pagew l
.pageh
;
70 dolog
" vWxH %dx%d" l
.pagevw l
.pagevh
;
71 dolog
" pagex,y %d,%d" l
.pagex l
.pagey
;
72 dolog
" dispx,y %d,%d" l
.pagedispx l
.pagedispy
;
73 dolog
" column %d" l
.pagecol
;
77 let debugrect (x0
, y0
, x1
, y1
, x2
, y2
, x3
, y3
) =
79 dolog
" x0,y0=(% f, % f)" x0 y0
;
80 dolog
" x1,y1=(% f, % f)" x1 y1
;
81 dolog
" x2,y2=(% f, % f)" x2 y2
;
82 dolog
" x3,y3=(% f, % f)" x3 y3
;
86 let isbirdseye = function
93 let istextentry = function
100 let wtmode = ref false;;
101 let cxack = ref false;;
103 let pgscale h
= truncate
(float h
*. conf
.pgscale);;
106 if not state
.uioh#alwaysscrolly
&& (conf
.scrollb
land scrollbhv
= 0)
107 || (state
.x
= 0 && state
.w
<= state
.winw
- conf
.scrollbw
)
113 if not state
.uioh#alwaysscrolly
&& (conf
.scrollb
land scrollbvv
= 0)
118 let wadjsb () = -vscrollw ();;
119 let xadjsb () = if conf
.leftscroll
then vscrollw () else 0;;
122 fstate
.fontsize
<- n
;
123 fstate
.wwidth
<- measurestr fstate
.fontsize
"w";
124 fstate
.maxrows
<- (state
.winh
- fstate
.fontsize
- 1) / (fstate
.fontsize
+ 1);
130 Printf.kprintf prerr_endline fmt
132 Printf.kprintf ignore fmt
136 if emptystr conf
.pathlauncher
137 then print_endline state
.path
139 let command = Str.global_replace percentsre state
.path conf
.pathlauncher
in
140 try addpid
@@ popen
command []
142 Printf.eprintf
"failed to execute `%s': %s\n" command (exntos exn
);
147 let redirectstderr () =
148 let clofail what errmsg
= dolog
"failed to close %s: %s" what errmsg
in
149 if conf
.redirectstderr
151 match Unix.pipe
() with
153 dolog
"failed to create stderr redirection pipes: %s" (exntos exn
)
156 begin match Unix.dup
Unix.stderr
with
158 dolog
"failed to dup stderr: %s" (exntos exn
);
159 Ne.clo r
(clofail "pipe/r");
160 Ne.clo w
(clofail "pipe/w");
163 begin match Unix.dup2 w
Unix.stderr
with
165 dolog
"failed to dup2 to stderr: %s" (exntos exn
);
166 Ne.clo dupstderr
(clofail "stderr duplicate");
167 Ne.clo r
(clofail "redir pipe/r");
168 Ne.clo w
(clofail "redir pipe/w");
171 state
.stderr
<- dupstderr
;
172 state
.errfd
<- Some r
;
176 state
.newerrmsgs
<- false;
177 begin match state
.errfd
with
179 begin match Unix.dup2 state
.stderr
Unix.stderr
with
181 dolog
"failed to dup2 original stderr: %s" (exntos exn
)
183 Ne.clo fd
(clofail "dup of stderr");
188 prerr_string
(Buffer.contents state
.errmsgs
);
190 Buffer.clear state
.errmsgs
;
196 let postRedisplay who
=
198 then prerr_endline
("redisplay for " ^ who
);
199 state
.redisplay
<- true;
203 let getopaque pageno
=
204 try Some
(Hashtbl.find state
.pagemap
(pageno
, state
.gen
))
205 with Not_found
-> None
208 let putopaque pageno opaque
=
209 Hashtbl.replace state
.pagemap
(pageno
, state
.gen
) opaque
212 let pagetranslatepoint l x y
=
213 let dy = y
- l
.pagedispy
in
214 let y = dy + l
.pagey
in
215 let dx = x
- l
.pagedispx
in
216 let x = dx + l
.pagex
in
220 let onppundermouse g
x y d
=
223 begin match getopaque l
.pageno
with
225 let x0 = l
.pagedispx
in
226 let x1 = x0 + l
.pagevw
in
227 let y0 = l
.pagedispy
in
228 let y1 = y0 + l
.pagevh
in
229 if y >= y0 && y <= y1 && x >= x0 && x <= x1
231 let px, py
= pagetranslatepoint l
x y in
232 match g opaque l
px py
with
245 let g opaque l
px py
=
248 match rectofblock opaque
px py
with
250 let rect = (a
.(0),a
.(2),a
.(1),a
.(2),a
.(1),a
.(3),a
.(0),a
.(3)) in
251 state
.rects
<- [l
.pageno
, l
.pageno
mod 3, rect];
252 G.postRedisplay "getunder";
255 let under = whatsunder opaque
px py
in
256 if under = Unone
then None
else Some
under
258 onppundermouse g x y Unone
263 match unproject opaque
x y with
264 | Some
(x, y) -> Some
(Some
(opaque
, l
.pageno
, x, y))
267 onppundermouse g x y None
;
271 state
.text
<- Printf.sprintf
"%c%s" c s
;
272 G.postRedisplay "showtext";
275 let pipesel opaque cmd
=
278 match Unix.pipe
() with
281 (Printf.sprintf
"pipesel can not create pipe: %s" (exntos exn
));
283 let doclose what fd
=
284 Ne.clo fd
(fun msg
-> dolog
"%s close failed: %s" what msg
)
287 try popen cmd
[r
, 0; w
, -1]
289 dolog
"can not execute %S: %s" cmd
(exntos exn
);
295 G.postRedisplay "pipesel";
297 else doclose "pipesel pipe/w" w
;
298 doclose "pipesel pipe/r" r
;
302 let g opaque l
px py
=
303 if markunder opaque
px py conf
.paxmark
306 match getopaque l
.pageno
with
308 | Some opaque
-> pipesel opaque conf
.paxcmd
313 G.postRedisplay "paxunder";
314 if conf
.paxmark
= Mark_page
317 match getopaque l
.pageno
with
319 | Some opaque
-> clearmark opaque
) state
.layout
;
321 onppundermouse g x y (fun () -> showtext '
!'
"Whoopsie daisy");
325 match Unix.pipe
() with
327 showtext '
!'
(Printf.sprintf
"pipe failed: %s" (exntos exn
))
330 Ne.clo fd
(fun msg
->
331 showtext '
!'
(Printf.sprintf
"failed to close %s: %s" cap msg
)
335 try popen conf
.selcmd
[r
, 0; w
, -1]
338 (Printf.sprintf
"failed to execute %s: %s"
339 conf
.selcmd
(exntos exn
));
345 let l = String.length s
in
346 let bytes = Bytes.unsafe_of_string s
in
347 let n = tempfailureretry
(Unix.write w
bytes 0) l in
352 "failed to write %d characters to sel pipe, wrote %d"
357 (Printf.sprintf
"failed to write to sel pipe: %s"
362 clo "selstring pipe/r" r
;
363 clo "selstring pipe/w" w
;
366 let undertext = function
369 | Ulinkgoto
(pageno
, _
) -> Printf.sprintf
"%s: page %d" state
.path
(pageno
+1)
370 | Utext s
-> "font: " ^ s
371 | Uunexpected s
-> "unexpected: " ^ s
372 | Ulaunch s
-> "launch: " ^ s
373 | Unamed s
-> "named: " ^ s
374 | Uremote
(filename
, pageno
) ->
375 Printf.sprintf
"%s: page %d" filename
(pageno
+1)
376 | Uremotedest
(filename
, destname
) ->
377 Printf.sprintf
"%s: destination %S" filename destname
378 | Uannotation
(opaque
, slinkindex
) ->
379 "annotation: " ^ getannotcontents opaque slinkindex
382 let updateunder x y =
383 match getunder x y with
384 | Unone
-> Wsi.setcursor
Wsi.CURSOR_INHERIT
386 if conf
.underinfo
then showtext 'u'
("ri: " ^ uri
);
387 Wsi.setcursor
Wsi.CURSOR_INFO
388 | Ulinkgoto
(pageno
, _
) ->
390 then showtext 'p'
("age: " ^ string_of_int
(pageno
+1));
391 Wsi.setcursor
Wsi.CURSOR_INFO
393 if conf
.underinfo
then showtext '
f'
("ont: " ^ s
);
394 Wsi.setcursor
Wsi.CURSOR_TEXT
396 if conf
.underinfo
then showtext 'u'
("nexpected: " ^ s
);
397 Wsi.setcursor
Wsi.CURSOR_INHERIT
399 if conf
.underinfo
then showtext '
l'
("aunch: " ^ s
);
400 Wsi.setcursor
Wsi.CURSOR_INHERIT
402 if conf
.underinfo
then showtext '
n'
("amed: " ^ s
);
403 Wsi.setcursor
Wsi.CURSOR_INHERIT
404 | Uremote
(filename
, pageno
) ->
405 if conf
.underinfo
then showtext 'r'
406 (Printf.sprintf
"emote: %s (%d)" filename
(pageno
+1));
407 Wsi.setcursor
Wsi.CURSOR_INFO
408 | Uremotedest
(filename
, destname
) ->
409 if conf
.underinfo
then showtext 'r'
410 (Printf.sprintf
"emote destination: %s (%S)" filename destname
);
411 Wsi.setcursor
Wsi.CURSOR_INFO
413 if conf
.underinfo
then showtext 'a'
"nnotation";
414 Wsi.setcursor
Wsi.CURSOR_INFO
417 let showlinktype under =
418 if conf
.underinfo
&& under != Unone
419 then showtext ' '
@@ undertext under
422 let intentry_with_suffix text key
=
424 if key
>= 32 && key
< 127
428 match Char.lowercase
c with
430 let text = addchar
text c in
434 let text = addchar
text c in
438 state
.text <- Printf.sprintf
"invalid char (%d, `%c')" key
c;
443 let s = Bytes.create
4 in
444 let n = tempfailureretry
(Unix.read fd
s 0) 4 in
445 if n != 4 then error
"incomplete read(len) = %d" n;
446 let len = (Char.code
(Bytes.get
s 0) lsl 24)
447 lor (Char.code
(Bytes.get
s 1) lsl 16)
448 lor (Char.code
(Bytes.get
s 2) lsl 8)
449 lor (Char.code
(Bytes.get
s 3))
451 let s = Bytes.create
len in
452 let n = tempfailureretry
(Unix.read fd
s 0) len in
453 if n != len then error
"incomplete read(data) %d vs %d" n len;
458 let b = Buffer.create
16 in
459 Buffer.add_string
b "llll";
462 let s = Buffer.to_bytes
b in
463 let n = Bytes.length
s in
465 (* dolog "wcmd %S" (String.sub s 4 len); *)
466 Bytes.set
s 0 (Char.chr
((len lsr 24) land 0xff));
467 Bytes.set
s 1 (Char.chr
((len lsr 16) land 0xff));
468 Bytes.set
s 2 (Char.chr
((len lsr 8) land 0xff));
469 Bytes.set
s 3 (Char.chr
(len land 0xff));
470 let n'
= tempfailureretry
(Unix.write state
.ss
s 0) n in
471 if n'
!= n then error
"write failed %d vs %d" n'
n;
475 let nogeomcmds cmds
=
477 | s, [] -> emptystr
s
481 let layoutN ((columns
, coverA
, coverB
), b) y sh
=
482 let sh = sh - (hscrollh ()) in
483 let wadj = wadjsb () in
484 let rec fold accu
n =
485 if n = Array.length
b
488 let pdimno, dx, vy
, (_
, w
, h
, xoff
) = b.(n) in
491 || n = state
.pagecount
- coverB
492 || (n - coverA
) mod columns
= columns
- 1)
498 let pagey = max
0 (y - vy
) in
499 let pagedispy = if pagey > 0 then 0 else vy
- y in
500 let pagedispx, pagex
=
502 if n = coverA
- 1 || n = state
.pagecount
- coverB
503 then state
.x + (wadj + state
.winw
- w
) / 2
504 else dx + xoff
+ state
.x
511 let vw = wadj + state
.winw
- pagedispx in
512 let pw = w
- pagex
in
515 let pagevh = min
(h
- pagey) (sh - pagedispy) in
516 if pagevw > 0 && pagevh > 0
527 ; pagedispx = pagedispx
528 ; pagedispy = pagedispy
540 if Array.length
b = 0
542 else List.rev
(fold [] (page_of_y
y))
545 let layoutS (columns
, b) y sh =
546 let sh = sh - hscrollh () in
547 let wadj = wadjsb () in
548 let rec fold accu n =
549 if n = Array.length
b
552 let pdimno, px, vy
, (_
, pagew
, pageh
, xoff
) = b.(n) in
559 let x = xoff
+ state
.x in
560 let pagey = max
0 (y - vy
) in
561 let pagedispy = if pagey > 0 then 0 else vy
- y in
562 let pagedispx, pagex
=
576 let pagecolw = pagew
/columns
in
578 if pagecolw < state
.winw
579 then pagedispx + ((wadj + state
.winw
- pagecolw) / 2)
583 let vw = wadj + state
.winw
- pagedispx in
584 let pw = pagew
- pagex
in
587 let pagevw = min
pagevw pagecolw in
588 let pagevh = min
(pageh
- pagey) (sh - pagedispy) in
589 if pagevw > 0 && pagevh > 0
600 ; pagedispx = pagedispx
601 ; pagedispy = pagedispy
602 ; pagecol
= n mod columns
617 if nogeomcmds state
.geomcmds
619 match conf
.columns
with
620 | Csingle
b -> layoutN ((1, 0, 0), b) y sh
621 | Cmulti
c -> layoutN c y sh
622 | Csplit
s -> layoutS s y sh
627 let y = state
.y + incr
in
629 let y = min
y (state
.maxy
- (if conf
.maxhfit
then state
.winh
else 0)) in
634 let tilex = l.pagex
mod conf
.tilew
in
635 let tiley = l.pagey mod conf
.tileh
in
637 let col = l.pagex
/ conf
.tilew
in
638 let row = l.pagey / conf
.tileh
in
640 let xadj = xadjsb () in
641 let rec rowloop row y0 dispy h
=
645 let dh = conf
.tileh
- y0 in
647 let rec colloop col x0 dispx w
=
651 let dw = conf
.tilew
- x0 in
653 let dispx'
= xadj + dispx in
654 f col row dispx' dispy
x0 y0 dw dh;
655 colloop (col+1) 0 (dispx+dw) (w
-dw)
658 colloop col tilex l.pagedispx l.pagevw;
659 rowloop (row+1) 0 (dispy
+dh) (h
-dh)
662 if l.pagevw > 0 && l.pagevh > 0
663 then rowloop row tiley l.pagedispy l.pagevh;
666 let gettileopaque l col row =
668 l.pageno
, state
.gen
, conf
.colorspace
, conf
.angle
, l.pagew
, l.pageh
, col, row
670 try Some
(Hashtbl.find state
.tilemap
key)
671 with Not_found
-> None
674 let puttileopaque l col row gen colorspace angle opaque size elapsed
=
675 let key = l.pageno
, gen
, colorspace
, angle
, l.pagew
, l.pageh
, col, row in
676 Hashtbl.add state
.tilemap
key (opaque
, size
, elapsed
)
679 let filledrect x0 y0 x1 y1 =
680 GlArray.disable `texture_coord
;
681 Raw.sets_float state
.vraw ~pos
:0 [| x0; y0; x0; y1; x1; y0; x1; y1 |];
682 GlArray.vertex `two state
.vraw
;
683 GlArray.draw_arrays `triangle_strip ~first
:0 ~count
:4;
684 GlArray.enable `texture_coord
;
687 let linerect x0 y0 x1 y1 =
688 GlArray.disable `texture_coord
;
689 Raw.sets_float state
.vraw ~pos
:0 [| x0; y0; x0; y1; x1; y1; x1; y0 |];
690 GlArray.vertex `two state
.vraw
;
691 GlArray.draw_arrays `line_loop ~first
:0 ~count
:4;
692 GlArray.enable `texture_coord
;
695 let drawtiles l color
=
697 let wadj = wadjsb () in
699 let f col row x y tilex tiley w h
=
700 match gettileopaque l col row with
701 | Some
(opaque
, _
, t
) ->
702 let params = x, y, w
, h
, tilex, tiley in
704 then GlTex.env
(`mode `blend
);
705 drawtile
params opaque
;
707 then GlTex.env
(`mode `modulate
);
711 let s = Printf.sprintf
715 let w = measurestr fstate
.fontsize
s in
716 GlDraw.color
(0.0, 0.0, 0.0);
717 filledrect (float (x-2))
720 (float (y + fstate
.fontsize
+ 2));
721 GlDraw.color
(1.0, 1.0, 1.0);
722 drawstring fstate
.fontsize
x (y + fstate
.fontsize
- 1) s;
732 let lw = wadj + state
.winw
- x in
735 let lh = state
.winh
- y in
739 then GlTex.env
(`mode `blend
);
740 begin match state
.checkerstexid
with
742 Gl.enable `texture_2d
;
743 GlTex.bind_texture ~target
:`texture_2d id
;
747 and y1 = float (y+h
) in
749 let tw = float w /. 16.0
750 and th
= float h
/. 16.0 in
751 let tx0 = float tilex /. 16.0
752 and ty0
= float tiley /. 16.0 in
754 and ty1
= ty0
+. th
in
755 Raw.sets_float state
.vraw ~pos
:0
756 [| x0; y0; x0; y1; x1; y0; x1; y1 |];
757 Raw.sets_float state
.traw ~pos
:0
758 [| tx0; ty0
; tx0; ty1
; tx1; ty0
; tx1; ty1
|];
759 GlArray.vertex `two state
.vraw
;
760 GlArray.tex_coord `two state
.traw
;
761 GlArray.draw_arrays `triangle_strip ~first
:0 ~count
:4;
762 Gl.disable `texture_2d
;
765 GlDraw.color
(1.0, 1.0, 1.0);
766 filledrect (float x) (float y) (float (x+w)) (float (y+h
));
769 then GlTex.env
(`mode `modulate
);
770 if w > 128 && h
> fstate
.fontsize
+ 10
772 let c = if conf
.invert
then 1.0 else 0.0 in
773 GlDraw.color
(c, c, c);
776 then (col*conf
.tilew
, row*conf
.tileh
)
779 drawstring2 fstate
.fontsize
x y "Loading %d [%d,%d]" l.pageno
c r
;
788 let pagevisible layout n = List.exists
(fun l -> l.pageno
= n) layout;;
790 let tilevisible1 l x y =
792 and ax1
= l.pagex
+ l.pagevw
794 and ay1
= l.pagey + l.pagevh in
798 let bx1 = min
(bx0 + conf
.tilew
) l.pagew
799 and by1
= min
(by0
+ conf
.tileh
) l.pageh
in
801 let rx0 = max
ax0 bx0
802 and ry0
= max ay0 by0
803 and rx1
= min ax1
bx1
804 and ry1
= min ay1 by1
in
806 let nonemptyintersection = rx1
> rx0 && ry1
> ry0
in
810 let tilevisible layout n x y =
811 let rec findpageinlayout m
= function
812 | l :: rest
when l.pageno
= n ->
813 tilevisible1 l x y || (
814 match conf
.columns
with
815 | Csplit
(c, _
) when c > m
-> findpageinlayout (m
+1) rest
820 | _
:: rest
-> findpageinlayout 0 rest
823 findpageinlayout 0 layout;
826 let tileready l x y =
827 tilevisible1 l x y &&
828 gettileopaque l (x/conf
.tilew
) (y/conf
.tileh
) != None
831 let tilepage n p
layout =
832 let rec loop = function
836 let f col row _ _ _ _ _ _
=
837 if state
.currently
= Idle
839 match gettileopaque l col row with
842 let x = col*conf
.tilew
843 and y = row*conf
.tileh
in
845 let w = l.pagew
- x in
849 let h = l.pageh
- y in
854 then getpbo
w h conf
.colorspace
857 wcmd "tile %s %d %d %d %d %s"
858 (~
> p
) x y w h (~
> pbo);
861 l, p
, conf
.colorspace
, conf
.angle
,
862 state
.gen
, col, row, conf
.tilew
, conf
.tileh
871 if nogeomcmds state
.geomcmds
875 let preloadlayout y =
876 let y = if y < state
.winh
then 0 else y - state
.winh
in
877 let h = state
.winh
*3 in
883 if state
.currently
!= Idle
888 begin match getopaque l.pageno
with
890 wcmd "page %d %d" l.pageno
l.pagedimno
;
891 state
.currently
<- Loading
(l, state
.gen
);
893 tilepage l.pageno opaque pages
;
898 if nogeomcmds state
.geomcmds
904 if conf
.preload && state
.currently
= Idle
905 then load (preloadlayout state
.y);
908 let layoutready layout =
909 let rec fold all ls
=
912 let seen = ref false in
913 let allvisible = ref true in
914 let foo col row _ _ _ _ _ _
=
916 allvisible := !allvisible &&
917 begin match gettileopaque l col row with
923 fold (!seen && !allvisible) rest
926 let alltilesvisible = fold true layout in
931 let y = bound
y 0 state
.maxy
in
932 let y, layout, proceed
=
933 match conf
.maxwait
with
934 | Some time
when state
.ghyll
== noghyll
->
935 begin match state
.throttle
with
937 let layout = layout y state
.winh
in
938 let ready = layoutready layout in
942 state
.throttle
<- Some
(layout, y, now
());
944 else G.postRedisplay "gotoy showall (None)";
946 | Some
(_
, _
, started
) ->
947 let dt = now
() -. started
in
950 state
.throttle
<- None
;
951 let layout = layout y state
.winh
in
953 G.postRedisplay "maxwait";
960 let layout = layout y state
.winh
in
961 if not
!wtmode || layoutready layout
962 then G.postRedisplay "gotoy ready";
968 state
.layout <- layout;
969 begin match state
.mode
with
972 | Ltexact
(pageno
, linkno
) ->
973 let rec loop = function
975 state
.mode
<- LinkNav
(Ltgendir
0)
976 | l :: _
when l.pageno
= pageno
->
977 begin match getopaque pageno
with
978 | None
-> state
.mode
<- LinkNav
(Ltnotready
(pageno
, 0))
980 let x0, y0, x1, y1 = getlinkrect opaque linkno
in
981 if not
(x0 >= l.pagex
&& x1 <= l.pagex
+ l.pagevw
982 && y0 >= l.pagey && y1 <= l.pagey + l.pagevh)
983 then state
.mode
<- LinkNav
(Ltgendir
0)
985 | _
:: rest
-> loop rest
988 | Ltnotready _
| Ltgendir _
-> ()
994 begin match state
.mode
with
995 | Birdseye
(conf
, leftx
, pageno
, hooverpageno
, anchor
) ->
996 if not
(pagevisible layout pageno
)
998 match state
.layout with
1001 state
.mode
<- Birdseye
(
1002 conf
, leftx
, l.pageno
, hooverpageno
, anchor
1007 | Ltnotready
(_
, dir
)
1010 let rec loop = function
1013 match getopaque l.pageno
with
1014 | None
-> Ltnotready
(l.pageno
, dir
)
1019 then LDfirstvisible
(l.pagex
, l.pagey, dir
)
1021 if dir
> 0 then LDfirst
else LDlast
1027 | Lnotfound
-> loop rest
1029 showlinktype (getlink opaque
n);
1030 Ltexact
(l.pageno
, n)
1034 state
.mode
<- LinkNav
linknav
1042 state
.ghyll
<- noghyll
;
1045 let mx, my
= state
.mpos
in
1050 let conttiling pageno opaque
=
1051 tilepage pageno opaque
1052 (if conf
.preload then preloadlayout state
.y else state
.layout)
1055 let gotoy_and_clear_text y =
1056 if not conf
.verbose
then state
.text <- E.s;
1060 let getanchory (n, top
, dtop
) =
1061 let y, h = getpageyh
n in
1062 if conf
.presentation
1064 let ips = calcips
h in
1065 y + truncate
(top
*.float h -. dtop
*.float ips) + ips;
1067 y + truncate
(top
*.float h -. dtop
*.float conf
.interpagespace
)
1070 let gotoanchor anchor
=
1071 gotoy (getanchory anchor
);
1075 cbput state
.hists
.nav
(getanchor
());
1079 let anchor = cbgetc state
.hists
.nav dir
in
1083 let gotoghyll1 single
y =
1084 let scroll f n a
b =
1085 (* http://devmaster.net/forums/topic/9796-ease-in-ease-out-algorithm/ *)
1087 let s x = 3.0*.x**2.0 -. 2.0*.x**3.0 in
1089 then s (float f /. float a
)
1092 then 1.0 -. s ((float (f-b) /. float (n-b)))
1098 let ins = float a
*. 0.5
1099 and outs
= float (n-b) *. 0.5 in
1101 ins +. outs
+. float ones
1103 let rec set nab
y sy
=
1104 let (_N
, _A
, _B
), y =
1107 let scl = if y > sy
then 2 else -2 in
1108 let _N, _
, _
= nab
in
1109 (_N,0,_N), y+conf
.scrollstep
*scl
1111 let sum = summa
_N _A _B
in
1112 let dy = float (y - sy
) in
1116 then state
.ghyll
<- noghyll
1119 let s = scroll n _N _A _B
in
1120 let y1 = y1 +. ((s *. dy) /. sum) in
1121 gotoy_and_clear_text (truncate
y1);
1122 state
.ghyll
<- gf (n+1) y1;
1126 | Some
y'
when single
-> set nab
y' state
.y
1127 | Some
y'
-> set (_N/2, 1, 1) y' state
.y
1129 gf 0 (float state
.y)
1132 match conf
.ghyllscroll
with
1133 | Some nab
when not conf
.presentation
->
1134 if state
.ghyll
== noghyll
1135 then set nab
y state
.y
1136 else state
.ghyll
(Some
y)
1138 gotoy_and_clear_text y
1141 let gotoghyll = gotoghyll1 false;;
1143 let gotopage n top
=
1144 let y, h = getpageyh
n in
1145 let y = y + (truncate
(top
*. float h)) in
1149 let gotopage1 n top
=
1150 let y = getpagey
n in
1155 let invalidate s f =
1160 match state
.geomcmds
with
1161 | ps
, [] when emptystr ps
->
1163 state
.geomcmds
<- s, [];
1166 state
.geomcmds
<- ps
, [s, f];
1168 | ps
, (s'
, _
) :: rest
when s'
= s ->
1169 state
.geomcmds
<- ps
, ((s, f) :: rest
);
1172 state
.geomcmds
<- ps
, ((s, f) :: cmds
);
1176 Hashtbl.iter
(fun _ opaque
->
1177 wcmd "freepage %s" (~
> opaque
);
1179 Hashtbl.clear state
.pagemap
;
1183 if not
(Queue.is_empty state
.tilelru
)
1185 Queue.iter
(fun (k
, p
, s) ->
1186 wcmd "freetile %s" (~
> p
);
1187 state
.memused
<- state
.memused
- s;
1188 Hashtbl.remove state
.tilemap k
;
1190 state
.uioh#infochanged Memused
;
1191 Queue.clear state
.tilelru
;
1197 let h = truncate
(float h*.conf
.zoom
) in
1198 let d = conf
.interpagespace
lsl (if conf
.presentation
then 1 else 0) in
1202 let opendoc path password
=
1204 state
.password
<- password
;
1205 state
.gen
<- state
.gen
+ 1;
1206 state
.docinfo
<- [];
1207 state
.outlines
<- [||];
1210 setaalevel conf
.aalevel
;
1212 if emptystr state
.origin
1216 Wsi.settitle
("llpp " ^
(mbtoutf8
(Filename.basename
titlepath)));
1217 wcmd "open %d %d %s\000%s\000" (btod
!wtmode) (btod
!cxack) path password
;
1218 invalidate "reqlayout"
1220 wcmd "reqlayout %d %d %d %s\000"
1221 conf
.angle
(FMTE.to_int conf
.fitmodel
)
1222 (stateh state
.winh
) state
.nameddest
1227 state
.anchor <- getanchor
();
1228 opendoc state
.path state
.password
;
1232 let c = c *. conf
.colorscale
in
1236 let scalecolor2 (r
, g, b) =
1237 (r
*. conf
.colorscale
, g *. conf
.colorscale
, b *. conf
.colorscale
);
1240 let docolumns columns
=
1241 let wadj = wadjsb () in
1244 let a = Array.make state
.pagecount
(-1, -1, -1, (-1, -1, -1, -1)) in
1245 let wadj = wadjsb () in
1246 let rec loop pageno
pdimno pdim
y ph pdims
=
1247 if pageno
= state
.pagecount
1250 let pdimno, ((_
, w, h, xoff
) as pdim
), pdims
=
1252 | ((pageno'
, _
, _
, _
) as pdim
) :: rest
when pageno'
= pageno
->
1253 pdimno+1, pdim
, rest
1257 let x = max
0 (((wadj + state
.winw
- w) / 2) - xoff
) in
1259 (if conf
.presentation
1260 then (if pageno
= 0 then calcips
h else calcips ph
+ calcips
h)
1261 else (if pageno
= 0 then 0 else conf
.interpagespace
)
1264 a.(pageno
) <- (pdimno, x, y, pdim
);
1265 loop (pageno
+1) pdimno pdim
(y + h) h pdims
1267 loop 0 ~
-1 (-1,-1,-1,-1) 0 0 state
.pdims
;
1268 conf
.columns
<- Csingle
a;
1270 | Cmulti
((columns
, coverA
, coverB
), _
) ->
1271 let a = Array.make state
.pagecount
(-1, -1, -1, (-1, -1, -1, -1)) in
1272 let rec loop pageno
pdimno pdim
x y rowh pdims
=
1273 let rec fixrow m
= if m
= pageno
then () else
1274 let (pdimno, x, y, ((_
, _
, h, _
) as pdim
)) = a.(m
) in
1277 let y = y + (rowh
- h) / 2 in
1278 a.(m
) <- (pdimno, x, y, pdim
);
1282 if pageno
= state
.pagecount
1283 then fixrow (((pageno
- 1) / columns
) * columns
)
1285 let pdimno, ((_
, w, h, xoff
) as pdim
), pdims
=
1287 | ((pageno'
, _
, _
, _
) as pdim
) :: rest
when pageno'
= pageno
->
1288 pdimno+1, pdim
, rest
1293 if pageno
= coverA
- 1 || pageno
= state
.pagecount
- coverB
1295 let x = (wadj + state
.winw
- w) / 2 in
1297 if conf
.presentation
then calcips
h else conf
.interpagespace
in
1298 x, y + ips + rowh
, h
1301 if (pageno
- coverA
) mod columns
= 0
1303 let x = max
0 (wadj + state
.winw
- state
.w) / 2 in
1305 if conf
.presentation
1307 let ips = calcips
h in
1308 y + (if pageno
= 0 then 0 else calcips rowh
+ ips)
1310 y + (if pageno
= 0 then 0 else conf
.interpagespace
)
1314 else x, y, max rowh
h
1318 if pageno
> 1 && (pageno
- coverA
) mod columns
= 0
1321 if pageno
= columns
&& conf
.presentation
1323 let ips = calcips rowh
in
1324 for i
= 0 to pred columns
1326 let (pdimno, x, y, pdim
) = a.(i
) in
1327 a.(i
) <- (pdimno, x, y+ips, pdim
)
1333 fixrow (pageno
- columns
);
1338 a.(pageno
) <- (pdimno, x, y, pdim
);
1339 let x = x + w + xoff
*2 + conf
.interpagespace
in
1340 loop (pageno
+1) pdimno pdim
x y rowh' pdims
1342 loop 0 ~
-1 (-1,-1,-1,-1) 0 0 0 state
.pdims
;
1343 conf
.columns
<- Cmulti
((columns
, coverA
, coverB
), a);
1346 let a = Array.make
(state
.pagecount
*c) (-1, -1, -1, (-1, -1, -1, -1)) in
1347 let rec loop pageno
pdimno pdim
y pdims
=
1348 if pageno
= state
.pagecount
1351 let pdimno, ((_
, w, h, _
) as pdim
), pdims
=
1353 | ((pageno'
, _
, _
, _
) as pdim
) :: rest
when pageno'
= pageno
->
1354 pdimno+1, pdim
, rest
1359 let rec loop1 n x y =
1360 if n = c then y else (
1361 a.(pageno
*c + n) <- (pdimno, x, y, pdim
);
1362 loop1 (n+1) (x+cw) (y + h + conf
.interpagespace
)
1365 let y = loop1 0 0 y in
1366 loop (pageno
+1) pdimno pdim
y pdims
1368 loop 0 ~
-1 (-1,-1,-1,-1) 0 state
.pdims
;
1369 conf
.columns
<- Csplit
(c, a);
1373 docolumns conf
.columns
;
1374 state
.maxy
<- calcheight
();
1375 if state
.reprf
== noreprf
1377 match state
.mode
with
1378 | Birdseye
(_
, _
, pageno
, _
, _
) ->
1379 let y, h = getpageyh pageno
in
1380 let top = (state
.winh
- h) / 2 in
1381 gotoy (max
0 (y - top))
1384 | LinkNav _
-> gotoanchor state
.anchor
1388 state
.reprf
<- noreprf
;
1392 let reshape ?
(firsttime
=false) w h =
1393 GlDraw.viewport ~
x:0 ~
y:0 ~
w:w ~
h:h;
1394 if not firsttime
&& nogeomcmds state
.geomcmds
1395 then state
.anchor <- getanchor
();
1398 let w = wadjsb () + (truncate
(float w *. conf
.zoom
)) in
1401 setfontsize fstate
.fontsize
;
1402 GlMat.mode `modelview
;
1403 GlMat.load_identity
();
1405 GlMat.mode `projection
;
1406 GlMat.load_identity
();
1407 GlMat.rotate ~
x:1.0 ~angle
:180.0 ();
1408 GlMat.translate ~
x:~
-.1.0 ~
y:~
-.1.0 ();
1409 GlMat.scale3
(2.0 /. float state
.winw
, 2.0 /. float state
.winh
, 1.0);
1414 else float state
.x /. float state
.w
1416 invalidate "geometry"
1420 then state
.x <- truncate
(relx *. float w);
1422 match conf
.columns
with
1424 | Cmulti
((c, _
, _
), _
) -> (w - (c-1)*conf
.interpagespace
) / c
1425 | Csplit
(c, _
) -> w * c
1427 wcmd "geometry %d %d %d"
1428 w (stateh h) (FMTE.to_int conf
.fitmodel
)
1433 let len = String.length state
.text in
1434 let x0 = xadjsb () in
1437 match state
.mode
with
1438 | Textentry _
| View
| LinkNav _
->
1439 let h, _
, _
= state
.uioh#scrollpw
in
1444 filledrect x (float (state
.winh
- (fstate
.fontsize
+ 4) - hscrollh))
1445 (x+.w) (float (state
.winh
- hscrollh))
1448 let w = float (wadjsb () + state
.winw
- 1) in
1449 if state
.progress
>= 0.0 && state
.progress
< 1.0
1451 GlDraw.color
(0.3, 0.3, 0.3);
1452 let w1 = w *. state
.progress
in
1454 GlDraw.color
(0.0, 0.0, 0.0);
1455 rect (float x0+.w1) (float x0+.w-.w1)
1458 GlDraw.color
(0.0, 0.0, 0.0);
1462 GlDraw.color
(1.0, 1.0, 1.0);
1463 drawstring fstate
.fontsize
1464 (if conf
.leftscroll
then x0 + 2 else x0 + if len > 0 then 8 else 2)
1465 (state
.winh
- hscrollh - 5) s;
1468 match state
.mode
with
1469 | Textentry
((prefix
, text, _
, _
, _
, _
), _
) ->
1473 Printf.sprintf
"%s%s_ [%s]" prefix
text state
.text
1475 Printf.sprintf
"%s%s_" prefix
text
1481 | LinkNav _
-> state
.text
1486 if not
(istextentry state
.mode
) && state
.uioh#eformsgs
1488 let s1 = "(press 'e' to review error messasges)" in
1489 if nonemptystr
s then s ^
" " ^
s1 else s1
1499 let len = Queue.length state
.tilelru
in
1501 match state
.throttle
with
1504 then preloadlayout state
.y
1506 | Some
(layout, _
, _
) ->
1510 if state
.memused
<= conf
.memlimit
1515 let (k
, p
, s) as lruitem
= Queue.pop state
.tilelru
in
1516 let n, gen
, colorspace
, angle
, pagew
, pageh
, col, row = k
in
1517 let (_
, pw, ph
, _
) = getpagedim
n in
1520 && colorspace
= conf
.colorspace
1521 && angle
= conf
.angle
1525 let x = col*conf
.tilew
1526 and y = row*conf
.tileh
in
1527 tilevisible (Lazy.force_val
layout) n x y
1529 then Queue.push lruitem state
.tilelru
1532 wcmd "freetile %s" (~
> p
);
1533 state
.memused
<- state
.memused
- s;
1534 state
.uioh#infochanged Memused
;
1535 Hashtbl.remove state
.tilemap k
;
1543 let onpagerect pageno
f =
1545 match conf
.columns
with
1546 | Cmulti
(_
, b) -> b
1548 | Csplit
(_
, b) -> b
1550 if pageno
>= 0 && pageno
< Array.length
b
1552 let (_
, _
, _
, (_
, w, h, _
)) = b.(pageno
) in
1556 let gotopagexy1 pageno
x y =
1557 let _,w1,h1
,leftx
= getpagedim pageno
in
1558 let top = y /. (float h1
) in
1559 let left = x /. (float w1) in
1560 let py, w, h = getpageywh pageno
in
1561 let wh = state
.winh
- hscrollh () in
1562 let x = left *. (float w) in
1563 let x = leftx
+ state
.x + truncate
x in
1564 let wadj = wadjsb () in
1566 if x < 0 || x >= wadj + state
.winw
1570 let pdy = truncate
(top *. float h) in
1571 let y'
= py + pdy in
1572 let dy = y'
- state
.y in
1574 if x != state
.x || not
(dy > 0 && dy < wh)
1576 if conf
.presentation
1578 if abs
(py - y'
) > wh
1585 if state
.x != sx || state
.y != sy
1590 let ww = wadj + state
.winw
in
1592 and qy
= pdy / wh in
1594 and y = py + qy
* wh in
1595 let x = if -x + ww > w1 then -(w1-ww) else x
1596 and y'
= if y + wh > state
.maxy
then state
.maxy
- wh else y in
1598 if conf
.presentation
1600 if abs
(py - y'
) > wh
1610 gotoy_and_clear_text y;
1612 else gotoy_and_clear_text state
.y;
1615 let gotopagexy pageno
x y =
1616 match state
.mode
with
1617 | Birdseye
_ -> gotopage pageno
0.0
1620 | LinkNav
_ -> gotopagexy1 pageno
x y
1623 let getpassword () =
1624 let passcmd = getenvwithdef
"LLPP_ASKPASS" conf
.passcmd in
1629 showtext '
!'
@@ "error getting password: " ^
s;
1630 dolog
"%s" s) passcmd;
1634 (* dolog "%S" cmds; *)
1635 let cl = splitatspace cmds
in
1637 try Scanf.sscanf
s fmt
f
1639 dolog
"error processing '%S': %s" cmds
(exntos exn
);
1642 let addoutline outline
=
1643 match state
.currently
with
1644 | Outlining outlines
->
1645 state
.currently
<- Outlining
(outline
:: outlines
)
1646 | Idle
-> state
.currently
<- Outlining
[outline
]
1649 dolog
"invalid outlining state";
1650 logcurrently state
.currently
1654 state
.uioh#infochanged Pdim
;
1657 | "clearrects" :: [] ->
1658 state
.rects
<- state
.rects1
;
1659 G.postRedisplay "clearrects";
1661 | "continue" :: args
:: [] ->
1662 let n = scan args
"%u" (fun n -> n) in
1663 state
.pagecount
<- n;
1664 begin match state
.currently
with
1666 state
.currently
<- Idle
;
1667 state
.outlines
<- Array.of_list
(List.rev
l)
1673 let cur, cmds
= state
.geomcmds
in
1675 then failwith
"umpossible";
1677 begin match List.rev cmds
with
1679 state
.geomcmds
<- E.s, [];
1680 state
.throttle
<- None
;
1684 state
.geomcmds
<- s, List.rev rest
;
1686 if conf
.maxwait
= None
&& not
!wtmode
1687 then G.postRedisplay "continue";
1689 | "msg" :: args
:: [] ->
1692 | "vmsg" :: args
:: [] ->
1694 then showtext ' ' args
1696 | "emsg" :: args
:: [] ->
1697 Buffer.add_string state
.errmsgs args
;
1698 state
.newerrmsgs
<- true;
1699 G.postRedisplay "error message"
1701 | "progress" :: args
:: [] ->
1702 let progress, text =
1705 f, String.sub args pos
(String.length args
- pos
))
1708 state
.progress <- progress;
1709 G.postRedisplay "progress"
1711 | "firstmatch" :: args
:: [] ->
1712 let pageno, c, x0, y0, x1, y1, x2
, y2
, x3
, y3
=
1713 scan args
"%u %d %f %f %f %f %f %f %f %f"
1714 (fun p
c x0 y0 x1 y1 x2 y2 x3 y3
->
1715 (p
, c, x0, y0, x1, y1, x2
, y2
, x3
, y3
))
1717 let xoff = float (xadjsb ()) in
1721 and x3
= x3
+. xoff in
1722 let y = (getpagey
pageno) + truncate
y0 in
1725 state
.rects1
<- [pageno, c, (x0, y0, x1, y1, x2
, y2
, x3
, y3
)]
1727 | "match" :: args
:: [] ->
1728 let pageno, c, x0, y0, x1, y1, x2
, y2
, x3
, y3
=
1729 scan args
"%u %d %f %f %f %f %f %f %f %f"
1730 (fun p
c x0 y0 x1 y1 x2 y2 x3 y3
->
1731 (p
, c, x0, y0, x1, y1, x2
, y2
, x3
, y3
))
1733 let xoff = float (xadjsb ()) in
1737 and x3
= x3
+. xoff in
1739 (pageno, c, (x0, y0, x1, y1, x2
, y2
, x3
, y3
)) :: state
.rects1
1741 | "page" :: args
:: [] ->
1742 let pageopaques, t
= scan args
"%s %f" (fun p t
-> p
, t
) in
1743 let pageopaque = ~
< pageopaques in
1744 begin match state
.currently
with
1745 | Loading
(l, gen
) ->
1746 vlog "page %d took %f sec" l.pageno t
;
1747 Hashtbl.replace state
.pagemap
(l.pageno, gen
) pageopaque;
1748 begin match state
.throttle
with
1750 let preloadedpages =
1752 then preloadlayout state
.y
1757 List.fold_left
(fun s l -> IntSet.add
l.pageno s)
1758 IntSet.empty
preloadedpages
1761 Hashtbl.fold (fun ((pageno, _) as key) opaque
accu ->
1762 if not
(IntSet.mem
pageno set)
1764 wcmd "freepage %s" (~
> opaque
);
1770 List.iter
(Hashtbl.remove state
.pagemap
) evictedpages;
1773 state
.currently
<- Idle
;
1776 tilepage l.pageno pageopaque state
.layout;
1778 load preloadedpages;
1779 let visible = pagevisible state
.layout l.pageno in
1782 match state
.mode
with
1783 | LinkNav
(Ltnotready
(pageno, dir
)) ->
1784 if pageno = l.pageno
1789 then LDfirstvisible
(l.pagex
, l.pagey, dir
)
1791 if dir
> 0 then LDfirst
else LDlast
1794 findlink
pageopaque ld
1799 showlinktype (getlink
pageopaque n);
1800 state
.mode
<- LinkNav
(Ltexact
(l.pageno, n))
1802 | LinkNav
(Ltgendir
_)
1803 | LinkNav
(Ltexact
_)
1809 if visible && layoutready state
.layout
1811 G.postRedisplay "page";
1815 | Some
(layout, _, _) ->
1816 state
.currently
<- Idle
;
1817 tilepage l.pageno pageopaque layout;
1824 dolog
"Inconsistent loading state";
1825 logcurrently state
.currently
;
1829 | "tile" :: args
:: [] ->
1830 let (x, y, opaques
, size
, t
) =
1831 scan args
"%u %u %s %u %f"
1832 (fun x y p size t
-> (x, y, p
, size
, t
))
1834 let opaque = ~
< opaques
in
1835 begin match state
.currently
with
1836 | Tiling
(l, pageopaque, cs
, angle
, gen
, col, row, tilew
, tileh
) ->
1837 vlog "tile %d [%d,%d] took %f sec" l.pageno col row t
;
1840 if tilew
!= conf
.tilew
|| tileh
!= conf
.tileh
1842 wcmd "freetile %s" (~
> opaque);
1843 state
.currently
<- Idle
;
1847 puttileopaque l col row gen cs angle
opaque size t
;
1848 state
.memused
<- state
.memused
+ size
;
1849 state
.uioh#infochanged Memused
;
1851 Queue.push
((l.pageno, gen
, cs
, angle
, l.pagew
, l.pageh
, col, row),
1852 opaque, size
) state
.tilelru
;
1855 match state
.throttle
with
1856 | None
-> state
.layout
1857 | Some
(layout, _, _) -> layout
1860 state
.currently
<- Idle
;
1862 && conf
.colorspace
= cs
1863 && conf
.angle
= angle
1864 && tilevisible layout l.pageno x y
1865 then conttiling l.pageno pageopaque;
1867 begin match state
.throttle
with
1869 preload state
.layout;
1871 && conf
.colorspace
= cs
1872 && conf
.angle
= angle
1873 && tilevisible state
.layout l.pageno x y
1874 && (not
!wtmode || layoutready state
.layout)
1875 then G.postRedisplay "tile nothrottle";
1877 | Some
(layout, y, _) ->
1878 let ready = layoutready layout in
1882 state
.layout <- layout;
1883 state
.throttle
<- None
;
1884 G.postRedisplay "throttle";
1893 dolog
"Inconsistent tiling state";
1894 logcurrently state
.currently
;
1898 | "pdim" :: args
:: [] ->
1899 let (n, w, h, _) as pdim
=
1900 scan args
"%u %u %u %u" (fun n w h x -> n, w, h, x)
1903 match conf
.fitmodel
with
1905 | FitPage
| FitProportional
->
1906 match conf
.columns
with
1907 | Csplit
_ -> (n, w, h, 0)
1908 | Csingle
_ | Cmulti
_ -> pdim
1910 state
.uioh#infochanged Pdim
;
1911 state
.pdims
<- pdim :: state
.pdims
1913 | "o" :: args
:: [] ->
1914 let (l, n, t
, h, pos
) =
1915 scan args
"%u %u %d %u %n"
1916 (fun l n t
h pos
-> l, n, t
, h, pos
)
1918 let s = String.sub args pos
(String.length args
- pos
) in
1919 addoutline (s, l, Oanchor
(n, float t
/. float h, 0.0))
1921 | "ou" :: args
:: [] ->
1922 let (l, len, pos
) = scan args
"%u %u %n" (fun l len pos
-> l, len, pos
) in
1923 let s = String.sub args pos
len in
1924 let pos2 = pos
+ len + 1 in
1925 let uri = String.sub args
pos2 (String.length args
- pos2) in
1926 addoutline (s, l, Ouri
uri)
1928 | "on" :: args
:: [] ->
1929 let (l, pos
) = scan args
"%u %n" (fun l pos
-> l, pos
) in
1930 let s = String.sub args pos
(String.length args
- pos
) in
1931 addoutline (s, l, Onone
)
1933 | "a" :: args
:: [] ->
1935 scan args
"%u %d %d" (fun n l t
-> n, l, t
)
1937 state
.reprf
<- (fun () -> gotopagexy n (float l) (float t
))
1939 | "info" :: args
:: [] ->
1940 let pos = nindex args '
\t'
in
1941 if pos >= 0 && String.sub args
0 pos = "Title"
1943 let s = String.sub args
(pos+1) @@ String.length args
- pos - 1 in
1947 state
.docinfo
<- (1, args
) :: state
.docinfo
1949 | "infoend" :: [] ->
1950 state
.uioh#infochanged Docinfo
;
1951 state
.docinfo
<- List.rev state
.docinfo
1955 then Wsi.settitle
"Wrong password";
1956 let password = getpassword () in
1958 then error
"document is password protected"
1959 else opendoc state
.path
password
1962 error
"unknown cmd `%S'" cmds
1967 let action = function
1968 | HCprev
-> cbget cb ~
-1
1969 | HCnext
-> cbget cb
1
1970 | HCfirst
-> cbget cb ~
-(cb
.rc)
1971 | HClast
-> cbget cb
(cb
.len - 1 - cb
.rc)
1972 and cancel
() = cb
.rc <- rc
1976 let search pattern forward
=
1977 match conf
.columns
with
1979 showtext '
!'
"searching does not work properly in split columns mode"
1982 if nonemptystr pattern
1985 match state
.layout with
1988 l.pageno, (l.pagey + if forward
then 0 else 0*l.pagevh)
1990 wcmd "search %d %d %d %d,%s\000"
1991 (btod conf
.icase
) pn py (btod forward
) pattern
;
1994 let intentry text key =
1996 if key >= 32 && key < 127
2002 let text = addchar
text c in
2006 state
.text <- Printf.sprintf
"invalid char (%d, `%c')" key c;
2010 let linknentry text key =
2012 if key >= 32 && key < 127
2018 let text = addchar
text c in
2022 state
.text <- Printf.sprintf
"invalid char (%d, `%c')" key c;
2030 let l = String.length
s in
2031 let rec loop pos n = if pos = l then n else
2032 let m = Char.code
s.[pos] - (if pos = 0 && l > 1 then 96 else 97) in
2033 loop (pos+1) (n*26 + m)
2036 let rec loop n = function
2039 match getopaque l.pageno with
2040 | None
-> loop n rest
2042 let m = getlinkcount
opaque in
2045 let under = getlink
opaque n in
2048 else loop (n-m) rest
2050 loop n state
.layout;
2054 let textentry text key =
2055 if key land 0xff00 = 0xff00
2057 else TEcont
(text ^ toutf8
key)
2060 let reqlayout angle fitmodel
=
2061 match state
.throttle
with
2063 if nogeomcmds state
.geomcmds
2064 then state
.anchor <- getanchor
();
2065 conf
.angle
<- angle
mod 360;
2068 match state
.mode
with
2069 | LinkNav
_ -> state
.mode
<- View
2074 conf
.fitmodel
<- fitmodel
;
2075 invalidate "reqlayout"
2077 wcmd "reqlayout %d %d %d"
2078 conf
.angle
(FMTE.to_int conf
.fitmodel
) (stateh state
.winh
)
2083 let settrim trimmargins trimfuzz
=
2084 if nogeomcmds state
.geomcmds
2085 then state
.anchor <- getanchor
();
2086 conf
.trimmargins
<- trimmargins
;
2087 conf
.trimfuzz
<- trimfuzz
;
2088 let x0, y0, x1, y1 = trimfuzz
in
2089 invalidate "settrim"
2091 wcmd "settrim %d %d %d %d %d" (btod conf
.trimmargins
) x0 y0 x1 y1);
2096 match state
.throttle
with
2098 let zoom = max
0.0001 zoom in
2099 if zoom <> conf
.zoom
2101 state
.prevzoom
<- (conf
.zoom, state
.x);
2103 reshape state
.winw state
.winh
;
2104 state
.text <- Printf.sprintf
"zoom is now %-5.2f" (zoom *. 100.0);
2107 | Some
(layout, y, started
) ->
2109 match conf
.maxwait
with
2113 let dt = now
() -. started
in
2121 let setcolumns mode columns coverA coverB
=
2122 state
.prevcolumns
<- Some
(conf
.columns
, conf
.zoom);
2126 then showtext '
!'
"split mode doesn't work in bird's eye"
2128 conf
.columns
<- Csplit
(-columns
, E.a);
2136 conf
.columns
<- Csingle
E.a;
2141 conf
.columns
<- Cmulti
((columns
, coverA
, coverB
), E.a);
2145 reshape state
.winw state
.winh
;
2148 let resetmstate () =
2149 state
.mstate
<- Mnone
;
2150 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
2153 let enterbirdseye () =
2154 let zoom = float conf
.thumbw
/. float state
.winw
in
2155 let birdseyepageno =
2156 let cy = state
.winh
/ 2 in
2160 let rec fold best
= function
2163 let d = cy - (l.pagedispy + l.pagevh/2)
2164 and dbest
= cy - (best
.pagedispy + best
.pagevh/2) in
2165 if abs
d < abs dbest
2172 state
.mode
<- Birdseye
(
2173 { conf
with zoom = conf
.zoom }, state
.x, birdseyepageno, -1, getanchor
()
2177 conf
.presentation
<- false;
2178 conf
.interpagespace
<- 10;
2179 conf
.hlinks
<- false;
2180 conf
.fitmodel
<- FitPage
;
2182 conf
.maxwait
<- None
;
2184 match conf
.beyecolumns
with
2187 Cmulti
((c, 0, 0), E.a)
2188 | None
-> Csingle
E.a
2192 state
.text <- Printf.sprintf
"birds eye mode on (zoom %3.1f%%)"
2197 reshape state
.winw state
.winh
;
2200 let leavebirdseye (c, leftx
, pageno, _, anchor) goback
=
2202 conf
.zoom <- c.zoom;
2203 conf
.presentation
<- c.presentation
;
2204 conf
.interpagespace
<- c.interpagespace
;
2205 conf
.maxwait
<- c.maxwait
;
2206 conf
.hlinks
<- c.hlinks
;
2207 conf
.fitmodel
<- c.fitmodel
;
2208 conf
.beyecolumns
<- (
2209 match conf
.columns
with
2210 | Cmulti
((c, _, _), _) -> Some
c
2212 | Csplit
_ -> failwith
"leaving bird's eye split mode"
2215 match c.columns
with
2216 | Cmulti
(c, _) -> Cmulti
(c, E.a)
2217 | Csingle
_ -> Csingle
E.a
2218 | Csplit
(c, _) -> Csplit
(c, E.a)
2222 state
.text <- Printf.sprintf
"birds eye mode off (zoom %3.1f%%)"
2225 reshape state
.winw state
.winh
;
2226 state
.anchor <- if goback
then anchor else (pageno, 0.0, 1.0);
2230 let togglebirdseye () =
2231 match state
.mode
with
2232 | Birdseye vals
-> leavebirdseye vals
true
2233 | View
-> enterbirdseye ()
2238 let upbirdseye incr
(conf
, leftx
, pageno, hooverpageno
, anchor) =
2239 let pageno = max
0 (pageno - incr
) in
2240 let rec loop = function
2241 | [] -> gotopage1 pageno 0
2242 | l :: _ when l.pageno = pageno ->
2243 if l.pagedispy >= 0 && l.pagey = 0
2244 then G.postRedisplay "upbirdseye"
2245 else gotopage1 pageno 0
2246 | _ :: rest
-> loop rest
2250 state
.mode
<- Birdseye
(conf
, leftx
, pageno, hooverpageno
, anchor)
2253 let downbirdseye incr
(conf
, leftx
, pageno, hooverpageno
, anchor) =
2254 let pageno = min
(state
.pagecount
- 1) (pageno + incr
) in
2255 state
.mode
<- Birdseye
(conf
, leftx
, pageno, hooverpageno
, anchor);
2256 let rec loop = function
2258 let y, h = getpageyh
pageno in
2259 let dy = (y - state
.y) - (state
.winh
- h - conf
.interpagespace
) in
2261 | l :: _ when l.pageno = pageno ->
2262 if l.pagevh != l.pageh
2263 then gotoy (clamp (l.pageh
- l.pagevh + conf
.interpagespace
))
2264 else G.postRedisplay "downbirdseye"
2265 | _ :: rest
-> loop rest
2271 let optentry mode
_ key =
2272 let btos b = if b then "on" else "off" in
2273 if key >= 32 && key < 127
2275 let c = Char.chr
key in
2279 try conf
.scrollstep
<- int_of_string
s with exc
->
2280 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2282 TEswitch
("scroll step: ", E.s, None
, intentry, ondone, true)
2287 conf
.autoscrollstep
<- boundastep state
.winh
(int_of_string
s);
2288 if state
.autoscroll
<> None
2289 then state
.autoscroll
<- Some conf
.autoscrollstep
2291 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2293 TEswitch
("auto scroll step: ", E.s, None
, intentry, ondone, true)
2298 let n, a, b = multicolumns_of_string
s in
2299 setcolumns mode
n a b;
2301 state
.text <- Printf.sprintf
"bad columns `%s': %s" s (exntos exc
)
2303 TEswitch
("columns: ", E.s, None
, textentry, ondone, true)
2308 let zoom = float (int_of_string
s) /. 100.0 in
2311 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2313 TEswitch
("zoom: ", E.s, None
, intentry, ondone, true)
2318 conf
.thumbw
<- bound
(int_of_string
s) 2 4096;
2320 Printf.sprintf
"thumbnail width is set to %d" conf
.thumbw
;
2321 begin match mode
with
2323 leavebirdseye beye
false;
2330 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2332 TEswitch
("thumbnail width: ", E.s, None
, intentry, ondone, true)
2337 Some
(int_of_string
s)
2339 state
.text <- Printf.sprintf
"bad integer `%s': %s"
2343 | Some angle
-> reqlayout angle conf
.fitmodel
2346 TEswitch
("rotation: ", E.s, None
, intentry, ondone, true)
2349 conf
.icase
<- not conf
.icase
;
2350 TEdone
("case insensitive search " ^
(btos conf
.icase
))
2353 conf
.preload <- not conf
.preload;
2355 TEdone
("preload " ^
(btos conf
.preload))
2358 conf
.verbose
<- not conf
.verbose
;
2359 TEdone
("verbose " ^
(btos conf
.verbose
))
2362 conf
.debug
<- not conf
.debug
;
2363 TEdone
("debug " ^
(btos conf
.debug
))
2366 conf
.maxhfit
<- not conf
.maxhfit
;
2367 state
.maxy
<- calcheight
();
2368 TEdone
("maxhfit " ^
(btos conf
.maxhfit
))
2371 conf
.crophack
<- not conf
.crophack
;
2372 TEdone
("crophack " ^
btos conf
.crophack
)
2376 match conf
.maxwait
with
2378 conf
.maxwait
<- Some infinity
;
2379 "always wait for page to complete"
2381 conf
.maxwait
<- None
;
2382 "show placeholder if page is not ready"
2387 conf
.underinfo
<- not conf
.underinfo
;
2388 TEdone
("underinfo " ^
btos conf
.underinfo
)
2391 conf
.savebmarks
<- not conf
.savebmarks
;
2392 TEdone
("persistent bookmarks " ^
btos conf
.savebmarks
)
2398 match state
.layout with
2403 conf
.interpagespace
<- int_of_string
s;
2404 docolumns conf
.columns
;
2405 state
.maxy
<- calcheight
();
2406 let y = getpagey
pageno in
2409 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2411 TEswitch
("vertical margin: ", E.s, None
, intentry, ondone, true)
2415 match conf
.fitmodel
with
2416 | FitProportional
-> FitWidth
2417 | FitWidth
| FitPage
-> FitProportional
2419 reqlayout conf
.angle
fm;
2420 TEdone
("proportional display " ^
btos (fm == FitProportional
))
2423 settrim (not conf
.trimmargins
) conf
.trimfuzz
;
2424 TEdone
("trim margins " ^
btos conf
.trimmargins
)
2427 conf
.invert
<- not conf
.invert
;
2428 TEdone
("invert colors " ^
btos conf
.invert
)
2432 cbput state
.hists
.sel
s;
2435 TEswitch
("selection command: ", E.s, Some
(onhist state
.hists
.sel
),
2436 textentry, ondone, true)
2440 then conf
.pax
<- Some
(ref (0.0, 0, 0))
2441 else conf
.pax
<- None
;
2442 TEdone
("PAX " ^
btos (conf
.pax
!= None
))
2445 state
.text <- Printf.sprintf
"bad option %d `%c'" key c;
2451 class type lvsource
= object
2452 method getitemcount
: int
2453 method getitem
: int -> (string * int)
2454 method hasaction
: int -> bool
2462 method getactive
: int
2463 method getfirst
: int
2465 method getminfo
: (int * int) array
2468 class virtual lvsourcebase
= object
2469 val mutable m_active
= 0
2470 val mutable m_first
= 0
2471 val mutable m_pan
= 0
2472 method getactive
= m_active
2473 method getfirst
= m_first
2474 method getpan
= m_pan
2475 method getminfo
: (int * int) array
= E.a
2478 let textentrykeyboard
2479 key _mask
((c, text, opthist
, onkey
, ondone, cancelonempty
), onleave
) =
2481 if key >= 0xffb0 && key <= 0xffb9
2482 then key - 0xffb0 + 48 else key
2485 state
.mode
<- Textentry
(te
, onleave
);
2488 G.postRedisplay "textentrykeyboard enttext";
2490 let histaction cmd
=
2493 | Some
(action, _) ->
2494 state
.mode
<- Textentry
(
2495 (c, action cmd
, opthist
, onkey
, ondone, cancelonempty
), onleave
2497 G.postRedisplay "textentry histaction"
2501 if emptystr
text && cancelonempty
2504 G.postRedisplay "textentrykeyboard after cancel";
2507 let s = withoutlastutf8
text in
2508 enttext (c, s, opthist
, onkey
, ondone, cancelonempty
)
2510 | @enter
| @kpenter
->
2513 G.postRedisplay "textentrykeyboard after confirm"
2515 | @up
| @kpup
-> histaction HCprev
2516 | @down
| @kpdown
-> histaction HCnext
2517 | @home
| @kphome
-> histaction HCfirst
2518 | @jend
| @kpend
-> histaction HClast
2523 begin match opthist
with
2525 | Some
(_, onhistcancel
) -> onhistcancel
()
2529 G.postRedisplay "textentrykeyboard after cancel2"
2532 enttext (c, E.s, opthist
, onkey
, ondone, cancelonempty
)
2535 | @delete
| @kpdelete
-> ()
2538 && key land 0xff00 != 0xff00 (* keyboard *)
2539 && key land 0xfe00 != 0xfe00 (* xkb *)
2540 && key land 0xfd00 != 0xfd00 (* 3270 *)
2542 begin match onkey
text key with
2546 G.postRedisplay "textentrykeyboard after confirm2";
2549 enttext (c, text, opthist
, onkey
, ondone, cancelonempty
);
2553 G.postRedisplay "textentrykeyboard after cancel3"
2556 state
.mode
<- Textentry
(te
, onleave
);
2557 G.postRedisplay "textentrykeyboard switch";
2561 vlog "unhandled key %s" (Wsi.keyname
key)
2564 let firstof first active
=
2565 if first
> active
|| abs
(first
- active
) > fstate
.maxrows
- 1
2566 then max
0 (active
- (fstate
.maxrows
/2))
2570 let calcfirst first active
=
2573 let rows = active
- first
in
2574 if rows > fstate
.maxrows
then active
- fstate
.maxrows
else first
2578 let scrollph y maxy
=
2579 let sh = float (maxy
+ state
.winh
) /. float state
.winh
in
2580 let sh = float state
.winh
/. sh in
2581 let sh = max
sh (float conf
.scrollh
) in
2583 let percent = float y /. float maxy
in
2584 let position = (float state
.winh
-. sh) *. percent in
2587 if position +. sh > float state
.winh
2588 then float state
.winh
-. sh
2594 let coe s = (s :> uioh
);;
2596 class listview ~zebra ~helpmode ~
(source
:lvsource
) ~trusted ~modehash
=
2598 val m_pan
= source#getpan
2599 val m_first
= source#getfirst
2600 val m_active
= source#getactive
2602 val m_prev_uioh
= state
.uioh
2604 method private elemunder
y =
2608 let n = y / (fstate
.fontsize
+1) in
2609 if m_first
+ n < source#getitemcount
2611 if source#hasaction
(m_first
+ n)
2612 then Some
(m_first
+ n)
2619 GlFunc.blend_func ~src
:`src_alpha ~dst
:`one_minus_src_alpha
;
2620 GlDraw.color
(0., 0., 0.) ~alpha
:0.85;
2621 filledrect 0. 0. (float state
.winw
) (float state
.winh
);
2622 GlDraw.color
(1., 1., 1.);
2623 Gl.enable `texture_2d
;
2624 let fs = fstate
.fontsize
in
2626 let hw = (wadjsb () + xadjsb () + state
.winw
)/3 in
2627 let ww = fstate
.wwidth
in
2628 let tabw = 17.0*.ww in
2629 let itemcount = source#getitemcount
in
2630 let minfo = source#getminfo
in
2633 then float (xadjsb ()), float (state
.winw
- 1)
2634 else 0.0, float (state
.winw
- conf
.scrollbw
- 1)
2636 let xadj = xadjsb () in
2638 if (row - m_first
) > fstate
.maxrows
2641 if row >= 0 && row < itemcount
2643 let (s, level
) = source#getitem
row in
2644 let y = (row - m_first
) * nfs in
2646 (if conf
.leftscroll
then float xadj else 5.0)
2647 +. (float (level
+ m_pan
)) *. ww in
2650 (let c = if row land 1 = 0 then 1.0 else 0.92 in (c,c,c));
2654 Gl.disable `texture_2d
;
2655 let alpha = if source#hasaction
row then 0.9 else 0.3 in
2656 GlDraw.color
(1., 1., 1.) ~
alpha;
2657 linerect (x0 +. 1.) (float (y + 1)) (x1) (float (y + fs + 3));
2658 Gl.enable `texture_2d
;
2661 if zebra
&& row land 1 = 1
2665 GlDraw.color
(c,c,c);
2666 let drawtabularstring s =
2668 let x'
= truncate
(x0 +. x) in
2669 let pos = nindex
s '
\000'
in
2671 then drawstring1 fs x'
(y+nfs) s
2673 let s1 = String.sub
s 0 pos
2674 and s2
= String.sub
s (pos+1) (String.length
s - pos - 1) in
2679 let s'
= withoutlastutf8
s in
2680 let s = s' ^
"@Uellipsis" in
2681 let w = measurestr
fs s in
2682 if float x'
+. w +. ww < float (hw + x'
)
2687 if float x'
+. ww +. measurestr
fs s1 > float (hw + x'
)
2691 ignore
(drawstring1 fs x'
(y+nfs) s1);
2692 drawstring1 fs (hw + x'
) (y+nfs) s2
2696 let x = if helpmode
&& row > 0 then x +. ww else x in
2697 let tabpos = nindex
s '
\t'
in
2700 let len = String.length
s - tabpos - 1 in
2701 let s1 = String.sub
s 0 tabpos
2702 and s2
= String.sub
s (tabpos + 1) len in
2703 let nx = drawstr x s1 in
2705 let x = x +. (max
tabw sw) in
2708 let len = String.length
s - 2 in
2709 if len > 0 && s.[0] = '
\xc2'
&& s.[1] = '
\xb7'
2711 let s = String.sub
s 2 len in
2712 let x = if not helpmode
then x +. ww else x in
2713 GlDraw.color
(1.2, 1.2, 1.2);
2714 let vinc = drawstring1 (fs+fs/4)
2715 (truncate
(x -. ww)) (y+nfs) s in
2716 GlDraw.color
(1., 1., 1.);
2717 vinc +. (float fs *. 0.8)
2723 ignore
(drawtabularstring s);
2729 GlDraw.color
(1.0, 1.0, 1.0) ~
alpha:0.5;
2730 let xadj = float (xadjsb () + 5) in
2732 if (row - m_first
) > fstate
.maxrows
2735 if row >= 0 && row < itemcount
2737 let (s, level
) = source#getitem
row in
2738 let pos0 = nindex
s '
\000'
in
2739 let y = (row - m_first
) * nfs in
2740 let x = float (level
+ m_pan
) *. ww in
2741 let (first
, last
) = minfo.(row) in
2743 if pos0 > 0 && first
> pos0
2744 then String.sub
s (pos0+1) (first
-pos0-1)
2745 else String.sub
s 0 first
2747 let suffix = String.sub
s first
(last
- first
) in
2748 let w1 = measurestr fstate
.fontsize
prefix in
2749 let w2 = measurestr fstate
.fontsize
suffix in
2750 let x = x +. if conf
.leftscroll
then xadj else 5.0 in
2751 let x = if pos0 > 0 && first
> pos0 then x +. float hw else x in
2753 and y0 = float (y+2) in
2755 and y1 = float (y+fs+3) in
2756 filledrect x0 y0 x1 y1;
2761 Gl.disable `texture_2d
;
2762 if Array.length
minfo > 0 then loop m_first
;
2765 method updownlevel incr
=
2766 let len = source#getitemcount
in
2768 if m_active
>= 0 && m_active
< len
2769 then snd
(source#getitem m_active
)
2773 if i
= len then i
-1 else if i
= -1 then 0 else
2774 let _, l = source#getitem i
in
2775 if l != curlevel then i
else flow (i
+incr
)
2777 let active = flow m_active
in
2778 let first = calcfirst m_first
active in
2779 G.postRedisplay "outline updownlevel";
2780 {< m_active
= active; m_first
= first >}
2782 method private key1
key mask
=
2783 let set1 active first qsearch
=
2784 coe {< m_active
= active; m_first
= first; m_qsearch
= qsearch
>}
2786 let search active pattern incr
=
2787 let active = if active = -1 then m_first
else active in
2790 if n >= 0 && n < source#getitemcount
2792 let s, _ = source#getitem
n in
2794 (try ignore
(Str.search_forward re
s 0); true
2795 with Not_found
-> false)
2797 else loop (n + incr
)
2804 let re = Str.regexp_case_fold pattern
in
2810 let itemcount = source#getitemcount
in
2811 let find start incr
=
2813 if i
= -1 || i
= itemcount
2816 if source#hasaction i
2818 else find (i
+ incr
)
2823 let set active first =
2824 let first = bound
first 0 (itemcount - fstate
.maxrows
) in
2826 coe {< m_active
= active; m_first
= first; m_qsearch
= E.s >}
2829 let isvisible first n = n >= first && n - first <= fstate
.maxrows
in
2831 let incr1 = if incr
> 0 then 1 else -1 in
2832 if isvisible m_first m_active
2835 let next = m_active
+ incr
in
2837 if next < 0 || next >= itemcount
2839 else find next incr1
2841 if abs
(m_active
- next) > fstate
.maxrows
2847 let first = m_first
+ incr
in
2848 let first = bound
first 0 (itemcount - fstate
.maxrows
) in
2850 let next = m_active
+ incr
in
2851 let next = bound
next 0 (itemcount - 1) in
2858 if isvisible first next
2865 let first = min
next m_first
in
2867 if abs
(next - first) > fstate
.maxrows
2873 let first = m_first
+ incr
in
2874 let first = bound
first 0 (itemcount - 1) in
2876 let next = m_active
+ incr
in
2877 let next = bound
next 0 (itemcount - 1) in
2878 let next = find next incr1 in
2880 if next = -1 || abs
(m_active
- first) > fstate
.maxrows
2882 let active = if m_active
= -1 then next else m_active
in
2887 if isvisible first active
2893 G.postRedisplay "listview navigate";
2897 | (@r
|@s) when Wsi.withctrl mask
->
2898 let incr = if key = @r
then -1 else 1 in
2900 match search (m_active
+ incr) m_qsearch
incr with
2902 state
.text <- m_qsearch ^
" [not found]";
2905 state
.text <- m_qsearch
;
2906 active, firstof m_first
active
2908 G.postRedisplay "listview ctrl-r/s";
2909 set1 active first m_qsearch
;
2911 | @insert
when Wsi.withctrl mask
->
2912 if m_active
>= 0 && m_active
< source#getitemcount
2914 let s, _ = source#getitem m_active
in
2920 if emptystr m_qsearch
2923 let qsearch = withoutlastutf8 m_qsearch
in
2927 G.postRedisplay "listview empty qsearch";
2928 set1 m_active m_first
E.s;
2932 match search m_active
qsearch ~
-1 with
2934 state
.text <- qsearch ^
" [not found]";
2937 state
.text <- qsearch;
2938 active, firstof m_first
active
2940 G.postRedisplay "listview backspace qsearch";
2941 set1 active first qsearch
2944 | key when (key != 0 && key land 0xff00 != 0xff00) ->
2945 let pattern = m_qsearch ^ toutf8
key in
2947 match search m_active
pattern 1 with
2949 state
.text <- pattern ^
" [not found]";
2952 state
.text <- pattern;
2953 active, firstof m_first
active
2955 G.postRedisplay "listview qsearch add";
2956 set1 active first pattern;
2960 if emptystr m_qsearch
2962 G.postRedisplay "list view escape";
2963 let mx, my
= state
.mpos
in
2967 source#exit ~uioh
:(coe self
)
2968 ~cancel
:true ~
active:m_active ~
first:m_first ~pan
:m_pan
2970 | None
-> m_prev_uioh
2975 G.postRedisplay "list view kill qsearch";
2976 coe {< m_qsearch
= E.s >}
2979 | @enter
| @kpenter
->
2981 let self = {< m_qsearch
= E.s >} in
2983 G.postRedisplay "listview enter";
2984 if m_active
>= 0 && m_active
< source#getitemcount
2986 source#exit ~uioh
:(coe self) ~cancel
:false
2987 ~
active:m_active ~
first:m_first ~pan
:m_pan
;
2990 source#exit ~uioh
:(coe self) ~cancel
:true
2991 ~
active:m_active ~
first:m_first ~pan
:m_pan
;
2994 begin match opt with
2995 | None
-> m_prev_uioh
2999 | @delete
| @kpdelete
->
3002 | @up
| @kpup
-> navigate ~
-1
3003 | @down
| @kpdown
-> navigate 1
3004 | @prior
| @kpprior
-> navigate ~
-(fstate
.maxrows
)
3005 | @next | @kpnext
-> navigate fstate
.maxrows
3007 | @right
| @kpright
->
3009 G.postRedisplay "listview right";
3010 coe {< m_pan
= m_pan
- 1 >}
3012 | @left | @kpleft
->
3014 G.postRedisplay "listview left";
3015 coe {< m_pan
= m_pan
+ 1 >}
3017 | @home
| @kphome
->
3018 let active = find 0 1 in
3019 G.postRedisplay "listview home";
3023 let first = max
0 (itemcount - fstate
.maxrows
) in
3024 let active = find (itemcount - 1) ~
-1 in
3025 G.postRedisplay "listview end";
3028 | key when (key = 0 || key land 0xff00 = 0xff00) ->
3032 dolog
"listview unknown key %#x" key; coe self
3034 method key key mask
=
3035 match state
.mode
with
3036 | Textentry te
-> textentrykeyboard key mask te
; coe self
3039 | LinkNav
_ -> self#key1
key mask
3041 method button button down
x y _ =
3044 | 1 when x > state
.winw
- conf
.scrollbw
->
3045 G.postRedisplay "listview scroll";
3048 let _, position, sh = self#
scrollph in
3049 if y > truncate
position && y < truncate
(position +. sh)
3051 state
.mstate
<- Mscrolly
;
3055 let s = float (max
0 (y - conf
.scrollh
)) /. float state
.winh
in
3056 let first = truncate
(s *. float source#getitemcount
) in
3057 let first = min source#getitemcount
first in
3058 Some
(coe {< m_first
= first; m_active
= first >})
3060 state
.mstate
<- Mnone
;
3064 begin match self#elemunder
y with
3066 G.postRedisplay "listview click";
3067 source#exit ~uioh
:(coe {< m_active
= n >})
3068 ~cancel
:false ~
active:n ~
first:m_first ~pan
:m_pan
3072 | n when (n == 4 || n == 5) && not down
->
3073 let len = source#getitemcount
in
3075 if n = 5 && m_first
+ fstate
.maxrows
>= len
3079 let first = m_first
+ (if n == 4 then -1 else 1) in
3080 bound
first 0 (len - 1)
3082 G.postRedisplay "listview wheel";
3083 Some
(coe {< m_first
= first >})
3084 | n when (n = 6 || n = 7) && not down
->
3085 let inc = if n = 7 then -1 else 1 in
3086 G.postRedisplay "listview hwheel";
3087 Some
(coe {< m_pan
= m_pan
+ inc >})
3092 | None
-> m_prev_uioh
3095 method multiclick
_ x y = self#button
1 true x y
3098 match state
.mstate
with
3100 let s = float (max
0 (y - conf
.scrollh
)) /. float state
.winh
in
3101 let first = truncate
(s *. float source#getitemcount
) in
3102 let first = min source#getitemcount
first in
3103 G.postRedisplay "listview motion";
3104 coe {< m_first
= first; m_active
= first >}
3112 method pmotion
x y =
3113 if x < state
.winw
- conf
.scrollbw
3116 match self#elemunder
y with
3117 | None
-> Wsi.setcursor
Wsi.CURSOR_INHERIT
; m_active
3118 | Some
n -> Wsi.setcursor
Wsi.CURSOR_INFO
; n
3122 then (G.postRedisplay "listview pmotion"; {< m_active
= n >})
3127 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
3131 method infochanged
_ = ()
3133 method scrollpw
= (0, 0.0, 0.0)
3135 let nfs = fstate
.fontsize
+ 1 in
3136 let y = m_first
* nfs in
3137 let itemcount = source#getitemcount
in
3138 let maxi = max
0 (itemcount - fstate
.maxrows
) in
3139 let maxy = maxi * nfs in
3140 let p, h = scrollph y maxy in
3143 method modehash
= modehash
3144 method eformsgs
= false
3145 method alwaysscrolly
= true
3148 class outlinelistview ~zebra ~source
=
3149 let settext autonarrow
s =
3152 let ss = source#statestr
in
3156 else "{" ^
ss ^
"} [" ^
s ^
"]"
3157 else state
.text <- s
3163 ~source
:(source
:> lvsource
)
3165 ~modehash
:(findkeyhash conf
"outline")
3168 val m_autonarrow
= false
3170 method! key key mask
=
3172 if emptystr state
.text
3174 else fstate
.maxrows - 2
3176 let calcfirst first active =
3179 let rows = active - first in
3180 if rows > maxrows then active - maxrows else first
3184 let active = m_active
+ incr in
3185 let active = bound
active 0 (source#getitemcount
- 1) in
3186 let first = calcfirst m_first
active in
3187 G.postRedisplay "outline navigate";
3188 coe {< m_active
= active; m_first
= first >}
3190 let navscroll first =
3192 let dist = m_active
- first in
3198 else first + maxrows
3201 G.postRedisplay "outline navscroll";
3202 coe {< m_first
= first; m_active
= active >}
3204 let ctrl = Wsi.withctrl mask
in
3209 then (source#denarrow
; E.s)
3211 let pattern = source#renarrow
in
3212 if nonemptystr m_qsearch
3213 then (source#narrow m_qsearch
; m_qsearch
)
3217 settext (not m_autonarrow
) text;
3218 G.postRedisplay "toggle auto narrowing";
3219 coe {< m_first
= 0; m_active
= 0; m_autonarrow
= not m_autonarrow
>}
3221 | @slash
when emptystr m_qsearch
&& not m_autonarrow
->
3223 G.postRedisplay "toggle auto narrowing";
3224 coe {< m_first
= 0; m_active
= 0; m_autonarrow
= true >}
3227 source#narrow m_qsearch
;
3229 then source#add_narrow_pattern m_qsearch
;
3230 G.postRedisplay "outline ctrl-n";
3231 coe {< m_first
= 0; m_active
= 0 >}
3234 let active = source#calcactive
(getanchor
()) in
3235 let first = firstof m_first
active in
3236 G.postRedisplay "outline ctrl-s";
3237 coe {< m_first
= first; m_active
= active >}
3240 G.postRedisplay "outline ctrl-u";
3241 if m_autonarrow
&& nonemptystr m_qsearch
3243 ignore
(source#renarrow
);
3244 settext m_autonarrow
E.s;
3245 coe {< m_first
= 0; m_active
= 0; m_qsearch
= E.s >}
3248 source#del_narrow_pattern
;
3249 let pattern = source#renarrow
in
3251 if emptystr
pattern then E.s else "Narrowed to " ^
pattern
3253 settext m_autonarrow
text;
3254 coe {< m_first
= 0; m_active
= 0; m_qsearch
= E.s >}
3258 let first = max
0 (m_active
- (fstate
.maxrows / 2)) in
3259 G.postRedisplay "outline ctrl-l";
3260 coe {< m_first
= first >}
3262 | @tab
when m_autonarrow
->
3263 if nonemptystr m_qsearch
3265 G.postRedisplay "outline list view tab";
3266 source#add_narrow_pattern m_qsearch
;
3268 coe {< m_qsearch
= E.s >}
3272 | @escape
when m_autonarrow
->
3273 if nonemptystr m_qsearch
3274 then source#add_narrow_pattern m_qsearch
;
3277 | @enter
| @kpenter
when m_autonarrow
->
3278 if nonemptystr m_qsearch
3279 then source#add_narrow_pattern m_qsearch
;
3282 | key when m_autonarrow
&& (key != 0 && key land 0xff00 != 0xff00) ->
3283 let pattern = m_qsearch ^ toutf8
key in
3284 G.postRedisplay "outlinelistview autonarrow add";
3285 source#narrow
pattern;
3286 settext true pattern;
3287 coe {< m_first
= 0; m_active
= 0; m_qsearch
= pattern >}
3289 | key when m_autonarrow
&& key = @backspace
->
3290 if emptystr m_qsearch
3293 let pattern = withoutlastutf8 m_qsearch
in
3294 G.postRedisplay "outlinelistview autonarrow backspace";
3295 ignore
(source#renarrow
);
3296 source#narrow
pattern;
3297 settext true pattern;
3298 coe {< m_first
= 0; m_active
= 0; m_qsearch
= pattern >}
3300 | @delete
| @kpdelete
->
3301 source#remove m_active
;
3302 G.postRedisplay "outline delete";
3303 let active = max
0 (m_active
-1) in
3304 coe {< m_first
= firstof m_first
active;
3305 m_active
= active >}
3307 | @up
| @kpup
when ctrl ->
3308 navscroll (max
0 (m_first
- 1))
3310 | @down
| @kpdown
when ctrl ->
3311 navscroll (min
(source#getitemcount
- 1) (m_first
+ 1))
3313 | @up
| @kpup
-> navigate ~
-1
3314 | @down
| @kpdown
-> navigate 1
3315 | @prior
| @kpprior
-> navigate ~
-(fstate
.maxrows)
3316 | @next | @kpnext
-> navigate fstate
.maxrows
3318 | @right
| @kpright
->
3322 G.postRedisplay "outline ctrl right";
3323 {< m_pan
= m_pan
+ 1 >}
3325 else self#updownlevel
1
3329 | @left | @kpleft
->
3333 G.postRedisplay "outline ctrl left";
3334 {< m_pan
= m_pan
- 1 >}
3336 else self#updownlevel ~
-1
3340 | @home
| @kphome
->
3341 G.postRedisplay "outline home";
3342 coe {< m_first
= 0; m_active
= 0 >}
3345 let active = source#getitemcount
- 1 in
3346 let first = max
0 (active - fstate
.maxrows) in
3347 G.postRedisplay "outline end";
3348 coe {< m_active
= active; m_first
= first >}
3350 | _ -> super#
key key mask
3353 let genhistoutlines =
3354 let order ty
(p1
, c1
, _, _, _, _) (p2
, c2
, _, _, _, _) =
3356 | `lastvisit
-> compare c1
.lastvisit c2
.lastvisit
3357 | `path
-> compare p2 p1
3358 | `file
-> compare
(Filename.basename p2
) (Filename.basename p1
)
3360 let e1 = emptystr c1
.title
3361 and e2
= emptystr c2
.title
in
3363 then compare
(Filename.basename p2
) (Filename.basename p1
)
3366 else compare c1
.title c2
.title
3368 let showfullpath = ref false in
3369 let showorigin = ref true in
3372 let s = if orderty
= t
then "[@Uradical] " ^
s else "[ ] " ^
s in
3373 s, 0, Oaction
(fun () -> Config.historder
:= t
; reeenterhist := true)
3375 let list = ref [] in
3376 if Config.gethist
list
3380 (fun accu (path
, c, b, x, a, o) ->
3381 let hist = (path
, (c, b, x, a, o)) in
3383 let s = if nonemptystr
o && !showorigin then o else path
in
3384 if !showfullpath then s else Filename.basename
s
3386 let base = mbtoutf8
s in
3387 (base ^
"\000" ^
c.title
, 1, Ohistory
hist) :: accu
3389 [ setorty "Sort by time of last visit" `lastvisit
;
3390 setorty "Sort by file name" `file
;
3391 setorty "Sort by path" `path
;
3392 setorty "Sort by title" `title
;
3393 (if !showfullpath then "@Uradical "
3394 else " ") ^
"Show full path", 0, Oaction
(fun () ->
3395 showfullpath := not
!showfullpath; reeenterhist := true);
3396 (if !showorigin then "@Uradical "
3397 else " ") ^
"Show origin", 0, Oaction
(fun () ->
3398 showorigin := not
!showorigin; reeenterhist := true)
3399 ] (List.sort
(order orderty
) !list)
3405 let gotohist (path
, (c, bookmarks
, x, anchor, origin
)) =
3406 Config.save
leavebirdseye;
3407 state
.anchor <- anchor;
3408 state
.bookmarks
<- bookmarks
;
3409 state
.origin
<- origin
;
3412 let x0, y0, x1, y1 = conf
.trimfuzz
in
3413 wcmd "trimset %d %d %d %d %d" (btod conf
.trimmargins
) x0 y0 x1 y1;
3414 reshape ~firsttime
:true state
.winw state
.winh
;
3415 opendoc path origin
;
3419 let makecheckers () =
3420 (* Based on lablGL-1.04/LablGlut/examples/lablGL/checker.ml which had
3422 converted by Issac Trotts. July 25, 2002 *)
3423 let image = GlPix.create `ubyte ~format
:`luminance ~width
:2 ~height
:2 in
3424 Raw.sets_string
(GlPix.to_raw
image) ~
pos:0 "\255\200\200\255";
3425 let id = GlTex.gen_texture
() in
3426 GlTex.bind_texture ~target
:`texture_2d
id;
3427 GlPix.store
(`unpack_alignment
1);
3428 GlTex.image2d
image;
3429 List.iter
(GlTex.parameter ~target
:`texture_2d
)
3430 [ `mag_filter `nearest
; `min_filter `nearest
];
3434 let setcheckers enabled
=
3435 match state
.checkerstexid
with
3437 if enabled
then state
.checkerstexid
<- Some
(makecheckers ())
3439 | Some checkerstexid
->
3442 GlTex.delete_texture checkerstexid
;
3443 state
.checkerstexid
<- None
;
3447 let describe_location () =
3448 let fn = page_of_y state
.y in
3449 let ln = page_of_y
(state
.y + state
.winh
- hscrollh () - 1) in
3450 let maxy = state
.maxy - (if conf
.maxhfit
then state
.winh
else 0) in
3454 else (100. *. (float state
.y /. float maxy))
3458 Printf.sprintf
"page %d of %d [%.2f%%]"
3459 (fn+1) state
.pagecount
percent
3462 "pages %d-%d of %d [%.2f%%]"
3463 (fn+1) (ln+1) state
.pagecount
percent
3466 let setpresentationmode v
=
3467 let n = page_of_y state
.y in
3468 state
.anchor <- (n, 0.0, 1.0);
3469 conf
.presentation
<- v
;
3470 if conf
.fitmodel
= FitPage
3471 then reqlayout conf
.angle conf
.fitmodel
;
3476 let btos b = if b then "@Uradical" else E.s in
3477 let showextended = ref false in
3478 let leave mode
_ = state
.mode
<- mode
in
3481 val mutable m_first_time
= true
3482 val mutable m_l
= []
3483 val mutable m_a
= E.a
3484 val mutable m_prev_uioh
= nouioh
3485 val mutable m_prev_mode
= View
3487 inherit lvsourcebase
3489 method reset prev_mode prev_uioh
=
3490 m_a
<- Array.of_list
(List.rev m_l
);
3492 m_prev_mode
<- prev_mode
;
3493 m_prev_uioh
<- prev_uioh
;
3497 if n >= Array.length m_a
3501 | _, _, _, Action
_ -> m_active
<- n
3502 | _, _, _, Noaction
-> loop (n+1)
3505 m_first_time
<- false;
3508 method int name get
set =
3510 (name
, `
int get
, 1, Action
(
3513 try set (int_of_string
s)
3515 state
.text <- Printf.sprintf
"bad integer `%s': %s"
3519 let te = name ^
": ", E.s, None
, intentry, ondone, true in
3520 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3524 method int_with_suffix name get
set =
3526 (name
, `intws get
, 1, Action
(
3529 try set (int_of_string_with_suffix
s)
3531 state
.text <- Printf.sprintf
"bad integer `%s': %s"
3536 name ^
": ", E.s, None
, intentry_with_suffix, ondone, true
3538 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3542 method bool ?
(offset
=1) ?
(btos=btos) name get
set =
3544 (name
, `
bool (btos, get
), offset
, Action
(
3551 method color name get
set =
3553 (name
, `color get
, 1, Action
(
3555 let invalid = (nan
, nan
, nan
) in
3558 try color_of_string
s
3560 state
.text <- Printf.sprintf
"bad color `%s': %s"
3567 let te = name ^
": ", E.s, None
, textentry, ondone, true in
3568 state
.text <- color_to_string
(get
());
3569 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3573 method string name get
set =
3575 (name
, `
string get
, 1, Action
(
3577 let ondone s = set s in
3578 let te = name ^
": ", E.s, None
, textentry, ondone, true in
3579 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3583 method colorspace name get
set =
3585 (name
, `
string get
, 1, Action
(
3589 inherit lvsourcebase
3592 m_active
<- CSTE.to_int conf
.colorspace
;
3595 method getitemcount
=
3596 Array.length
CSTE.names
3599 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3600 ignore
(uioh
, first, pan
);
3601 if not cancel
then set active;
3603 method hasaction
_ = true
3607 let modehash = findkeyhash conf
"info" in
3608 coe (new listview ~zebra
:false ~helpmode
:false
3609 ~
source ~trusted
:true ~
modehash)
3612 method paxmark name get
set =
3614 (name
, `
string get
, 1, Action
(
3618 inherit lvsourcebase
3621 m_active
<- MTE.to_int conf
.paxmark
;
3624 method getitemcount
= Array.length
MTE.names
3625 method getitem
n = (MTE.names
.(n), 0)
3626 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3627 ignore
(uioh
, first, pan
);
3628 if not cancel
then set active;
3630 method hasaction
_ = true
3634 let modehash = findkeyhash conf
"info" in
3635 coe (new listview ~zebra
:false ~helpmode
:false
3636 ~
source ~trusted
:true ~
modehash)
3639 method fitmodel name get
set =
3641 (name
, `
string get
, 1, Action
(
3645 inherit lvsourcebase
3648 m_active
<- FMTE.to_int conf
.fitmodel
;
3651 method getitemcount
= Array.length
FMTE.names
3652 method getitem
n = (FMTE.names
.(n), 0)
3653 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3654 ignore
(uioh
, first, pan
);
3655 if not cancel
then set active;
3657 method hasaction
_ = true
3661 let modehash = findkeyhash conf
"info" in
3662 coe (new listview ~zebra
:false ~helpmode
:false
3663 ~
source ~trusted
:true ~
modehash)
3666 method caption
s offset
=
3667 m_l
<- (s, `empty
, offset
, Noaction
) :: m_l
3669 method caption2
s f offset
=
3670 m_l
<- (s, `
string f, offset
, Noaction
) :: m_l
3672 method getitemcount
= Array.length m_a
3675 let tostr = function
3676 | `
int f -> string_of_int
(f ())
3677 | `intws
f -> string_with_suffix_of_int
(f ())
3679 | `color
f -> color_to_string
(f ())
3680 | `
bool (btos, f) -> btos (f ())
3683 let name, t
, offset
, _ = m_a
.(n) in
3684 ((let s = tostr t
in
3686 then Printf.sprintf
"%s\t%s" name s
3690 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3695 match m_a
.(active) with
3696 | _, _, _, Action
f -> f uioh
3697 | _, _, _, Noaction
-> uioh
3708 method hasaction
n =
3710 | _, _, _, Action
_ -> true
3711 | _, _, _, Noaction
-> false
3714 let rec fillsrc prevmode prevuioh
=
3715 let sep () = src#caption
E.s 0 in
3716 let colorp name get
set =
3718 (fun () -> color_to_string
(get
()))
3721 let c = color_of_string
v in
3724 state
.text <- Printf.sprintf
"bad color `%s': %s" v (exntos exn
)
3727 let oldmode = state
.mode
in
3728 let birdseye = isbirdseye state
.mode
in
3730 src#caption
(if birdseye then "Setup (Bird's eye)" else "Setup") 0;
3732 src#
bool "presentation mode"
3733 (fun () -> conf
.presentation
)
3734 (fun v -> setpresentationmode v);
3736 src#
bool "ignore case in searches"
3737 (fun () -> conf
.icase
)
3738 (fun v -> conf
.icase
<- v);
3741 (fun () -> conf
.preload)
3742 (fun v -> conf
.preload <- v);
3744 src#
bool "highlight links"
3745 (fun () -> conf
.hlinks
)
3746 (fun v -> conf
.hlinks
<- v);
3748 src#
bool "under info"
3749 (fun () -> conf
.underinfo
)
3750 (fun v -> conf
.underinfo
<- v);
3752 src#
bool "persistent bookmarks"
3753 (fun () -> conf
.savebmarks
)
3754 (fun v -> conf
.savebmarks
<- v);
3756 src#fitmodel
"fit model"
3757 (fun () -> FMTE.to_string conf
.fitmodel
)
3758 (fun v -> reqlayout conf
.angle
(FMTE.of_int
v));
3760 src#
bool "trim margins"
3761 (fun () -> conf
.trimmargins
)
3762 (fun v -> settrim v conf
.trimfuzz
; fillsrc prevmode prevuioh
);
3764 src#
bool "persistent location"
3765 (fun () -> conf
.jumpback
)
3766 (fun v -> conf
.jumpback
<- v);
3769 src#
int "inter-page space"
3770 (fun () -> conf
.interpagespace
)
3772 conf
.interpagespace
<- n;
3773 docolumns conf
.columns
;
3775 match state
.layout with
3780 state
.maxy <- calcheight
();
3781 let y = getpagey
pageno in
3786 (fun () -> conf
.pagebias
)
3787 (fun v -> conf
.pagebias
<- v);
3789 src#
int "scroll step"
3790 (fun () -> conf
.scrollstep
)
3791 (fun n -> conf
.scrollstep
<- n);
3793 src#
int "horizontal scroll step"
3794 (fun () -> conf
.hscrollstep
)
3795 (fun v -> conf
.hscrollstep
<- v);
3797 src#
int "auto scroll step"
3799 match state
.autoscroll
with
3801 | _ -> conf
.autoscrollstep
)
3803 let n = boundastep state
.winh
n in
3804 if state
.autoscroll
<> None
3805 then state
.autoscroll
<- Some
n;
3806 conf
.autoscrollstep
<- n);
3809 (fun () -> truncate
(conf
.zoom *. 100.))
3810 (fun v -> setzoom ((float v) /. 100.));
3813 (fun () -> conf
.angle
)
3814 (fun v -> reqlayout v conf
.fitmodel
);
3816 src#
int "scroll bar width"
3817 (fun () -> conf
.scrollbw
)
3820 reshape state
.winw state
.winh
;
3823 src#
int "scroll handle height"
3824 (fun () -> conf
.scrollh
)
3825 (fun v -> conf
.scrollh
<- v;);
3827 src#
int "thumbnail width"
3828 (fun () -> conf
.thumbw
)
3830 conf
.thumbw
<- min
4096 v;
3833 leavebirdseye beye
false;
3840 let mode = state
.mode in
3841 src#
string "columns"
3843 match conf
.columns
with
3845 | Cmulti
(multi
, _) -> multicolumns_to_string multi
3846 | Csplit
(count
, _) -> "-" ^ string_of_int count
3849 let n, a, b = multicolumns_of_string
v in
3850 setcolumns mode n a b);
3853 src#caption
"Pixmap cache" 0;
3854 src#int_with_suffix
"size (advisory)"
3855 (fun () -> conf
.memlimit
)
3856 (fun v -> conf
.memlimit
<- v);
3859 (fun () -> Printf.sprintf
"%s bytes, %d tiles"
3860 (string_with_suffix_of_int state
.memused
)
3861 (Hashtbl.length state
.tilemap
)) 1;
3864 src#caption
"Layout" 0;
3865 src#caption2
"Dimension"
3867 Printf.sprintf
"%dx%d (virtual %dx%d)"
3868 state
.winw state
.winh
3873 src#caption2
"Position" (fun () ->
3874 Printf.sprintf
"%dx%d" state
.x state
.y
3877 src#caption2
"Position" (fun () -> describe_location ()) 1
3881 src#
bool ~offset
:0 ~
btos:(fun v -> if v then "(on)" else "(off)")
3882 "Save these parameters as global defaults at exit"
3883 (fun () -> conf
.bedefault
)
3884 (fun v -> conf
.bedefault
<- v)
3888 let btos b = if b then "@Ulguillemet" else "@Urguillemet" in
3889 src#
bool ~offset
:0 ~
btos "Extended parameters"
3890 (fun () -> !showextended)
3891 (fun v -> showextended := v; fillsrc prevmode prevuioh
);
3895 (fun () -> conf
.checkers
)
3896 (fun v -> conf
.checkers
<- v; setcheckers v);
3897 src#
bool "update cursor"
3898 (fun () -> conf
.updatecurs
)
3899 (fun v -> conf
.updatecurs
<- v);
3900 src#
bool "scroll-bar on the left"
3901 (fun () -> conf
.leftscroll
)
3902 (fun v -> conf
.leftscroll
<- v);
3904 (fun () -> conf
.verbose
)
3905 (fun v -> conf
.verbose
<- v);
3906 src#
bool "invert colors"
3907 (fun () -> conf
.invert
)
3908 (fun v -> conf
.invert
<- v);
3910 (fun () -> conf
.maxhfit
)
3911 (fun v -> conf
.maxhfit
<- v);
3912 src#
bool "redirect stderr"
3913 (fun () -> conf
.redirectstderr)
3914 (fun v -> conf
.redirectstderr <- v; redirectstderr ());
3916 (fun () -> conf
.pax
!= None
)
3919 then conf
.pax
<- Some
(ref (now
(), 0, 0))
3920 else conf
.pax
<- None
);
3921 src#
string "uri launcher"
3922 (fun () -> conf
.urilauncher
)
3923 (fun v -> conf
.urilauncher
<- v);
3924 src#
string "path launcher"
3925 (fun () -> conf
.pathlauncher
)
3926 (fun v -> conf
.pathlauncher
<- v);
3927 src#
string "tile size"
3928 (fun () -> Printf.sprintf
"%dx%d" conf
.tilew conf
.tileh
)
3931 let w, h = Scanf.sscanf
v "%dx%d" (fun w h -> w, h) in
3932 conf
.tilew
<- max
64 w;
3933 conf
.tileh
<- max
64 h;
3936 state
.text <- Printf.sprintf
"bad tile size `%s': %s"
3939 src#
int "texture count"
3940 (fun () -> conf
.texcount
)
3943 then conf
.texcount
<- v
3944 else showtext '
!'
" Failed to set texture count please retry later"
3946 src#
int "slice height"
3947 (fun () -> conf
.sliceheight
)
3949 conf
.sliceheight
<- v;
3950 wcmd "sliceh %d" conf
.sliceheight
;
3952 src#
int "anti-aliasing level"
3953 (fun () -> conf
.aalevel
)
3955 conf
.aalevel
<- bound
v 0 8;
3956 state
.anchor <- getanchor
();
3957 opendoc state
.path state
.password;
3959 src#
string "page scroll scaling factor"
3960 (fun () -> string_of_float conf
.pgscale)
3963 let s = float_of_string
v in
3966 state
.text <- Printf.sprintf
3967 "bad page scroll scaling factor `%s': %s" v (exntos exn
)
3970 src#
int "ui font size"
3971 (fun () -> fstate
.fontsize
)
3972 (fun v -> setfontsize (bound
v 5 100));
3973 src#
int "hint font size"
3974 (fun () -> conf
.hfsize
)
3975 (fun v -> conf
.hfsize
<- bound
v 5 100);
3976 colorp "background color"
3977 (fun () -> conf
.bgcolor
)
3978 (fun v -> conf
.bgcolor
<- v);
3979 src#
bool "crop hack"
3980 (fun () -> conf
.crophack
)
3981 (fun v -> conf
.crophack
<- v);
3982 src#
string "trim fuzz"
3983 (fun () -> irect_to_string conf
.trimfuzz
)
3986 conf
.trimfuzz
<- irect_of_string
v;
3988 then settrim true conf
.trimfuzz
;
3990 state
.text <- Printf.sprintf
"bad irect `%s': %s" v (exntos exn
)
3992 src#
string "throttle"
3994 match conf
.maxwait
with
3995 | None
-> "show place holder if page is not ready"
3998 then "wait for page to fully render"
4000 "wait " ^ string_of_float
time
4001 ^
" seconds before showing placeholder"
4005 let f = float_of_string
v in
4007 then conf
.maxwait
<- None
4008 else conf
.maxwait
<- Some
f
4010 state
.text <- Printf.sprintf
"bad time `%s': %s" v (exntos exn
)
4012 src#
string "ghyll scroll"
4014 match conf
.ghyllscroll
with
4016 | Some nab
-> ghyllscroll_to_string nab
4019 try conf
.ghyllscroll
<- ghyllscroll_of_string
v
4021 state
.text <- Printf.sprintf
"bad ghyll `%s': %s" v (exntos exn
)
4023 src#
string "selection command"
4024 (fun () -> conf
.selcmd
)
4025 (fun v -> conf
.selcmd
<- v);
4026 src#
string "synctex command"
4027 (fun () -> conf
.stcmd
)
4028 (fun v -> conf
.stcmd
<- v);
4029 src#
string "pax command"
4030 (fun () -> conf
.paxcmd
)
4031 (fun v -> conf
.paxcmd
<- v);
4032 src#
string "ask password command"
4033 (fun () -> conf
.passcmd)
4034 (fun v -> conf
.passcmd <- v);
4035 src#
string "save path command"
4036 (fun () -> conf
.savecmd
)
4037 (fun v -> conf
.savecmd
<- v);
4038 src#colorspace
"color space"
4039 (fun () -> CSTE.to_string conf
.colorspace
)
4041 conf
.colorspace
<- CSTE.of_int
v;
4045 src#paxmark
"pax mark method"
4046 (fun () -> MTE.to_string conf
.paxmark
)
4047 (fun v -> conf
.paxmark
<- MTE.of_int
v);
4051 (fun () -> conf
.usepbo
)
4052 (fun v -> conf
.usepbo
<- v);
4053 src#
bool "mouse wheel scrolls pages"
4054 (fun () -> conf
.wheelbypage
)
4055 (fun v -> conf
.wheelbypage
<- v);
4056 src#
bool "open remote links in a new instance"
4057 (fun () -> conf
.riani
)
4058 (fun v -> conf
.riani
<- v);
4059 src#
bool "edit annotations inline"
4060 (fun () -> conf
.annotinline
)
4061 (fun v -> conf
.annotinline
<- v);
4065 src#caption
"Document" 0;
4066 List.iter
(fun (_, s) -> src#caption
s 1) state
.docinfo
;
4067 src#caption2
"Pages"
4068 (fun () -> string_of_int state
.pagecount
) 1;
4069 src#caption2
"Dimensions"
4070 (fun () -> string_of_int
(List.length state
.pdims
)) 1;
4074 src#caption
"Trimmed margins" 0;
4075 src#caption2
"Dimensions"
4076 (fun () -> string_of_int
(List.length state
.pdims
)) 1;
4080 src#caption
"OpenGL" 0;
4081 src#caption
(Printf.sprintf
"Vendor\t%s" (GlMisc.get_string `vendor
)) 1;
4082 src#caption
(Printf.sprintf
"Renderer\t%s" (GlMisc.get_string `renderer
)) 1;
4085 src#caption
"Location" 0;
4086 if nonemptystr state
.origin
4087 then src#caption
("Orign\t" ^ mbtoutf8 state
.origin
) 1;
4088 src#caption
("Path\t" ^ mbtoutf8 state
.path
) 1;
4090 src#reset prevmode prevuioh
;
4095 let prevmode = state
.mode
4096 and prevuioh
= state
.uioh in
4097 fillsrc prevmode prevuioh
;
4098 let source = (src :> lvsource
) in
4099 let modehash = findkeyhash conf
"info" in
4100 state
.uioh <- coe (object (self)
4101 inherit listview ~zebra
:false ~helpmode
:false
4102 ~
source ~trusted
:true ~
modehash as super
4103 val mutable m_prevmemused
= 0
4104 method! infochanged
= function
4106 if m_prevmemused
!= state
.memused
4108 m_prevmemused
<- state
.memused
;
4109 G.postRedisplay "memusedchanged";
4111 | Pdim
-> G.postRedisplay "pdimchanged"
4112 | Docinfo
-> fillsrc prevmode prevuioh
4114 method! key key mask
=
4115 if not
(Wsi.withctrl mask
)
4118 | @left | @kpleft
-> coe (self#updownlevel ~
-1)
4119 | @right
| @kpright
-> coe (self#updownlevel
1)
4120 | _ -> super#
key key mask
4121 else super#
key key mask
4123 G.postRedisplay "info";
4129 inherit lvsourcebase
4130 method getitemcount
= Array.length state
.help
4132 let s, l, _ = state
.help
.(n) in
4135 method exit ~
uioh ~cancel ~
active ~
first ~pan
=
4139 match state
.help
.(active) with
4140 | _, _, Action
f -> Some
(f uioh)
4141 | _, _, Noaction
-> Some
uioh
4150 method hasaction
n =
4151 match state
.help
.(n) with
4152 | _, _, Action
_ -> true
4153 | _, _, Noaction
-> false
4159 let modehash = findkeyhash conf
"help" in
4161 state
.uioh <- coe (new listview
4162 ~zebra
:false ~helpmode
:true
4163 ~
source ~trusted
:true ~
modehash);
4164 G.postRedisplay "help";
4170 inherit lvsourcebase
4171 val mutable m_items
= E.a
4173 method getitemcount
= 1 + Array.length m_items
4178 else m_items
.(n-1), 0
4180 method exit ~
uioh ~cancel ~
active ~
first ~pan
=
4185 then Buffer.clear state
.errmsgs
;
4192 method hasaction
n =
4196 state
.newerrmsgs
<- false;
4197 let l = Str.split newlinere
(Buffer.contents state
.errmsgs
) in
4198 m_items
<- Array.of_list
l
4207 let source = (msgsource :> lvsource
) in
4208 let modehash = findkeyhash conf
"listview" in
4209 state
.uioh <- coe (object
4210 inherit listview ~zebra
:false ~helpmode
:false
4211 ~
source ~trusted
:false ~
modehash as super
4214 then msgsource#reset
;
4217 G.postRedisplay "msgs";
4221 let editor = getenvwithdef
"EDITOR" E.s in
4225 let tmppath = Filename.temp_file
"llpp" "note" in
4228 let oc = open_out
tmppath in
4232 let execstr = editor ^
" " ^
tmppath in
4234 match popen
execstr [] with
4235 | (exception exn
) ->
4237 Printf.sprintf
"popen(%S) failed: %s" execstr (exntos exn
);
4240 match Unix.waitpid
[] pid
4242 | (exception exn
) ->
4244 Printf.sprintf
"waitpid(%d) failed: %s" pid (exntos exn
);
4248 | Unix.WEXITED
0 -> filelines
tmppath
4251 Printf.sprintf
"editor process(%s) exited abnormally: %d"
4254 | Unix.WSIGNALED
n ->
4256 Printf.sprintf
"editor process(%s) was killed by signal %d"
4259 | Unix.WSTOPPED
n ->
4261 Printf.sprintf
"editor(%s) process was stopped by signal %d"
4265 match Unix.unlink
tmppath with
4266 | (exception exn
) ->
4267 showtext '
!'
@@ Printf.sprintf
"failed to ulink %S: %s"
4268 tmppath (exntos exn
);
4273 let enterannotmode opaque slinkindex
=
4276 inherit lvsourcebase
4277 val mutable m_text
= E.s
4278 val mutable m_items
= E.a
4280 method getitemcount
= Array.length m_items
4283 let label, _func
= m_items
.(n) in
4286 method exit ~
uioh ~cancel ~
active ~
first ~pan
=
4287 ignore
(uioh, first, pan
);
4290 let _label, func
= m_items
.(active) in
4295 method hasaction
n = not
@@ emptystr
@@ fst m_items
.(n)
4298 let rec split accu b i
=
4300 if p = String.length
s
4301 then (String.sub
s b (p-b), unit) :: accu
4303 if (i
> 70 && s.[p] = ' '
) || s.[p] = '
\r'
|| s.[p] = '
\n'
4305 let ss = if i
= 0 then E.s else String.sub
s b i
in
4306 split ((ss, unit)::accu) (p+1) 0
4311 wcmd "freepage %s" (~
> opaque);
4313 Hashtbl.fold (fun key opaque'
accu ->
4314 if opaque'
= opaque'
4315 then key :: accu else accu) state
.pagemap
[]
4317 List.iter
(Hashtbl.remove state
.pagemap
) keys;
4322 delannot
opaque slinkindex
;
4325 let edit inline
() =
4330 modannot
opaque slinkindex
s;
4336 let mode = state
.mode in
4339 ("annotation: ", m_text
, None
, textentry, update, true),
4340 fun _ -> state
.mode <- mode);
4344 let s = getusertext m_text
in
4349 ( "[Copy]", fun () -> selstring m_text
)
4350 :: ("[Delete]", dele)
4351 :: ("[Edit]", edit conf
.annotinline
)
4353 :: split [] 0 0 |> List.rev
|> Array.of_list
4360 let s = getannotcontents
opaque slinkindex
in
4363 let source = (msgsource :> lvsource
) in
4364 let modehash = findkeyhash conf
"listview" in
4365 state
.uioh <- coe (object
4366 inherit listview ~zebra
:false ~helpmode
:false
4367 ~
source ~trusted
:false ~
modehash
4369 G.postRedisplay "enterannotmode";
4372 let gotounder under =
4373 let getpath filename
=
4375 if nonemptystr filename
4377 if Filename.is_relative filename
4379 let dir = Filename.dirname state
.path in
4381 if Filename.is_implicit
dir
4382 then Filename.concat
(Sys.getcwd
()) dir
4385 Filename.concat
dir filename
4389 if Sys.file_exists
path
4394 | Ulinkgoto
(pageno, top) ->
4398 gotopage1 pageno top;
4404 | Uremote
(filename
, pageno) ->
4405 let path = getpath filename
in
4410 let command = Printf.sprintf
"%s -page %d %S" !selfexec pageno path in
4411 try addpid
@@ popen
command []
4413 Printf.eprintf
"failed to execute `%s': %s\n" command (exntos exn
);
4416 let anchor = getanchor
() in
4417 let ranchor = state
.path, state
.password, anchor, state
.origin
in
4418 state
.origin
<- E.s;
4419 state
.anchor <- (pageno, 0.0, 0.0);
4420 state
.ranchors
<- ranchor :: state
.ranchors
;
4423 else showtext '
!'
("Could not find " ^ filename
)
4425 | Uremotedest
(filename
, destname
) ->
4426 let path = getpath filename
in
4431 let command = !selfexec ^
" " ^
path ^
" -dest " ^ destname
in
4432 try addpid
@@ popen
command []
4435 "failed to execute `%s': %s\n" command (exntos exn
);
4438 let anchor = getanchor
() in
4439 let ranchor = state
.path, state
.password, anchor, state
.origin
in
4440 state
.origin
<- E.s;
4441 state
.nameddest
<- destname
;
4442 state
.ranchors
<- ranchor :: state
.ranchors
;
4445 else showtext '
!'
("Could not find " ^ filename
)
4447 | Uunexpected
_ | Ulaunch
_ | Unamed
_ | Utext
_ | Unone
-> ()
4448 | Uannotation
(opaque, slinkindex
) -> enterannotmode opaque slinkindex
4451 let gotooutline (_, _, kind
) =
4455 let (pageno, y, _) = anchor in
4457 (if conf
.presentation
then (pageno, y, 1.0) else anchor)
4461 | Ouri
uri -> gotounder (Ulinkuri
uri)
4462 | Olaunch cmd
-> gotounder (Ulaunch cmd
)
4463 | Oremote remote
-> gotounder (Uremote remote
)
4464 | Ohistory
hist -> gotohist hist
4465 | Oremotedest remotedest
-> gotounder (Uremotedest remotedest
)
4469 let outlinesource sourcetype
=
4471 inherit lvsourcebase
4472 val mutable m_items
= E.a
4473 val mutable m_minfo
= E.a
4474 val mutable m_orig_items
= E.a
4475 val mutable m_orig_minfo
= E.a
4476 val mutable m_narrow_patterns
= []
4477 val mutable m_hadremovals
= false
4478 val mutable m_gen
= -1
4480 method getitemcount
=
4481 Array.length m_items
+ (if m_hadremovals
then 1 else 0)
4484 if n == Array.length m_items
&& m_hadremovals
4486 ("[Confirm removal]", 0)
4488 let s, n, _ = m_items
.(n) in
4491 method exit ~
uioh ~cancel ~
active ~
first ~pan
=
4492 ignore
(uioh, first);
4493 let confrimremoval = m_hadremovals
&& active = Array.length m_items
in
4495 if m_narrow_patterns
= []
4496 then m_orig_items
, m_orig_minfo
4497 else m_items
, m_minfo
4501 if not
confrimremoval
4503 gotooutline m_items
.(active);
4508 state
.bookmarks
<- Array.to_list m_items
;
4509 m_orig_items
<- m_items
;
4510 m_orig_minfo
<- m_minfo
;
4520 method hasaction
_ = true
4523 if Array.length m_items
!= Array.length m_orig_items
4526 match m_narrow_patterns
with
4528 | many
-> String.concat
"@Uellipsis" (List.rev many
)
4530 "Narrowed to " ^
s ^
" (ctrl-u to restore)"
4534 match m_narrow_patterns
with
4537 | head
:: _ -> "@Uellipsis" ^ head
4539 method narrow
pattern =
4540 let reopt = try Some
(Str.regexp_case_fold
pattern) with _ -> None
in
4544 let rec loop accu minfo n =
4547 m_items
<- Array.of_list
accu;
4548 m_minfo
<- Array.of_list
minfo;
4551 let (s, _, t
) as o = m_items
.(n) in
4554 | Oaction
_ -> o :: accu, (0, 0) :: minfo
4555 | Onone
| Oanchor
_ | Ouri
_ | Olaunch
_
4556 | Oremote
_ | Oremotedest
_ | Ohistory
_ ->
4558 try Str.search_forward
re s 0
4559 with Not_found
-> -1
4562 then o :: accu, (first, Str.match_end
()) :: minfo
4565 loop accu minfo (n-1)
4567 loop [] [] (Array.length m_items
- 1)
4569 method! getminfo
= m_minfo
4573 match sourcetype
with
4574 | `bookmarks
-> Array.of_list state
.bookmarks
4575 | `outlines
-> state
.outlines
4576 | `history
-> genhistoutlines !Config.historder
4578 m_minfo
<- m_orig_minfo
;
4579 m_items
<- m_orig_items
4582 if sourcetype
= `bookmarks
4584 if m >= 0 && m < Array.length m_items
4586 m_hadremovals
<- true;
4587 m_items
<- Array.init
(Array.length m_items
- 1) (fun n ->
4588 let n = if n >= m then n+1 else n in
4593 method add_narrow_pattern
pattern =
4594 m_narrow_patterns
<- pattern :: m_narrow_patterns
4596 method del_narrow_pattern
=
4597 match m_narrow_patterns
with
4598 | _ :: rest
-> m_narrow_patterns
<- rest
4603 match m_narrow_patterns
with
4604 | pattern :: [] -> self#narrow
pattern; pattern
4606 List.fold_left
(fun accu pattern ->
4607 self#narrow
pattern;
4608 pattern ^
"@Uellipsis" ^
accu) E.s list
4610 method calcactive
anchor =
4611 let rely = getanchory anchor in
4612 let rec loop n best bestd
=
4613 if n = Array.length m_items
4616 let _, _, kind
= m_items
.(n) in
4619 let orely = getanchory anchor in
4620 let d = abs
(orely - rely) in
4623 else loop (n+1) best bestd
4624 | Onone
| Oremote
_ | Olaunch
_
4625 | Oremotedest
_ | Ouri
_ | Ohistory
_ | Oaction
_ ->
4626 loop (n+1) best bestd
4630 method reset
anchor items =
4631 m_hadremovals
<- false;
4632 if state
.gen
!= m_gen
4634 m_orig_items
<- items;
4636 m_narrow_patterns
<- [];
4638 m_orig_minfo
<- E.a;
4642 if items != m_orig_items
4644 m_orig_items
<- items;
4645 if m_narrow_patterns
== []
4646 then m_items
<- items;
4649 let active = self#calcactive
anchor in
4651 m_first
<- firstof m_first
active
4655 let enterselector sourcetype
=
4657 let source = outlinesource sourcetype
in
4660 match sourcetype
with
4661 | `bookmarks
-> Array.of_list state
.bookmarks
4662 | `
outlines -> state
.outlines
4663 | `history
-> genhistoutlines !Config.historder
4665 if Array.length
outlines = 0
4667 showtext ' ' errmsg
;
4670 state
.text <- source#greetmsg
;
4671 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
4672 let anchor = getanchor
() in
4673 source#reset
anchor outlines;
4675 coe (new outlinelistview ~zebra
:(sourcetype
=`history
) ~
source);
4676 G.postRedisplay "enter selector";
4680 let enteroutlinemode =
4681 let f = enterselector `
outlines in
4682 fun () -> f "Document has no outline";
4685 let enterbookmarkmode =
4686 let f = enterselector `bookmarks
in
4687 fun () -> f "Document has no bookmarks (yet)";
4690 let enterhistmode () = enterselector `history
"No history (yet)";;
4692 let quickbookmark ?title
() =
4693 match state
.layout with
4699 let tm = Unix.localtime
(now
()) in
4700 Printf.sprintf
"Quick (page %d) (bookmarked at %02d/%02d/%d %02d:%02d)"
4704 (tm.Unix.tm_year
+ 1900)
4707 | Some
title -> title
4709 state
.bookmarks
<- (title, 0, Oanchor
(getanchor1
l)) :: state
.bookmarks
4712 let setautoscrollspeed step goingdown
=
4713 let incr = max
1 ((abs step
) / 2) in
4714 let incr = if goingdown
then incr else -incr in
4715 let astep = boundastep state
.winh
(step
+ incr) in
4716 state
.autoscroll
<- Some
astep;
4720 match conf
.columns
with
4722 | Csingle
_ | Cmulti
_ -> state
.x != 0 || conf
.zoom > 1.0
4725 let panbound x = bound
x (-state
.w) (wadjsb () + state
.winw
);;
4727 let existsinrow pageno (columns
, coverA
, coverB
) p =
4728 let last = ((pageno - coverA
) mod columns
) + columns
in
4729 let rec any = function
4732 if l.pageno = coverA
- 1 || l.pageno = state
.pagecount
- coverB
4736 then (if l.pageno = last then false else any rest
)
4744 match state
.layout with
4746 let pageno = page_of_y state
.y in
4747 gotoghyll (getpagey
(pageno+1))
4749 match conf
.columns
with
4751 if conf
.presentation
&& rest
== [] && l.pageh
> l.pagey + l.pagevh
4753 let y = clamp (pgscale state
.winh
) in
4756 let pageno = min
(l.pageno+1) (state
.pagecount
-1) in
4757 gotoghyll (getpagey
pageno)
4758 | Cmulti
((c, _, _) as cl, _) ->
4759 if conf
.presentation
4760 && (existsinrow l.pageno cl
4761 (fun l -> l.pageh
> l.pagey + l.pagevh))
4763 let y = clamp (pgscale state
.winh
) in
4766 let pageno = min
(l.pageno+c) (state
.pagecount
-1) in
4767 gotoghyll (getpagey
pageno)
4769 if l.pageno < state
.pagecount
- 1 || l.pagecol
< n - 1
4771 let pagey, pageh
= getpageyh
l.pageno in
4772 let pagey = pagey + pageh
* l.pagecol
in
4773 let ips = if l.pagecol
= 0 then 0 else conf
.interpagespace
in
4774 gotoghyll (pagey + pageh
+ ips)
4778 match state
.layout with
4780 let pageno = page_of_y state
.y in
4781 gotoghyll (getpagey
(pageno-1))
4783 match conf
.columns
with
4785 if conf
.presentation
&& l.pagey != 0
4787 gotoghyll (clamp (pgscale ~
-(state
.winh
)))
4789 let pageno = max
0 (l.pageno-1) in
4790 gotoghyll (getpagey
pageno)
4791 | Cmulti
((c, _, coverB
) as cl, _) ->
4792 if conf
.presentation
&&
4793 (existsinrow l.pageno cl (fun l -> l.pagey != 0))
4795 gotoghyll (clamp (pgscale ~
-(state
.winh
)))
4798 if l.pageno = state
.pagecount
- coverB
4802 let pageno = max
0 (l.pageno-decr) in
4803 gotoghyll (getpagey
pageno)
4811 let pageno = max
0 (l.pageno-1) in
4812 let pagey, pageh
= getpageyh
pageno in
4815 let pagey, pageh
= getpageyh
l.pageno in
4816 pagey + pageh
* (l.pagecol
-1) - conf
.interpagespace
4822 if emptystr conf
.savecmd
4823 then error
"don't know where to save modified document"
4825 let savecmd = Str.global_replace percentsre state
.path conf
.savecmd in
4828 (fun s -> error
"failed to obtain path to the saved copy: %s" s)
4831 if not
(emptystr
path)
4833 let tmp = path ^
".tmp" in
4835 Unix.rename
tmp path;
4838 let viewkeyboard key mask
=
4840 let mode = state
.mode in
4841 state
.mode <- Textentry
(te, fun _ -> state
.mode <- mode);
4844 G.postRedisplay "view:enttext"
4846 let ctrl = Wsi.withctrl mask
in
4848 if key >= 0xffb0 && key < 0xffb9 then key - 0xffb0 + 48 else key
4854 if hasunsavedchanges
()
4858 if conf
.angle
mod 360 = 0 && not
(isbirdseye state
.mode)
4860 state
.mode <- LinkNav
(Ltgendir
0);
4863 else showtext '
!'
"Keyboard link navigation does not work under rotation"
4866 begin match state
.mstate
with
4869 G.postRedisplay "kill rect";
4872 | Mscrolly
| Mscrollx
4875 begin match state
.mode with
4878 G.postRedisplay "esc leave linknav"
4882 match state
.ranchors
with
4884 | (path, password, anchor, origin
) :: rest
->
4885 state
.ranchors
<- rest
;
4886 state
.anchor <- anchor;
4887 state
.origin
<- origin
;
4888 state
.nameddest
<- E.s;
4889 opendoc path password
4894 gotoghyll (getnav ~
-1)
4905 Hashtbl.iter
(fun _ opaque -> clearmark
opaque) state
.pagemap
;
4906 G.postRedisplay "dehighlight";
4908 | @slash
| @question
->
4909 let ondone isforw
s =
4910 cbput state
.hists
.pat
s;
4911 state
.searchpattern
<- s;
4914 let s = String.make
1 (Char.chr
key) in
4915 enttext (s, E.s, Some
(onhist state
.hists
.pat
),
4916 textentry, ondone (key = @slash
), true)
4918 | @plus
| @kpplus
| @equals
when ctrl ->
4919 let incr = if conf
.zoom +. 0.01 > 0.1 then 0.1 else 0.01 in
4920 setzoom (conf
.zoom +. incr)
4922 | @plus
| @kpplus
->
4925 try int_of_string
s with exc
->
4926 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
);
4932 state
.text <- "page bias is now " ^ string_of_int
n;
4935 enttext ("page bias: ", E.s, None
, intentry, ondone, true)
4937 | @minus
| @kpminus
when ctrl ->
4938 let decr = if conf
.zoom -. 0.1 < 0.1 then 0.01 else 0.1 in
4939 setzoom (max
0.01 (conf
.zoom -. decr))
4941 | @minus
| @kpminus
->
4942 let ondone msg
= state
.text <- msg
in
4944 "option [acfhilpstvxACFPRSZTISM]: ", E.s, None
,
4945 optentry state
.mode, ondone, true
4956 | (@1 | @2) when ctrl && conf
.fitmodel
!= FitPage
-> (* ctrl-1/2 *)
4958 match conf
.columns
with
4959 | Csingle
_ | Cmulti
_ -> 1
4960 | Csplit
(n, _) -> n
4962 let h = state
.winh
-
4963 conf
.interpagespace
lsl (if conf
.presentation
then 1 else 0)
4965 let zoom = zoomforh state
.winw
h (vscrollw ()) cols in
4966 if zoom > 0.0 && (key = 50 || zoom < 1.0)
4971 match conf
.fitmodel
with
4972 | FitWidth
-> FitProportional
4973 | FitProportional
-> FitPage
4974 | FitPage
-> FitWidth
4976 state
.text <- "fit model: " ^
FMTE.to_string
fm;
4977 reqlayout conf
.angle
fm
4985 | (48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57)
4986 when not
ctrl -> (* 0..9 *)
4989 try int_of_string
s with exc
->
4990 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
);
4996 cbput state
.hists
.pag
(string_of_int
n);
4997 gotopage1 (n + conf
.pagebias
- 1) 0;
5000 let pageentry text key =
5001 match Char.unsafe_chr
key with
5002 | '
g'
-> TEdone
text
5003 | _ -> intentry text key
5005 let text = String.make
1 (Char.chr
key) in
5006 enttext (":", text, Some
(onhist state
.hists
.pag
),
5007 pageentry, ondone, true)
5010 conf
.scrollb
<- if conf
.scrollb
= 0 then (scrollbvv
lor scrollbhv
) else 0;
5011 reshape state
.winw state
.winh
;
5014 state
.bzoom
<- not state
.bzoom
;
5016 showtext ' '
("block zoom " ^
if state
.bzoom
then "on" else "off")
5019 conf
.hlinks
<- not conf
.hlinks
;
5020 state
.text <- "highlightlinks " ^
if conf
.hlinks
then "on" else "off";
5021 G.postRedisplay "toggle highlightlinks";
5024 state
.glinks
<- true;
5025 let mode = state
.mode in
5026 state
.mode <- Textentry
(
5027 (":", E.s, None
, linknentry, linkndone gotounder, false),
5029 state
.glinks
<- false;
5033 G.postRedisplay "view:linkent(F)"
5036 state
.glinks
<- true;
5037 let mode = state
.mode in
5038 state
.mode <- Textentry
(
5040 ":", E.s, None
, linknentry, linkndone (fun under ->
5041 selstring (undertext under);
5045 state
.glinks
<- false;
5049 G.postRedisplay "view:linkent"
5052 begin match state
.autoscroll
with
5054 conf
.autoscrollstep
<- step
;
5055 state
.autoscroll
<- None
5057 if conf
.autoscrollstep
= 0
5058 then state
.autoscroll
<- Some
1
5059 else state
.autoscroll
<- Some conf
.autoscrollstep
5066 setpresentationmode (not conf
.presentation
);
5067 showtext ' '
("presentation mode " ^
5068 if conf
.presentation
then "on" else "off");
5071 if List.mem
Wsi.Fullscreen state
.winstate
5072 then Wsi.reshape conf
.cwinw conf
.cwinh
5073 else Wsi.fullscreen
()
5076 search state
.searchpattern
false
5079 search state
.searchpattern
true
5082 begin match state
.layout with
5085 gotoghyll (getpagey
l.pageno)
5091 | @delete
| @kpdelete
-> (* delete *)
5095 showtext ' '
(describe_location ());
5098 begin match state
.layout with
5101 Wsi.reshape (l.pagew
+ vscrollw ()) l.pageh
;
5106 enterbookmarkmode ()
5114 | @e when Buffer.length state
.errmsgs
> 0 ->
5119 match state
.layout with
5124 (s, 0, Oanchor
(getanchor1
l)) :: state
.bookmarks
5127 enttext ("bookmark: ", E.s, None
, textentry, ondone, true)
5131 showtext ' '
"Quick bookmark added";
5134 begin match state
.layout with
5136 let rect = getpdimrect
l.pagedimno
in
5140 (truncate
(1.8 *. (rect.(1) -. rect.(0))),
5141 truncate
(1.2 *. (rect.(3) -. rect.(0))))
5143 (truncate
(rect.(1) -. rect.(0)),
5144 truncate
(rect.(3) -. rect.(0)))
5146 let w = truncate
((float w)*.conf
.zoom)
5147 and h = truncate
((float h)*.conf
.zoom) in
5150 state
.anchor <- getanchor
();
5151 Wsi.reshape (w + vscrollw ()) (h + conf
.interpagespace
)
5153 G.postRedisplay "z";
5158 | @x -> state
.roam
()
5161 reqlayout (conf
.angle
+
5162 (if key = @Gt
then 30 else -30)) conf
.fitmodel
5166 bound
(conf
.colorscale
+. (if key = 93 then 0.1 else -0.1)) 0.0 1.0
5168 G.postRedisplay "brightness";
5170 | @c when state
.mode = View
->
5175 let m = (wadjsb () + state
.winw
- state
.w) / 2 in
5177 gotoy_and_clear_text state
.y
5181 match state
.prevcolumns
with
5182 | None
-> (1, 0, 0), 1.0
5183 | Some
(columns
, z
) ->
5186 | Csplit
(c, _) -> -c, 0, 0
5187 | Cmulti
((c, a, b), _) -> c, a, b
5188 | Csingle
_ -> 1, 0, 0
5192 setcolumns View
c a b;
5195 | @down
| @up
when ctrl && Wsi.withshift mask
->
5196 let zoom, x = state
.prevzoom
in
5200 | @k
| @up
| @kpup
->
5201 begin match state
.autoscroll
with
5203 begin match state
.mode with
5204 | Birdseye beye
-> upbirdseye 1 beye
5209 then gotoy_and_clear_text (clamp ~
-(state
.winh
/2))
5211 if not
(Wsi.withshift mask
) && conf
.presentation
5213 else gotoghyll1 true (clamp (-conf
.scrollstep
))
5217 setautoscrollspeed n false
5220 | @j
| @down
| @kpdown
->
5221 begin match state
.autoscroll
with
5223 begin match state
.mode with
5224 | Birdseye beye
-> downbirdseye 1 beye
5229 then gotoy_and_clear_text (clamp (state
.winh
/2))
5231 if not
(Wsi.withshift mask
) && conf
.presentation
5233 else gotoghyll1 true (clamp (conf
.scrollstep
))
5237 setautoscrollspeed n true
5240 | @left | @right
| @kpleft
| @kpright
when not
(Wsi.withalt mask
) ->
5246 else conf
.hscrollstep
5248 let dx = if key = @left || key = @kpleft
then dx else -dx in
5249 state
.x <- panbound (state
.x + dx);
5250 gotoy_and_clear_text state
.y
5253 G.postRedisplay "left/right"
5256 | @prior
| @kpprior
->
5260 match state
.layout with
5262 | l :: _ -> state
.y - l.pagey
5264 clamp (pgscale (-state
.winh
))
5268 | @next | @kpnext
->
5272 match List.rev state
.layout with
5274 | l :: _ -> getpagey
l.pageno
5276 clamp (pgscale state
.winh
)
5280 | @g | @home
| @kphome
->
5283 | @G
| @jend
| @kpend
->
5285 gotoghyll (clamp state
.maxy)
5287 | @right
| @kpright
when Wsi.withalt mask
->
5288 gotoghyll (getnav 1)
5289 | @left | @kpleft
when Wsi.withalt mask
->
5290 gotoghyll (getnav ~
-1)
5295 | @v when conf
.debug
->
5298 match getopaque l.pageno with
5301 let x0, y0, x1, y1 = pagebbox
opaque in
5302 let a,b = float x0, float y0 in
5303 let c,d = float x1, float y0 in
5304 let e,f = float x1, float y1 in
5305 let h,j
= float x0, float y1 in
5306 let rect = (a,b,c,d,e,f,h,j
) in
5308 state
.rects
<- (l.pageno, l.pageno mod 3, rect) :: state
.rects
;
5310 G.postRedisplay "v";
5313 let mode = state
.mode in
5314 let cmd = ref E.s in
5315 let onleave = function
5316 | Cancel
-> state
.mode <- mode
5319 match getopaque l.pageno with
5320 | Some
opaque -> pipesel opaque !cmd
5321 | None
-> ()) state
.layout;
5325 cbput state
.hists
.sel
s;
5329 "| ", !cmd, Some
(onhist state
.hists
.sel
), textentry, ondone, true
5331 G.postRedisplay "|";
5332 state
.mode <- Textentry
(te, onleave);
5335 vlog "huh? %s" (Wsi.keyname
key)
5338 let linknavkeyboard key mask
linknav =
5339 let getpage pageno =
5340 let rec loop = function
5342 | l :: _ when l.pageno = pageno -> Some
l
5343 | _ :: rest
-> loop rest
5344 in loop state
.layout
5346 let doexact (pageno, n) =
5347 match getopaque pageno, getpage pageno with
5348 | Some
opaque, Some
l ->
5349 if key = @enter
|| key = @kpenter
5351 let under = getlink
opaque n in
5352 G.postRedisplay "link gotounder";
5359 Some
(findlink
opaque LDfirst
), -1
5362 Some
(findlink
opaque LDlast
), 1
5365 Some
(findlink
opaque (LDleft
n)), -1
5368 Some
(findlink
opaque (LDright
n)), 1
5371 Some
(findlink
opaque (LDup
n)), -1
5374 Some
(findlink
opaque (LDdown
n)), 1
5379 begin match findpwl
l.pageno dir with
5383 state
.mode <- LinkNav
(Ltgendir
dir);
5384 let y, h = getpageyh
pageno in
5387 then y + h - state
.winh
5392 begin match getopaque pageno, getpage pageno with
5393 | Some
opaque, Some
_ ->
5395 let ld = if dir > 0 then LDfirst
else LDlast
in
5398 begin match link with
5400 showlinktype (getlink
opaque m);
5401 state
.mode <- LinkNav
(Ltexact
(pageno, m));
5402 G.postRedisplay "linknav jpage";
5403 | Lnotfound
-> notfound dir
5409 begin match opt with
5410 | Some Lnotfound
-> pwl l dir;
5411 | Some
(Lfound
m) ->
5415 let _, y0, _, y1 = getlinkrect
opaque m in
5417 then gotopage1 l.pageno y0
5419 let d = fstate
.fontsize
+ 1 in
5420 if y1 - l.pagey > l.pagevh - d
5421 then gotopage1 l.pageno (y1 - state
.winh
- hscrollh () + d)
5422 else G.postRedisplay "linknav";
5424 showlinktype (getlink
opaque m);
5425 state
.mode <- LinkNav
(Ltexact
(l.pageno, m));
5428 | None
-> viewkeyboard key mask
5430 | _ -> viewkeyboard key mask
5435 G.postRedisplay "leave linknav"
5439 | Ltgendir
_ | Ltnotready
_ -> viewkeyboard key mask
5440 | Ltexact exact
-> doexact exact
5443 let keyboard key mask
=
5444 if (key = 103 && Wsi.withctrl mask
) && not
(istextentry state
.mode)
5445 then wcmd "interrupt"
5446 else state
.uioh <- state
.uioh#
key key mask
5449 let birdseyekeyboard key mask
5450 ((oconf
, leftx
, pageno, hooverpageno
, anchor) as beye
) =
5452 match conf
.columns
with
5454 | Cmulti
((c, _, _), _) -> c
5455 | Csplit
_ -> failwith
"bird's eye split mode"
5457 let pgh layout = List.fold_left
5458 (fun m l -> max
l.pageh
m) state
.winh
layout in
5460 | @l when Wsi.withctrl mask
->
5461 let y, h = getpageyh
pageno in
5462 let top = (state
.winh
- h) / 2 in
5463 gotoy (max
0 (y - top))
5464 | @enter
| @kpenter
-> leavebirdseye beye
false
5465 | @escape
-> leavebirdseye beye
true
5466 | @up
-> upbirdseye incr beye
5467 | @down
-> downbirdseye incr beye
5468 | @left -> upbirdseye 1 beye
5469 | @right
-> downbirdseye 1 beye
5472 begin match state
.layout with
5476 state
.mode <- Birdseye
(
5477 oconf
, leftx
, l.pageno, hooverpageno
, anchor
5479 gotopage1 l.pageno 0;
5482 let layout = layout (state
.y-state
.winh
) (pgh state
.layout) in
5484 | [] -> gotoy (clamp (-state
.winh
))
5486 state
.mode <- Birdseye
(
5487 oconf
, leftx
, l.pageno, hooverpageno
, anchor
5489 gotopage1 l.pageno 0
5492 | [] -> gotoy (clamp (-state
.winh
))
5496 begin match List.rev state
.layout with
5498 let layout = layout (state
.y + (pgh state
.layout)) state
.winh
in
5499 begin match layout with
5501 let incr = l.pageh
- l.pagevh in
5506 oconf
, leftx
, state
.pagecount
- 1, hooverpageno
, anchor
5508 G.postRedisplay "birdseye pagedown";
5510 else gotoy (clamp (incr + conf
.interpagespace
*2));
5514 Birdseye
(oconf
, leftx
, l.pageno, hooverpageno
, anchor);
5515 gotopage1 l.pageno 0;
5518 | [] -> gotoy (clamp state
.winh
)
5522 state
.mode <- Birdseye
(oconf
, leftx
, 0, hooverpageno
, anchor);
5526 let pageno = state
.pagecount
- 1 in
5527 state
.mode <- Birdseye
(oconf
, leftx
, pageno, hooverpageno
, anchor);
5528 if not
(pagevisible state
.layout pageno)
5531 match List.rev state
.pdims
with
5533 | (_, _, h, _) :: _ -> h
5535 gotoy (max
0 (getpagey
pageno - (state
.winh
- h - conf
.interpagespace
)))
5536 else G.postRedisplay "birdseye end";
5538 | _ -> viewkeyboard key mask
5543 match state
.mode with
5544 | Textentry
_ -> scalecolor 0.4
5546 | View
-> scalecolor 1.0
5547 | Birdseye
(_, _, pageno, hooverpageno
, _) ->
5548 if l.pageno = hooverpageno
5551 if l.pageno = pageno
5553 let c = scalecolor 1.0 in
5555 GlDraw.line_width
3.0;
5556 let dispx = xadjsb () + l.pagedispx in
5558 (float (dispx-1)) (float (l.pagedispy-1))
5559 (float (dispx+l.pagevw+1))
5560 (float (l.pagedispy+l.pagevh+1))
5562 GlDraw.line_width
1.0;
5571 let postdrawpage l linkindexbase
=
5572 match getopaque l.pageno with
5574 if tileready l l.pagex
l.pagey
5576 let x = l.pagedispx - l.pagex
+ xadjsb ()
5577 and y = l.pagedispy - l.pagey in
5579 match conf
.columns
with
5580 | Csingle
_ | Cmulti
_ ->
5581 (if conf
.hlinks
then 1 else 0)
5583 && not
(isbirdseye state
.mode) then 2 else 0)
5587 match state
.mode with
5588 | Textentry
((_, s, _, _, _, _), _) when state
.glinks
-> s
5594 postprocess
opaque hlmask x y (linkindexbase
, s, conf
.hfsize
);
5599 let scrollindicator () =
5600 let sbw, ph
, sh = state
.uioh#
scrollph in
5601 let sbh, pw, sw = state
.uioh#scrollpw
in
5606 else ((state
.winw
- sbw), state
.winw
, 0)
5609 GlDraw.color (0.64, 0.64, 0.64);
5610 filledrect (float x0) 0. (float x1) (float state
.winh
);
5612 (float hx0
) (float (state
.winh
- sbh))
5613 (float (hx0
+ wadjsb () + state
.winw
)) (float state
.winh
)
5615 GlDraw.color (0.0, 0.0, 0.0);
5617 filledrect (float x0) ph
(float x1) (ph
+. sh);
5618 let pw = pw +. float hx0
in
5619 filledrect pw (float (state
.winh
- sbh)) (pw +. sw) (float state
.winh
);
5623 match state
.mstate
with
5624 | Mnone
| Mscrolly
| Mscrollx
| Mpan
_ | Mzoom
_ | Mzoomrect
_ ->
5627 | Msel
((x0, y0), (x1, y1)) ->
5628 let identify opaque l px py = Some
(opaque, l.pageno, px, py) in
5629 let o0,n0
,px0
,py0
= onppundermouse identify x0 y0 (~
< E.s, -1, 0, 0) in
5630 let _o1,n1
,px1
,py1
= onppundermouse identify x1 y1 (~
< E.s, -1, 0, 0) in
5631 if n0
!= -1 && n0
= n1
then seltext
o0 (px0
, py0
, px1
, py1
);
5634 let showrects = function [] -> () | rects
->
5636 GlDraw.color (0.0, 0.0, 1.0) ~
alpha:0.5;
5637 GlFunc.blend_func ~
src:`src_alpha ~dst
:`one_minus_src_alpha
;
5639 (fun (pageno, c, (x0, y0, x1, y1, x2
, y2
, x3
, y3
)) ->
5641 if l.pageno = pageno
5643 let dx = float (l.pagedispx - l.pagex
) in
5644 let dy = float (l.pagedispy - l.pagey) in
5645 GlDraw.color (0.0, 0.0, 1.0 /. float c) ~
alpha:0.5;
5646 Raw.sets_float state
.vraw ~
pos:0
5651 GlArray.vertex `two state
.vraw
;
5652 GlArray.draw_arrays `triangle_strip ~
first:0 ~count
:4;
5661 GlClear.color (scalecolor2 conf
.bgcolor
);
5662 GlClear.clear
[`
color];
5663 List.iter
drawpage state
.layout;
5665 match state
.mode with
5666 | LinkNav
(Ltexact
(pageno, linkno
)) ->
5667 begin match getopaque pageno with
5669 let dx = xadjsb () in
5670 let x0, y0, x1, y1 = getlinkrect
opaque linkno
in
5671 let x0 = x0 + dx and x1 = x1 + dx in
5678 | None
-> state
.rects
5680 | LinkNav
(Ltgendir
_) | LinkNav
(Ltnotready
_)
5683 | View
-> state
.rects
5686 let rec postloop linkindexbase
= function
5688 let linkindexbase = linkindexbase + postdrawpage l linkindexbase in
5689 postloop linkindexbase rest
5693 postloop 0 state
.layout;
5695 begin match state
.mstate
with
5696 | Mzoomrect
((x0, y0), (x1, y1)) ->
5698 GlDraw.color (0.3, 0.3, 0.3) ~
alpha:0.5;
5699 GlFunc.blend_func ~
src:`src_alpha ~dst
:`one_minus_src_alpha
;
5700 filledrect (float x0) (float y0) (float x1) (float y1);
5704 | Mscrolly
| Mscrollx
5713 let zoomrect x y x1 y1 =
5716 and y0 = min
y y1 in
5717 gotoy (state
.y + y0);
5718 state
.anchor <- getanchor
();
5719 let zoom = (float state
.w) /. float (x1 - x0) in
5722 let adjw = wadjsb () + state
.winw
in
5724 then (adjw - state
.w) / 2
5727 match conf
.fitmodel
with
5728 | FitWidth
| FitProportional
-> simple ()
5730 match conf
.columns
with
5732 onppundermouse (fun _ l _ _ -> Some
l.pagedispx) x0 y0 x0
5733 | Cmulti
_ | Csingle
_ -> simple ()
5735 state
.x <- (state
.x + margin) - x0;
5740 let annot inline
x y =
5741 match unproject x y with
5742 | Some
(opaque, n, ux
, uy
) ->
5744 addannot
opaque ux uy
text;
5745 wcmd "freepage %s" (~
> opaque);
5746 Hashtbl.remove state
.pagemap
(n, state
.gen
);
5752 let ondone s = add s in
5753 let mode = state
.mode in
5754 state
.mode <- Textentry
(
5755 ("annotation: ", E.s, None
, textentry, ondone, true),
5756 fun _ -> state
.mode <- mode);
5759 G.postRedisplay "annot"
5762 let s = getusertext E.s in
5763 let l = Str.split newlinere
s in
5771 let g opaque l px py =
5772 match rectofblock
opaque px py with
5774 let x0 = a.(0) -. 20. in
5775 let x1 = a.(1) +. 20. in
5776 let y0 = a.(2) -. 20. in
5777 let zoom = (float state
.w) /. (x1 -. x0) in
5778 let pagey = getpagey
l.pageno in
5779 gotoy_and_clear_text (pagey + truncate
y0);
5780 state
.anchor <- getanchor
();
5781 let margin = (state
.w - l.pagew
)/2 in
5782 state
.x <- -truncate
x0 - margin;
5787 match conf
.columns
with
5789 showtext '
!'
"block zooming does not work properly in split columns mode"
5790 | Cmulti
_ | Csingle
_ -> onppundermouse g x y ()
5794 let winw = wadjsb () + state
.winw - 1 in
5795 let s = float x /. float winw in
5796 let destx = truncate
(float (state
.w + winw) *. s) in
5797 state
.x <- winw - destx;
5798 gotoy_and_clear_text state
.y;
5799 state
.mstate
<- Mscrollx
;
5803 let s = float y /. float state
.winh
in
5804 let desty = truncate
(float (state
.maxy - state
.winh
) *. s) in
5805 gotoy_and_clear_text desty;
5806 state
.mstate
<- Mscrolly
;
5809 let viewmulticlick clicks
x y mask
=
5810 let g opaque l px py =
5818 if markunder
opaque px py mark
5822 match getopaque l.pageno with
5824 | Some
opaque -> pipesel opaque cmd
5826 state
.roam
<- (fun () -> dopipe conf
.paxcmd
);
5827 if not
(Wsi.withctrl mask
) then dopipe conf
.selcmd
;
5832 G.postRedisplay "viewmulticlick";
5833 onppundermouse g x y (fun () -> showtext '
!'
"Nothing to select") ();
5837 match conf
.columns
with
5839 | Csingle
_ | Cmulti
_ -> conf
.angle
mod 360 = 0
5842 let viewmouse button down
x y mask
=
5844 | n when (n == 4 || n == 5) && not down
->
5845 if Wsi.withctrl mask
5847 match state
.mstate
with
5848 | Mzoom
(oldn
, i
) ->
5856 if conf
.zoom +. 0.01 > 0.1 then 0.1 else 0.01
5858 if conf
.zoom -. 0.1 < 0.1 then -0.01 else -0.1
5860 let zoom = conf
.zoom -. incr in
5862 state
.mstate
<- Mzoom
(n, 0);
5864 state
.mstate
<- Mzoom
(n, i
+1);
5866 else state
.mstate
<- Mzoom
(n, 0)
5870 | Mscrolly
| Mscrollx
5872 | Mnone
-> state
.mstate
<- Mzoom
(n, 0)
5875 match state
.autoscroll
with
5876 | Some step
-> setautoscrollspeed step
(n=4)
5878 if conf
.wheelbypage
|| conf
.presentation
5887 then -conf
.scrollstep
5888 else conf
.scrollstep
5890 let incr = incr * 2 in
5891 let y = clamp incr in
5892 gotoy_and_clear_text y
5895 | n when (n = 6 || n = 7) && not down
&& canpan () ->
5897 panbound (state
.x + (if n = 7 then -2 else 2) * conf
.hscrollstep
);
5898 gotoy_and_clear_text state
.y
5900 | 1 when Wsi.withshift mask
->
5901 state
.mstate
<- Mnone
;
5904 match unproject x y with
5905 | Some
(_, pageno, ux
, uy
) ->
5906 let cmd = Printf.sprintf
5908 conf
.stcmd state
.path pageno ux uy
5910 addpid
@@ popen
cmd []
5914 | 1 when Wsi.withctrl mask
->
5917 Wsi.setcursor
Wsi.CURSOR_CROSSHAIR
;
5918 state
.mstate
<- Mpan
(x, y)
5921 state
.mstate
<- Mnone
5926 if Wsi.withshift mask
5928 annot conf
.annotinline
x y;
5929 G.postRedisplay "addannot"
5933 Wsi.setcursor
Wsi.CURSOR_CYCLE
;
5934 state
.mstate
<- Mzoomrect
(p, p)
5937 match state
.mstate
with
5938 | Mzoomrect
((x0, y0), _) ->
5939 if abs
(x-x0) > 10 && abs
(y - y0) > 10
5940 then zoomrect x0 y0 x y
5943 G.postRedisplay "kill accidental zoom rect";
5947 | Mscrolly
| Mscrollx
5953 | 1 when x > state
.winw - vscrollw () ->
5956 let _, position, sh = state
.uioh#
scrollph in
5957 if y > truncate
position && y < truncate
(position +. sh)
5958 then state
.mstate
<- Mscrolly
5961 state
.mstate
<- Mnone
5963 | 1 when y > state
.winh
- hscrollh () ->
5966 let _, position, sw = state
.uioh#scrollpw
in
5967 if x > truncate
position && x < truncate
(position +. sw)
5968 then state
.mstate
<- Mscrollx
5971 state
.mstate
<- Mnone
5973 | 1 when state
.bzoom
-> if not down
then zoomblock x y
5976 let dest = if down
then getunder x y else Unone
in
5977 begin match dest with
5980 | Uremote
_ | Uremotedest
_
5981 | Uunexpected
_ | Ulaunch
_ | Unamed
_ ->
5984 | Unone
when down
->
5985 Wsi.setcursor
Wsi.CURSOR_CROSSHAIR
;
5986 state
.mstate
<- Mpan
(x, y);
5988 | Uannotation
(opaque, slinkindex
) -> enterannotmode opaque slinkindex
5990 | Unone
| Utext
_ ->
5995 state
.mstate
<- Msel
((x, y), (x, y));
5996 G.postRedisplay "mouse select";
6000 match state
.mstate
with
6003 | Mzoom
_ | Mscrollx
| Mscrolly
->
6004 state
.mstate
<- Mnone
6006 | Mzoomrect
((x0, y0), _) ->
6010 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
6011 state
.mstate
<- Mnone
6013 | Msel
((x0, y0), (x1, y1)) ->
6014 let rec loop = function
6018 let a0 = l.pagedispy in
6019 let a1 = a0 + l.pagevh in
6020 let b0 = l.pagedispx in
6021 let b1 = b0 + l.pagevw in
6022 ((y0 >= a0 && y0 <= a1) || (y1 >= a0 && y1 <= a1))
6023 && ((x0 >= b0 && x0 <= b1) || (x1 >= b0 && x1 <= b1))
6027 match getopaque l.pageno with
6030 match Unix.pipe
() with
6034 "can not create sel pipe: %s"
6038 Ne.clo fd
(fun msg
->
6039 dolog
"%s close failed: %s" what msg
)
6042 try popen
cmd [r
, 0; w, -1]
6044 dolog
"can not execute %S: %s"
6051 G.postRedisplay "copysel";
6053 else clo "Msel pipe/w" w;
6054 clo "Msel pipe/r" r
;
6056 dosel conf
.selcmd
();
6057 state
.roam
<- dosel conf
.paxcmd
;
6069 let birdseyemouse button down
x y mask
6070 (conf
, leftx
, _, hooverpageno
, anchor) =
6073 let rec loop = function
6076 if y > l.pagedispy && y < l.pagedispy + l.pagevh
6077 && x > l.pagedispx && x < l.pagedispx + l.pagevw
6079 leavebirdseye (conf
, leftx
, l.pageno, hooverpageno
, anchor) false;
6085 | _ -> viewmouse button down
x y mask
6091 method key key mask
=
6092 begin match state
.mode with
6093 | Textentry
textentry -> textentrykeyboard key mask
textentry
6094 | Birdseye
birdseye -> birdseyekeyboard key mask
birdseye
6095 | View
-> viewkeyboard key mask
6096 | LinkNav
linknav -> linknavkeyboard key mask
linknav
6100 method button button bstate
x y mask
=
6101 begin match state
.mode with
6103 | View
-> viewmouse button bstate
x y mask
6104 | Birdseye beye
-> birdseyemouse button bstate
x y mask beye
6109 method multiclick clicks
x y mask
=
6110 begin match state
.mode with
6112 | View
-> viewmulticlick clicks
x y mask
6119 begin match state
.mode with
6121 | View
| Birdseye
_ | LinkNav
_ ->
6122 match state
.mstate
with
6123 | Mzoom
_ | Mnone
-> ()
6128 state
.mstate
<- Mpan
(x, y);
6130 then state
.x <- panbound (state
.x + dx);
6132 gotoy_and_clear_text y
6135 state
.mstate
<- Msel
(a, (x, y));
6136 G.postRedisplay "motion select";
6139 let y = min state
.winh
(max
0 y) in
6143 let x = min state
.winw (max
0 x) in
6146 | Mzoomrect
(p0
, _) ->
6147 state
.mstate
<- Mzoomrect
(p0
, (x, y));
6148 G.postRedisplay "motion zoomrect";
6152 method pmotion
x y =
6153 begin match state
.mode with
6154 | Birdseye
(conf
, leftx
, pageno, hooverpageno
, anchor) ->
6155 let rec loop = function
6157 if hooverpageno
!= -1
6159 state
.mode <- Birdseye
(conf
, leftx
, pageno, -1, anchor);
6160 G.postRedisplay "pmotion birdseye no hoover";
6163 if y > l.pagedispy && y < l.pagedispy + l.pagevh
6164 && x > l.pagedispx && x < l.pagedispx + l.pagevw
6166 state
.mode <- Birdseye
(conf
, leftx
, pageno, l.pageno, anchor);
6167 G.postRedisplay "pmotion birdseye hoover";
6177 match state
.mstate
with
6178 | Mpan
_ | Msel
_ | Mzoom
_ | Mscrolly
| Mscrollx
| Mzoomrect
_ -> ()
6186 let past, _, _ = !r
in
6188 let delta = now -. past in
6191 else r
:= (now, x, y)
6195 method infochanged
_ = ()
6198 let maxy = state
.maxy - (if conf
.maxhfit
then state
.winh
else 0) in
6201 then 0.0, float state
.winh
6202 else scrollph state
.y maxy
6207 let winw = wadjsb () + state
.winw in
6208 let fwinw = float winw in
6210 let sw = fwinw /. float state
.w in
6211 let sw = fwinw *. sw in
6212 max
sw (float conf
.scrollh
)
6215 let maxx = state
.w + winw in
6216 let x = winw - state
.x in
6217 let percent = float x /. float maxx in
6218 (fwinw -. sw) *. percent
6220 hscrollh (), position, sw
6224 match state
.mode with
6225 | LinkNav
_ -> "links"
6226 | Textentry
_ -> "textentry"
6227 | Birdseye
_ -> "birdseye"
6230 findkeyhash conf
modename
6232 method eformsgs
= true
6233 method alwaysscrolly
= false
6236 let adderrmsg src msg
=
6237 Buffer.add_string state
.errmsgs msg
;
6238 state
.newerrmsgs
<- true;
6242 let adderrfmt src fmt
=
6243 Format.ksprintf
(fun s -> adderrmsg src s) fmt
;
6247 let cl = splitatspace cmds
in
6249 try Scanf.sscanf
s fmt
f
6251 adderrfmt "remote exec"
6252 "error processing '%S': %s\n" cmds
(exntos exn
)
6255 | "reload" :: [] -> reload ()
6256 | "goto" :: args
:: [] ->
6257 scan args
"%u %f %f"
6259 let cmd, _ = state
.geomcmds
in
6261 then gotopagexy pageno x y
6264 gotopagexy pageno x y;
6267 state
.reprf
<- f state
.reprf
6269 | "goto1" :: args
:: [] -> scan args
"%u %f" gotopage
6270 | "gotor" :: args
:: [] ->
6272 (fun filename
pageno -> gotounder (Uremote
(filename
, pageno)))
6273 | "gotord" :: args
:: [] ->
6275 (fun filename
dest -> gotounder (Uremotedest
(filename
, dest)))
6276 | "rect" :: args
:: [] ->
6277 scan args
"%u %u %f %f %f %f"
6278 (fun pageno color x0 y0 x1 y1 ->
6279 onpagerect pageno (fun w h ->
6280 let _,w1,h1
,_ = getpagedim
pageno in
6281 let sw = float w1 /. float w
6282 and sh = float h1
/. float h in
6286 and y1s
= y1 *. sh in
6287 let rect = (x0s,y0s
,x1s
,y0s
,x1s
,y1s
,x0s,y1s
) in
6289 state
.rects <- (pageno, color, rect) :: state
.rects;
6290 G.postRedisplay "rect";
6293 | "activatewin" :: [] -> Wsi.activatewin
()
6294 | "quit" :: [] -> raise Quit
6296 adderrfmt "remote command"
6297 "error processing remote command: %S\n" cmds
;
6301 let scratch = Bytes.create
80 in
6302 let buf = Buffer.create
80 in
6305 try Some
(Unix.read fd
scratch 0 80)
6307 | Unix.Unix_error
(Unix.EAGAIN
, _, _) -> None
6308 | Unix.Unix_error
(Unix.EINTR
, _, _) -> tempfr ()
6311 match tempfr () with
6317 if Buffer.length
buf > 0
6319 let s = Buffer.contents
buf in
6329 let pos = Bytes.index_from
scratch ppos '
\n'
in
6330 if pos >= n then -1 else pos
6331 with Not_found
-> -1
6335 Buffer.add_subbytes
buf scratch ppos
(nlpos-ppos
);
6336 let s = Buffer.contents
buf in
6342 Buffer.add_subbytes
buf scratch ppos
(n-ppos
);
6348 let remoteopen path =
6349 try Some
(Unix.openfile
path [Unix.O_NONBLOCK
; Unix.O_RDONLY
] 0o0)
6351 adderrfmt "remoteopen" "error opening %S: %s" path (exntos exn
);
6356 let gcconfig = ref E.s in
6357 let trimcachepath = ref E.s in
6358 let rcmdpath = ref E.s in
6359 let pageno = ref None
in
6360 let rootwid = ref 0 in
6361 let openlast = ref false in
6362 let nofc = ref false in
6363 let doreap = ref false in
6364 selfexec := Sys.executable_name
;
6367 [("-p", Arg.String
(fun s -> state
.password <- s),
6368 "<password> Set password");
6372 Config.fontpath
:= s;
6373 selfexec := !selfexec ^
" -f " ^
Filename.quote
s;
6375 "<path> Set path to the user interface font");
6379 selfexec := !selfexec ^
" -c " ^
Filename.quote
s;
6380 Config.confpath
:= s),
6381 "<path> Set path to the configuration file");
6383 ("-last", Arg.Set
openlast, " Open last document");
6385 ("-page", Arg.Int
(fun pageno1
-> pageno := Some
(pageno1
-1)),
6386 "<page-number> Jump to page");
6388 ("-tcf", Arg.String
(fun s -> trimcachepath := s),
6389 "<path> Set path to the trim cache file");
6391 ("-dest", Arg.String
(fun s -> state
.nameddest
<- s),
6392 "<named-destination> Set named destination");
6394 ("-wtmode", Arg.Set
wtmode, " Operate in wt mode");
6395 ("-cxack", Arg.Set
cxack, " Cut corners");
6397 ("-remote", Arg.String
(fun s -> rcmdpath := s),
6398 "<path> Set path to the remote commands source");
6400 ("-origin", Arg.String
(fun s -> state
.origin
<- s),
6401 "<original-path> Set original path");
6403 ("-gc", Arg.Set_string
gcconfig,
6404 "<script-path> Collect garbage with the help of a script");
6406 ("-nofc", Arg.Set
nofc, " Do not use fontconfig");
6408 ("-v", Arg.Unit
(fun () ->
6410 "%s\nconfiguration path: %s\n"
6414 exit
0), " Print version and exit");
6416 ("-embed", Arg.Set_int
rootwid,
6417 "<window-id> Embed into window")
6420 (fun s -> state
.path <- s)
6421 ("Usage: " ^
Sys.argv
.(0) ^
" [options] some.pdf\nOptions:")
6424 then selfexec := !selfexec ^
" -wtmode";
6426 let histmode = emptystr state
.path && not
!openlast in
6428 if not
(Config.load !openlast)
6429 then prerr_endline
"failed to load configuration";
6430 begin match !pageno with
6431 | Some
pageno -> state
.anchor <- (pageno, 0.0, 0.0)
6435 if not
(emptystr
!gcconfig)
6438 match Unix.socketpair
Unix.PF_UNIX
Unix.SOCK_STREAM
0 with
6440 error
"gc socketpair failed: %s" (exntos exn
)
6443 match addpid
@@ popen
!gcconfig [(c, 0); (c, 1)] with
6445 error
"failed to popen gc script: %s" (exntos exn
);
6451 let wsfd, winw, winh
= Wsi.init
(object (self)
6452 val mutable m_clicks
= 0
6453 val mutable m_click_x
= 0
6454 val mutable m_click_y
= 0
6455 val mutable m_lastclicktime
= infinity
6457 method private cleanup =
6458 state
.roam
<- noroam
;
6459 Hashtbl.iter
(fun _ opaque -> clearmark
opaque) state
.pagemap
6460 method expose
= G.postRedisplay"expose"
6464 | Wsi.Unobscured
-> "unobscured"
6465 | Wsi.PartiallyObscured
-> "partiallyobscured"
6466 | Wsi.FullyObscured
-> "fullyobscured"
6468 vlog "visibility change %s" name
6469 method display = display ()
6470 method map mapped
= vlog "mappped %b" mapped
6471 method reshape w h =
6474 method mouse
b d x y m =
6475 if d && canselect ()
6477 (* http://blogs.msdn.com/b/oldnewthing/archive/2004/10/18/243925.aspx *)
6483 if abs
x - m_click_x
> 10
6484 || abs
y - m_click_y
> 10
6485 || abs_float
(t -. m_lastclicktime
) > 0.3
6487 m_clicks
<- m_clicks
+ 1;
6488 m_lastclicktime
<- t;
6492 G.postRedisplay "cleanup";
6493 state
.uioh <- state
.uioh#button
b d x y m;
6495 else state
.uioh <- state
.uioh#multiclick m_clicks
x y m
6500 m_lastclicktime
<- infinity
;
6501 state
.uioh <- state
.uioh#button
b d x y m
6505 state
.uioh <- state
.uioh#button
b d x y m
6508 state
.mpos
<- (x, y);
6509 state
.uioh <- state
.uioh#motion
x y
6510 method pmotion
x y =
6511 state
.mpos
<- (x, y);
6512 state
.uioh <- state
.uioh#pmotion
x y
6514 let mascm = m land (
6515 Wsi.altmask
+ Wsi.shiftmask
+ Wsi.ctrlmask
+ Wsi.metamask
6518 let x = state
.x and y = state
.y in
6520 if x != state
.x || y != state
.y then self#
cleanup
6522 match state
.keystate
with
6524 let km = k
, mascm in
6527 let modehash = state
.uioh#
modehash in
6528 try Hashtbl.find modehash km
6530 try Hashtbl.find (findkeyhash conf
"global") km
6531 with Not_found
-> KMinsrt
(k
, m)
6533 | KMinsrt
(k
, m) -> keyboard k
m
6534 | KMinsrl
l -> List.iter
(fun (k
, m) -> keyboard k
m) l
6535 | KMmulti
(l, r
) -> state
.keystate
<- KSinto
(l, r
)
6537 | KSinto
((k'
, m'
) :: [], insrt
) when k'
=k
&& m'
land mascm = m'
->
6538 List.iter
(fun (k
, m) -> keyboard k
m) insrt
;
6539 state
.keystate
<- KSnone
6540 | KSinto
((k'
, m'
) :: keys, insrt
) when k'
=k
&& m'
land mascm = m'
->
6541 state
.keystate
<- KSinto
(keys, insrt
)
6542 | KSinto
_ -> state
.keystate
<- KSnone
6545 state
.mpos
<- (x, y);
6546 state
.uioh <- state
.uioh#pmotion
x y
6547 method leave = state
.mpos
<- (-1, -1)
6548 method winstate wsl
= state
.winstate
<- wsl
6549 method quit
= raise Quit
6550 end) !rootwid conf
.cwinw conf
.cwinh platform
in
6555 List.exists
GlMisc.check_extension
6556 [ "GL_ARB_texture_rectangle"
6557 ; "GL_EXT_texture_recangle"
6558 ; "GL_NV_texture_rectangle" ]
6560 then (prerr_endline
"OpenGL does not suppport rectangular textures"; exit
1);
6563 let r = GlMisc.get_string `renderer
in
6564 let p = "Mesa DRI Intel(" in
6565 let l = String.length
p in
6566 String.length
r > l && String.sub
r 0 l = p
6569 defconf
.sliceheight
<- 1024;
6570 defconf
.texcount
<- 32;
6571 defconf
.usepbo
<- true;
6575 match Unix.socketpair
Unix.PF_UNIX
Unix.SOCK_STREAM
0 with
6577 Printf.eprintf
"socketpair failed: %s" (exntos exn
);
6585 setcheckers conf
.checkers
;
6587 if conf
.redirectstderr
6591 (Buffer.to_bytes state
.errmsgs
)
6592 (match state
.errfd
with
6594 let s = Bytes.create
(80*24) in
6597 let r, _, _ = Unix.select
[fd
] [] [] 0.0 in
6599 then Unix.read fd
s 0 (Bytes.length
s)
6605 else Bytes.sub
s 0 n
6609 try ignore
(Unix.write state
.stderr
s 0 (Bytes.length
s))
6610 with exn
-> print_endline
(exntos exn
)
6615 conf
.angle
, conf
.fitmodel
, (conf
.trimmargins
, conf
.trimfuzz
),
6616 conf
.texcount
, conf
.sliceheight
, conf
.mustoresize
, conf
.colorspace
,
6617 !Config.fontpath
, !trimcachepath,
6618 GlMisc.check_extension
"GL_ARB_pixel_buffer_object",
6621 List.iter
GlArray.enable
[`texture_coord
; `vertex
];
6623 reshape ~firsttime
:true winw winh
;
6627 Wsi.settitle
"llpp (history)";
6631 state
.text <- "Opening " ^
(mbtoutf8 state
.path);
6632 opendoc state
.path state
.password;
6636 Sys.set_signal
Sys.sighup
(Sys.Signal_handle
(fun _ -> reload ()));
6639 match Unix.waitpid
[Unix.WNOHANG
] ~
-1 with
6640 | (exception (Unix.Unix_error
(Unix.ECHILD
, _, _))) -> ()
6641 | (exception exn
) -> dolog
"Unix.waitpid: %s" @@ exntos exn
6643 | _pid
, _status
-> reap ()
6645 Sys.set_signal
Sys.sigchld
(Sys.Signal_handle
(fun _ -> doreap := true));
6649 if nonemptystr
!rcmdpath
6650 then remoteopen !rcmdpath
6655 let rec loop deadline
=
6662 match state
.errfd
with
6663 | None
-> [state
.ss; state
.wsfd]
6664 | Some fd
-> [state
.ss; state
.wsfd; fd
]
6669 | Some fd
-> fd
:: r
6673 state
.redisplay
<- false;
6680 if deadline
= infinity
6682 else max
0.0 (deadline
-. now)
6687 try Unix.select
r [] [] timeout
6688 with Unix.Unix_error
(Unix.EINTR
, _, _) -> [], [], []
6694 if state
.ghyll
== noghyll
6696 match state
.autoscroll
with
6697 | Some step
when step
!= 0 ->
6698 let y = state
.y + step
in
6702 else if y >= state
.maxy then 0 else y
6705 if state
.mode = View
6706 then state
.text <- E.s;
6709 else deadline
+. 0.01
6714 let rec checkfds = function
6716 | fd
:: rest
when fd
= state
.ss ->
6717 let cmd = readcmd state
.ss in
6721 | fd
:: rest
when fd
= state
.wsfd ->
6725 | fd
:: rest
when Some fd
= !optrfd ->
6726 begin match remote fd
with
6727 | None
-> optrfd := remoteopen !rcmdpath;
6728 | opt -> optrfd := opt
6733 let s = Bytes.create
80 in
6734 let n = tempfailureretry
(Unix.read fd
s 0) 80 in
6735 if conf
.redirectstderr
6737 Buffer.add_substring state
.errmsgs
(Bytes.to_string
s) 0 n;
6738 state
.newerrmsgs
<- true;
6739 state
.redisplay
<- true;
6742 prerr_string
(String.sub
(Bytes.to_string
s) 0 n);
6748 if !reeenterhist then (
6750 reeenterhist := false;
6754 if deadline
= infinity
6758 match state
.autoscroll
with
6759 | Some step
when step
!= 0 -> deadline1
6760 | _ -> if state
.ghyll
== noghyll
then infinity
else deadline1
6768 Config.save leavebirdseye;
6769 if hasunsavedchanges
()