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 selfexec = ref E.s
;;
49 let drawstring size x y s
=
51 Gl.enable `texture_2d
;
52 GlFunc.blend_func ~src
:`src_alpha ~dst
:`one_minus_src_alpha
;
53 ignore
(drawstr size x y s
);
55 Gl.disable `texture_2d
;
58 let drawstring1 size x y s
=
62 let drawstring2 size x y fmt
=
63 Printf.kprintf
(drawstring size
(x
+1) (y
+size
+1)) fmt
67 dolog
"l %d dim=%d {" l
.pageno l
.pagedimno
;
68 dolog
" WxH %dx%d" l
.pagew l
.pageh
;
69 dolog
" vWxH %dx%d" l
.pagevw l
.pagevh
;
70 dolog
" pagex,y %d,%d" l
.pagex l
.pagey
;
71 dolog
" dispx,y %d,%d" l
.pagedispx l
.pagedispy
;
72 dolog
" column %d" l
.pagecol
;
76 let debugrect (x0
, y0
, x1
, y1
, x2
, y2
, x3
, y3
) =
78 dolog
" x0,y0=(% f, % f)" x0 y0
;
79 dolog
" x1,y1=(% f, % f)" x1 y1
;
80 dolog
" x2,y2=(% f, % f)" x2 y2
;
81 dolog
" x3,y3=(% f, % f)" x3 y3
;
85 let isbirdseye = function
92 let istextentry = function
99 let wtmode = ref false;;
100 let cxack = ref false;;
102 let pgscale h
= truncate
(float h
*. conf
.pgscale);;
105 if not state
.uioh#alwaysscrolly
&& (conf
.scrollb
land scrollbhv
= 0)
106 || (state
.x
= 0 && state
.w
<= state
.winw
- conf
.scrollbw
)
112 if not state
.uioh#alwaysscrolly
&& (conf
.scrollb
land scrollbvv
= 0)
117 let wadjsb () = -vscrollw ();;
118 let xadjsb () = if conf
.leftscroll
then vscrollw () else 0;;
121 fstate
.fontsize
<- n
;
122 fstate
.wwidth
<- measurestr fstate
.fontsize
"w";
123 fstate
.maxrows
<- (state
.winh
- fstate
.fontsize
- 1) / (fstate
.fontsize
+ 1);
129 Printf.kprintf prerr_endline fmt
131 Printf.kprintf ignore fmt
135 if emptystr conf
.pathlauncher
136 then print_endline state
.path
138 let command = Str.global_replace percentsre state
.path conf
.pathlauncher
in
139 try addpid
@@ popen
command []
140 with exn
-> dolog
"failed to execute `%s': %s" command (exntos exn
)
144 let redirectstderr () =
145 let clofail what errmsg
= dolog
"failed to close %s: %s" what errmsg
in
146 if conf
.redirectstderr
148 match Unix.pipe
() with
150 dolog
"failed to create stderr redirection pipes: %s" (exntos exn
)
153 begin match Unix.dup
Unix.stderr
with
155 dolog
"failed to dup stderr: %s" (exntos exn
);
156 Ne.clo r
(clofail "pipe/r");
157 Ne.clo w
(clofail "pipe/w");
160 begin match Unix.dup2 w
Unix.stderr
with
162 dolog
"failed to dup2 to stderr: %s" (exntos exn
);
163 Ne.clo dupstderr
(clofail "stderr duplicate");
164 Ne.clo r
(clofail "redir pipe/r");
165 Ne.clo w
(clofail "redir pipe/w");
168 state
.stderr
<- dupstderr
;
169 state
.errfd
<- Some r
;
173 state
.newerrmsgs
<- false;
174 begin match state
.errfd
with
176 begin match Unix.dup2 state
.stderr
Unix.stderr
with
178 dolog
"failed to dup2 original stderr: %s" (exntos exn
)
180 Ne.clo fd
(clofail "dup of stderr");
185 prerr_string
(Buffer.contents state
.errmsgs
);
187 Buffer.clear state
.errmsgs
;
193 let postRedisplay who
=
195 then prerr_endline
("redisplay for " ^ who
);
196 state
.redisplay
<- true;
200 let getopaque pageno
=
201 try Some
(Hashtbl.find state
.pagemap
(pageno
, state
.gen
))
202 with Not_found
-> None
205 let putopaque pageno opaque
=
206 Hashtbl.replace state
.pagemap
(pageno
, state
.gen
) opaque
209 let pagetranslatepoint l x y
=
210 let dy = y
- l
.pagedispy
in
211 let y = dy + l
.pagey
in
212 let dx = x
- l
.pagedispx
in
213 let x = dx + l
.pagex
in
217 let onppundermouse g
x y d
=
220 begin match getopaque l
.pageno
with
222 let x0 = l
.pagedispx
in
223 let x1 = x0 + l
.pagevw
in
224 let y0 = l
.pagedispy
in
225 let y1 = y0 + l
.pagevh
in
226 if y >= y0 && y <= y1 && x >= x0 && x <= x1
228 let px, py
= pagetranslatepoint l
x y in
229 match g opaque l
px py
with
242 let g opaque l
px py
=
245 match rectofblock opaque
px py
with
247 let rect = (a
.(0),a
.(2),a
.(1),a
.(2),a
.(1),a
.(3),a
.(0),a
.(3)) in
248 state
.rects
<- [l
.pageno
, l
.pageno
mod 3, rect];
249 G.postRedisplay "getunder";
252 let under = whatsunder opaque
px py
in
253 if under = Unone
then None
else Some
under
255 onppundermouse g x y Unone
260 match unproject opaque
x y with
261 | Some
(x, y) -> Some
(Some
(opaque
, l
.pageno
, x, y))
264 onppundermouse g x y None
;
268 state
.text
<- Printf.sprintf
"%c%s" c s
;
269 G.postRedisplay "showtext";
272 let pipesel opaque cmd
=
275 match Unix.pipe
() with
278 (Printf.sprintf
"pipesel can not create pipe: %s" (exntos exn
));
280 let doclose what fd
=
281 Ne.clo fd
(fun msg
-> dolog
"%s close failed: %s" what msg
)
284 try popen cmd
[r
, 0; w
, -1]
286 dolog
"can not execute %S: %s" cmd
(exntos exn
);
292 G.postRedisplay "pipesel";
294 else doclose "pipesel pipe/w" w
;
295 doclose "pipesel pipe/r" r
;
299 let g opaque l
px py
=
300 if markunder opaque
px py conf
.paxmark
303 match getopaque l
.pageno
with
305 | Some opaque
-> pipesel opaque conf
.paxcmd
310 G.postRedisplay "paxunder";
311 if conf
.paxmark
= Mark_page
314 match getopaque l
.pageno
with
316 | Some opaque
-> clearmark opaque
) state
.layout
;
318 onppundermouse g x y (fun () -> showtext '
!'
"Whoopsie daisy");
322 match Unix.pipe
() with
324 showtext '
!'
(Printf.sprintf
"pipe failed: %s" (exntos exn
))
327 Ne.clo fd
(fun msg
->
328 showtext '
!'
(Printf.sprintf
"failed to close %s: %s" cap msg
)
332 try popen conf
.selcmd
[r
, 0; w
, -1]
335 (Printf.sprintf
"failed to execute %s: %s"
336 conf
.selcmd
(exntos exn
));
342 let l = String.length s
in
343 let bytes = Bytes.unsafe_of_string s
in
344 let n = tempfailureretry
(Unix.write w
bytes 0) l in
349 "failed to write %d characters to sel pipe, wrote %d"
354 (Printf.sprintf
"failed to write to sel pipe: %s"
359 clo "selstring pipe/r" r
;
360 clo "selstring pipe/w" w
;
363 let undertext ?
(nopath
=false) = function
366 | Ulinkgoto
(pageno
, _
) ->
368 then "page " ^ string_of_int
(pageno
+1)
369 else 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
1957 if emptystr
password
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;
2014 let l = String.length
s in
2015 let rec loop pos n = if pos = l then n else
2016 let m = Char.code
s.[pos] - (if pos = 0 && l > 1 then 96 else 97) in
2017 loop (pos+1) (n*26 + m)
2020 let rec loop n = function
2023 match getopaque l.pageno with
2024 | None
-> loop n rest
2026 let m = getlinkcount
opaque in
2029 let under = getlink
opaque n in
2032 else loop (n-m) rest
2034 loop n state
.layout;
2038 let linknentry text key =
2040 if key >= 32 && key < 127
2046 let text = addchar
text c in
2047 linknact (fun under -> state
.text <- undertext ~nopath
:true under) text;
2051 state
.text <- Printf.sprintf
"invalid char (%d, `%c')" key c;
2055 let textentry text key =
2056 if key land 0xff00 = 0xff00
2058 else TEcont
(text ^ toutf8
key)
2061 let reqlayout angle fitmodel
=
2062 match state
.throttle
with
2064 if nogeomcmds state
.geomcmds
2065 then state
.anchor <- getanchor
();
2066 conf
.angle
<- angle
mod 360;
2069 match state
.mode
with
2070 | LinkNav
_ -> state
.mode
<- View
2075 conf
.fitmodel
<- fitmodel
;
2076 invalidate "reqlayout"
2078 wcmd "reqlayout %d %d %d"
2079 conf
.angle
(FMTE.to_int conf
.fitmodel
) (stateh state
.winh
)
2084 let settrim trimmargins trimfuzz
=
2085 if nogeomcmds state
.geomcmds
2086 then state
.anchor <- getanchor
();
2087 conf
.trimmargins
<- trimmargins
;
2088 conf
.trimfuzz
<- trimfuzz
;
2089 let x0, y0, x1, y1 = trimfuzz
in
2090 invalidate "settrim"
2092 wcmd "settrim %d %d %d %d %d" (btod conf
.trimmargins
) x0 y0 x1 y1);
2097 match state
.throttle
with
2099 let zoom = max
0.0001 zoom in
2100 if zoom <> conf
.zoom
2102 state
.prevzoom
<- (conf
.zoom, state
.x);
2104 reshape state
.winw state
.winh
;
2105 state
.text <- Printf.sprintf
"zoom is now %-5.2f" (zoom *. 100.0);
2108 | Some
(layout, y, started
) ->
2110 match conf
.maxwait
with
2114 let dt = now
() -. started
in
2122 let setcolumns mode columns coverA coverB
=
2123 state
.prevcolumns
<- Some
(conf
.columns
, conf
.zoom);
2127 then showtext '
!'
"split mode doesn't work in bird's eye"
2129 conf
.columns
<- Csplit
(-columns
, E.a);
2137 conf
.columns
<- Csingle
E.a;
2142 conf
.columns
<- Cmulti
((columns
, coverA
, coverB
), E.a);
2146 reshape state
.winw state
.winh
;
2149 let resetmstate () =
2150 state
.mstate
<- Mnone
;
2151 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
2154 let enterbirdseye () =
2155 let zoom = float conf
.thumbw
/. float state
.winw
in
2156 let birdseyepageno =
2157 let cy = state
.winh
/ 2 in
2161 let rec fold best
= function
2164 let d = cy - (l.pagedispy + l.pagevh/2)
2165 and dbest
= cy - (best
.pagedispy + best
.pagevh/2) in
2166 if abs
d < abs dbest
2173 state
.mode
<- Birdseye
(
2174 { conf
with zoom = conf
.zoom }, state
.x, birdseyepageno, -1, getanchor
()
2178 conf
.presentation
<- false;
2179 conf
.interpagespace
<- 10;
2180 conf
.hlinks
<- false;
2181 conf
.fitmodel
<- FitPage
;
2183 conf
.maxwait
<- None
;
2185 match conf
.beyecolumns
with
2188 Cmulti
((c, 0, 0), E.a)
2189 | None
-> Csingle
E.a
2193 state
.text <- Printf.sprintf
"birds eye mode on (zoom %3.1f%%)"
2198 reshape state
.winw state
.winh
;
2201 let leavebirdseye (c, leftx
, pageno, _, anchor) goback
=
2203 conf
.zoom <- c.zoom;
2204 conf
.presentation
<- c.presentation
;
2205 conf
.interpagespace
<- c.interpagespace
;
2206 conf
.maxwait
<- c.maxwait
;
2207 conf
.hlinks
<- c.hlinks
;
2208 conf
.fitmodel
<- c.fitmodel
;
2209 conf
.beyecolumns
<- (
2210 match conf
.columns
with
2211 | Cmulti
((c, _, _), _) -> Some
c
2213 | Csplit
_ -> failwith
"leaving bird's eye split mode"
2216 match c.columns
with
2217 | Cmulti
(c, _) -> Cmulti
(c, E.a)
2218 | Csingle
_ -> Csingle
E.a
2219 | Csplit
(c, _) -> Csplit
(c, E.a)
2223 state
.text <- Printf.sprintf
"birds eye mode off (zoom %3.1f%%)"
2226 reshape state
.winw state
.winh
;
2227 state
.anchor <- if goback
then anchor else (pageno, 0.0, 1.0);
2231 let togglebirdseye () =
2232 match state
.mode
with
2233 | Birdseye vals
-> leavebirdseye vals
true
2234 | View
-> enterbirdseye ()
2239 let upbirdseye incr
(conf
, leftx
, pageno, hooverpageno
, anchor) =
2240 let pageno = max
0 (pageno - incr
) in
2241 let rec loop = function
2242 | [] -> gotopage1 pageno 0
2243 | l :: _ when l.pageno = pageno ->
2244 if l.pagedispy >= 0 && l.pagey = 0
2245 then G.postRedisplay "upbirdseye"
2246 else gotopage1 pageno 0
2247 | _ :: rest
-> loop rest
2251 state
.mode
<- Birdseye
(conf
, leftx
, pageno, hooverpageno
, anchor)
2254 let downbirdseye incr
(conf
, leftx
, pageno, hooverpageno
, anchor) =
2255 let pageno = min
(state
.pagecount
- 1) (pageno + incr
) in
2256 state
.mode
<- Birdseye
(conf
, leftx
, pageno, hooverpageno
, anchor);
2257 let rec loop = function
2259 let y, h = getpageyh
pageno in
2260 let dy = (y - state
.y) - (state
.winh
- h - conf
.interpagespace
) in
2262 | l :: _ when l.pageno = pageno ->
2263 if l.pagevh != l.pageh
2264 then gotoy (clamp (l.pageh
- l.pagevh + conf
.interpagespace
))
2265 else G.postRedisplay "downbirdseye"
2266 | _ :: rest
-> loop rest
2272 let optentry mode
_ key =
2273 let btos b = if b then "on" else "off" in
2274 if key >= 32 && key < 127
2276 let c = Char.chr
key in
2280 try conf
.scrollstep
<- int_of_string
s with exc
->
2281 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2283 TEswitch
("scroll step: ", E.s, None
, intentry, ondone, true)
2288 conf
.autoscrollstep
<- boundastep state
.winh
(int_of_string
s);
2289 if state
.autoscroll
<> None
2290 then state
.autoscroll
<- Some conf
.autoscrollstep
2292 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2294 TEswitch
("auto scroll step: ", E.s, None
, intentry, ondone, true)
2299 let n, a, b = multicolumns_of_string
s in
2300 setcolumns mode
n a b;
2302 state
.text <- Printf.sprintf
"bad columns `%s': %s" s (exntos exc
)
2304 TEswitch
("columns: ", E.s, None
, textentry, ondone, true)
2309 let zoom = float (int_of_string
s) /. 100.0 in
2312 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2314 TEswitch
("zoom: ", E.s, None
, intentry, ondone, true)
2319 conf
.thumbw
<- bound
(int_of_string
s) 2 4096;
2321 Printf.sprintf
"thumbnail width is set to %d" conf
.thumbw
;
2322 begin match mode
with
2324 leavebirdseye beye
false;
2331 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2333 TEswitch
("thumbnail width: ", E.s, None
, intentry, ondone, true)
2338 Some
(int_of_string
s)
2340 state
.text <- Printf.sprintf
"bad integer `%s': %s"
2344 | Some angle
-> reqlayout angle conf
.fitmodel
2347 TEswitch
("rotation: ", E.s, None
, intentry, ondone, true)
2350 conf
.icase
<- not conf
.icase
;
2351 TEdone
("case insensitive search " ^
(btos conf
.icase
))
2354 conf
.preload <- not conf
.preload;
2356 TEdone
("preload " ^
(btos conf
.preload))
2359 conf
.verbose
<- not conf
.verbose
;
2360 TEdone
("verbose " ^
(btos conf
.verbose
))
2363 conf
.debug
<- not conf
.debug
;
2364 TEdone
("debug " ^
(btos conf
.debug
))
2367 conf
.maxhfit
<- not conf
.maxhfit
;
2368 state
.maxy
<- calcheight
();
2369 TEdone
("maxhfit " ^
(btos conf
.maxhfit
))
2372 conf
.crophack
<- not conf
.crophack
;
2373 TEdone
("crophack " ^
btos conf
.crophack
)
2377 match conf
.maxwait
with
2379 conf
.maxwait
<- Some infinity
;
2380 "always wait for page to complete"
2382 conf
.maxwait
<- None
;
2383 "show placeholder if page is not ready"
2388 conf
.underinfo
<- not conf
.underinfo
;
2389 TEdone
("underinfo " ^
btos conf
.underinfo
)
2392 conf
.savebmarks
<- not conf
.savebmarks
;
2393 TEdone
("persistent bookmarks " ^
btos conf
.savebmarks
)
2399 match state
.layout with
2404 conf
.interpagespace
<- int_of_string
s;
2405 docolumns conf
.columns
;
2406 state
.maxy
<- calcheight
();
2407 let y = getpagey
pageno in
2410 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2412 TEswitch
("vertical margin: ", E.s, None
, intentry, ondone, true)
2416 match conf
.fitmodel
with
2417 | FitProportional
-> FitWidth
2418 | FitWidth
| FitPage
-> FitProportional
2420 reqlayout conf
.angle
fm;
2421 TEdone
("proportional display " ^
btos (fm == FitProportional
))
2424 settrim (not conf
.trimmargins
) conf
.trimfuzz
;
2425 TEdone
("trim margins " ^
btos conf
.trimmargins
)
2428 conf
.invert
<- not conf
.invert
;
2429 TEdone
("invert colors " ^
btos conf
.invert
)
2433 cbput state
.hists
.sel
s;
2436 TEswitch
("selection command: ", E.s, Some
(onhist state
.hists
.sel
),
2437 textentry, ondone, true)
2441 then conf
.pax
<- Some
(ref (0.0, 0, 0))
2442 else conf
.pax
<- None
;
2443 TEdone
("PAX " ^
btos (conf
.pax
!= None
))
2446 state
.text <- Printf.sprintf
"bad option %d `%c'" key c;
2452 class type lvsource
= object
2453 method getitemcount
: int
2454 method getitem
: int -> (string * int)
2455 method hasaction
: int -> bool
2463 method getactive
: int
2464 method getfirst
: int
2466 method getminfo
: (int * int) array
2469 class virtual lvsourcebase
= object
2470 val mutable m_active
= 0
2471 val mutable m_first
= 0
2472 val mutable m_pan
= 0
2473 method getactive
= m_active
2474 method getfirst
= m_first
2475 method getpan
= m_pan
2476 method getminfo
: (int * int) array
= E.a
2479 let textentrykeyboard
2480 key _mask
((c, text, opthist
, onkey
, ondone, cancelonempty
), onleave
) =
2483 if key >= 0xffb0 && key <= 0xffb9
2484 then key - 0xffb0 + 48 else key
2487 state
.mode
<- Textentry
(te
, onleave
);
2489 G.postRedisplay "textentrykeyboard enttext";
2491 let histaction cmd
=
2494 | Some
(action, _) ->
2495 state
.mode
<- Textentry
(
2496 (c, action cmd
, opthist
, onkey
, ondone, cancelonempty
), onleave
2498 G.postRedisplay "textentry histaction"
2502 if emptystr
text && cancelonempty
2505 G.postRedisplay "textentrykeyboard after cancel";
2508 let s = withoutlastutf8
text in
2509 enttext (c, s, opthist
, onkey
, ondone, cancelonempty
)
2511 | @enter
| @kpenter
->
2514 G.postRedisplay "textentrykeyboard after confirm"
2516 | @up
| @kpup
-> histaction HCprev
2517 | @down
| @kpdown
-> histaction HCnext
2518 | @home
| @kphome
-> histaction HCfirst
2519 | @jend
| @kpend
-> histaction HClast
2524 begin match opthist
with
2526 | Some
(_, onhistcancel
) -> onhistcancel
()
2530 G.postRedisplay "textentrykeyboard after cancel2"
2533 enttext (c, E.s, opthist
, onkey
, ondone, cancelonempty
)
2536 | @delete
| @kpdelete
-> ()
2539 && key land 0xff00 != 0xff00 (* keyboard *)
2540 && key land 0xfe00 != 0xfe00 (* xkb *)
2541 && key land 0xfd00 != 0xfd00 (* 3270 *)
2543 begin match onkey
text key with
2547 G.postRedisplay "textentrykeyboard after confirm2";
2550 enttext (c, text, opthist
, onkey
, ondone, cancelonempty
);
2554 G.postRedisplay "textentrykeyboard after cancel3"
2557 state
.mode
<- Textentry
(te
, onleave
);
2558 G.postRedisplay "textentrykeyboard switch";
2562 vlog "unhandled key %s" (Wsi.keyname
key)
2565 let firstof first active
=
2566 if first
> active
|| abs
(first
- active
) > fstate
.maxrows
- 1
2567 then max
0 (active
- (fstate
.maxrows
/2))
2571 let calcfirst first active
=
2574 let rows = active
- first
in
2575 if rows > fstate
.maxrows
then active
- fstate
.maxrows
else first
2579 let scrollph y maxy
=
2580 let sh = float (maxy
+ state
.winh
) /. float state
.winh
in
2581 let sh = float state
.winh
/. sh in
2582 let sh = max
sh (float conf
.scrollh
) in
2584 let percent = float y /. float maxy
in
2585 let position = (float state
.winh
-. sh) *. percent in
2588 if position +. sh > float state
.winh
2589 then float state
.winh
-. sh
2595 let coe s = (s :> uioh
);;
2597 class listview ~zebra ~helpmode ~
(source
:lvsource
) ~trusted ~modehash
=
2599 val m_pan
= source#getpan
2600 val m_first
= source#getfirst
2601 val m_active
= source#getactive
2603 val m_prev_uioh
= state
.uioh
2605 method private elemunder
y =
2609 let n = y / (fstate
.fontsize
+1) in
2610 if m_first
+ n < source#getitemcount
2612 if source#hasaction
(m_first
+ n)
2613 then Some
(m_first
+ n)
2620 GlFunc.blend_func ~src
:`src_alpha ~dst
:`one_minus_src_alpha
;
2621 GlDraw.color
(0., 0., 0.) ~alpha
:0.85;
2622 filledrect 0. 0. (float state
.winw
) (float state
.winh
);
2623 GlDraw.color
(1., 1., 1.);
2624 Gl.enable `texture_2d
;
2625 let fs = fstate
.fontsize
in
2627 let hw = (wadjsb () + xadjsb () + state
.winw
)/3 in
2628 let ww = fstate
.wwidth
in
2629 let tabw = 17.0*.ww in
2630 let itemcount = source#getitemcount
in
2631 let minfo = source#getminfo
in
2634 then float (xadjsb ()), float (state
.winw
- 1)
2635 else 0.0, float (state
.winw
- conf
.scrollbw
- 1)
2637 let xadj = xadjsb () in
2639 if (row - m_first
) > fstate
.maxrows
2642 if row >= 0 && row < itemcount
2644 let (s, level
) = source#getitem
row in
2645 let y = (row - m_first
) * nfs in
2647 (if conf
.leftscroll
then float xadj else 5.0)
2648 +. (float (level
+ m_pan
)) *. ww in
2651 (let c = if row land 1 = 0 then 1.0 else 0.92 in (c,c,c));
2655 Gl.disable `texture_2d
;
2656 let alpha = if source#hasaction
row then 0.9 else 0.3 in
2657 GlDraw.color
(1., 1., 1.) ~
alpha;
2658 linerect (x0 +. 1.) (float (y + 1)) (x1) (float (y + fs + 3));
2659 Gl.enable `texture_2d
;
2662 if zebra
&& row land 1 = 1
2666 GlDraw.color
(c,c,c);
2667 let drawtabularstring s =
2669 let x'
= truncate
(x0 +. x) in
2670 let pos = nindex
s '
\000'
in
2672 then drawstring1 fs x'
(y+nfs) s
2674 let s1 = String.sub
s 0 pos
2675 and s2
= String.sub
s (pos+1) (String.length
s - pos - 1) in
2680 let s'
= withoutlastutf8
s in
2681 let s = s' ^
"@Uellipsis" in
2682 let w = measurestr
fs s in
2683 if float x'
+. w +. ww < float (hw + x'
)
2688 if float x'
+. ww +. measurestr
fs s1 > float (hw + x'
)
2692 ignore
(drawstring1 fs x'
(y+nfs) s1);
2693 drawstring1 fs (hw + x'
) (y+nfs) s2
2697 let x = if helpmode
&& row > 0 then x +. ww else x in
2698 let tabpos = nindex
s '
\t'
in
2701 let len = String.length
s - tabpos - 1 in
2702 let s1 = String.sub
s 0 tabpos
2703 and s2
= String.sub
s (tabpos + 1) len in
2704 let nx = drawstr x s1 in
2706 let x = x +. (max
tabw sw) in
2709 let len = String.length
s - 2 in
2710 if len > 0 && s.[0] = '
\xc2'
&& s.[1] = '
\xb7'
2712 let s = String.sub
s 2 len in
2713 let x = if not helpmode
then x +. ww else x in
2714 GlDraw.color
(1.2, 1.2, 1.2);
2715 let vinc = drawstring1 (fs+fs/4)
2716 (truncate
(x -. ww)) (y+nfs) s in
2717 GlDraw.color
(1., 1., 1.);
2718 vinc +. (float fs *. 0.8)
2724 ignore
(drawtabularstring s);
2730 GlDraw.color
(1.0, 1.0, 1.0) ~
alpha:0.5;
2731 let xadj = float (xadjsb () + 5) in
2733 if (row - m_first
) > fstate
.maxrows
2736 if row >= 0 && row < itemcount
2738 let (s, level
) = source#getitem
row in
2739 let pos0 = nindex
s '
\000'
in
2740 let y = (row - m_first
) * nfs in
2741 let x = float (level
+ m_pan
) *. ww in
2742 let (first
, last
) = minfo.(row) in
2744 if pos0 > 0 && first
> pos0
2745 then String.sub
s (pos0+1) (first
-pos0-1)
2746 else String.sub
s 0 first
2748 let suffix = String.sub
s first
(last
- first
) in
2749 let w1 = measurestr fstate
.fontsize
prefix in
2750 let w2 = measurestr fstate
.fontsize
suffix in
2751 let x = x +. if conf
.leftscroll
then xadj else 5.0 in
2752 let x = if pos0 > 0 && first
> pos0 then x +. float hw else x in
2754 and y0 = float (y+2) in
2756 and y1 = float (y+fs+3) in
2757 filledrect x0 y0 x1 y1;
2762 Gl.disable `texture_2d
;
2763 if Array.length
minfo > 0 then loop m_first
;
2766 method updownlevel incr
=
2767 let len = source#getitemcount
in
2769 if m_active
>= 0 && m_active
< len
2770 then snd
(source#getitem m_active
)
2774 if i
= len then i
-1 else if i
= -1 then 0 else
2775 let _, l = source#getitem i
in
2776 if l != curlevel then i
else flow (i
+incr
)
2778 let active = flow m_active
in
2779 let first = calcfirst m_first
active in
2780 G.postRedisplay "outline updownlevel";
2781 {< m_active
= active; m_first
= first >}
2783 method private key1
key mask
=
2784 let set1 active first qsearch
=
2785 coe {< m_active
= active; m_first
= first; m_qsearch
= qsearch
>}
2787 let search active pattern incr
=
2788 let active = if active = -1 then m_first
else active in
2791 if n >= 0 && n < source#getitemcount
2793 let s, _ = source#getitem
n in
2795 (try ignore
(Str.search_forward re
s 0); true
2796 with Not_found
-> false)
2798 else loop (n + incr
)
2805 let re = Str.regexp_case_fold pattern
in
2811 let itemcount = source#getitemcount
in
2812 let find start incr
=
2814 if i
= -1 || i
= itemcount
2817 if source#hasaction i
2819 else find (i
+ incr
)
2824 let set active first =
2825 let first = bound
first 0 (itemcount - fstate
.maxrows
) in
2827 coe {< m_active
= active; m_first
= first; m_qsearch
= E.s >}
2830 let isvisible first n = n >= first && n - first <= fstate
.maxrows
in
2832 let incr1 = if incr
> 0 then 1 else -1 in
2833 if isvisible m_first m_active
2836 let next = m_active
+ incr
in
2838 if next < 0 || next >= itemcount
2840 else find next incr1
2842 if abs
(m_active
- next) > fstate
.maxrows
2848 let first = m_first
+ incr
in
2849 let first = bound
first 0 (itemcount - fstate
.maxrows
) in
2851 let next = m_active
+ incr
in
2852 let next = bound
next 0 (itemcount - 1) in
2859 if isvisible first next
2866 let first = min
next m_first
in
2868 if abs
(next - first) > fstate
.maxrows
2874 let first = m_first
+ incr
in
2875 let first = bound
first 0 (itemcount - 1) in
2877 let next = m_active
+ incr
in
2878 let next = bound
next 0 (itemcount - 1) in
2879 let next = find next incr1 in
2881 if next = -1 || abs
(m_active
- first) > fstate
.maxrows
2883 let active = if m_active
= -1 then next else m_active
in
2888 if isvisible first active
2894 G.postRedisplay "listview navigate";
2898 | (@r
|@s) when Wsi.withctrl mask
->
2899 let incr = if key = @r
then -1 else 1 in
2901 match search (m_active
+ incr) m_qsearch
incr with
2903 state
.text <- m_qsearch ^
" [not found]";
2906 state
.text <- m_qsearch
;
2907 active, firstof m_first
active
2909 G.postRedisplay "listview ctrl-r/s";
2910 set1 active first m_qsearch
;
2912 | @insert
when Wsi.withctrl mask
->
2913 if m_active
>= 0 && m_active
< source#getitemcount
2915 let s, _ = source#getitem m_active
in
2921 if emptystr m_qsearch
2924 let qsearch = withoutlastutf8 m_qsearch
in
2928 G.postRedisplay "listview empty qsearch";
2929 set1 m_active m_first
E.s;
2933 match search m_active
qsearch ~
-1 with
2935 state
.text <- qsearch ^
" [not found]";
2938 state
.text <- qsearch;
2939 active, firstof m_first
active
2941 G.postRedisplay "listview backspace qsearch";
2942 set1 active first qsearch
2945 | key when (key != 0 && key land 0xff00 != 0xff00) ->
2946 let pattern = m_qsearch ^ toutf8
key in
2948 match search m_active
pattern 1 with
2950 state
.text <- pattern ^
" [not found]";
2953 state
.text <- pattern;
2954 active, firstof m_first
active
2956 G.postRedisplay "listview qsearch add";
2957 set1 active first pattern;
2961 if emptystr m_qsearch
2963 G.postRedisplay "list view escape";
2964 let mx, my
= state
.mpos
in
2968 source#exit ~uioh
:(coe self
)
2969 ~cancel
:true ~
active:m_active ~
first:m_first ~pan
:m_pan
2971 | None
-> m_prev_uioh
2976 G.postRedisplay "list view kill qsearch";
2977 coe {< m_qsearch
= E.s >}
2980 | @enter
| @kpenter
->
2982 let self = {< m_qsearch
= E.s >} in
2984 G.postRedisplay "listview enter";
2985 if m_active
>= 0 && m_active
< source#getitemcount
2987 source#exit ~uioh
:(coe self) ~cancel
:false
2988 ~
active:m_active ~
first:m_first ~pan
:m_pan
;
2991 source#exit ~uioh
:(coe self) ~cancel
:true
2992 ~
active:m_active ~
first:m_first ~pan
:m_pan
;
2995 begin match opt with
2996 | None
-> m_prev_uioh
3000 | @delete
| @kpdelete
->
3003 | @up
| @kpup
-> navigate ~
-1
3004 | @down
| @kpdown
-> navigate 1
3005 | @prior
| @kpprior
-> navigate ~
-(fstate
.maxrows
)
3006 | @next | @kpnext
-> navigate fstate
.maxrows
3008 | @right
| @kpright
->
3010 G.postRedisplay "listview right";
3011 coe {< m_pan
= m_pan
- 1 >}
3013 | @left | @kpleft
->
3015 G.postRedisplay "listview left";
3016 coe {< m_pan
= m_pan
+ 1 >}
3018 | @home
| @kphome
->
3019 let active = find 0 1 in
3020 G.postRedisplay "listview home";
3024 let first = max
0 (itemcount - fstate
.maxrows
) in
3025 let active = find (itemcount - 1) ~
-1 in
3026 G.postRedisplay "listview end";
3029 | key when (key = 0 || key land 0xff00 = 0xff00) ->
3033 dolog
"listview unknown key %#x" key; coe self
3035 method key key mask
=
3036 match state
.mode
with
3037 | Textentry te
-> textentrykeyboard key mask te
; coe self
3040 | LinkNav
_ -> self#key1
key mask
3042 method button button down
x y _ =
3045 | 1 when x > state
.winw
- conf
.scrollbw
->
3046 G.postRedisplay "listview scroll";
3049 let _, position, sh = self#
scrollph in
3050 if y > truncate
position && y < truncate
(position +. sh)
3052 state
.mstate
<- Mscrolly
;
3056 let s = float (max
0 (y - conf
.scrollh
)) /. float state
.winh
in
3057 let first = truncate
(s *. float source#getitemcount
) in
3058 let first = min source#getitemcount
first in
3059 Some
(coe {< m_first
= first; m_active
= first >})
3061 state
.mstate
<- Mnone
;
3065 begin match self#elemunder
y with
3067 G.postRedisplay "listview click";
3068 source#exit ~uioh
:(coe {< m_active
= n >})
3069 ~cancel
:false ~
active:n ~
first:m_first ~pan
:m_pan
3073 | n when (n == 4 || n == 5) && not down
->
3074 let len = source#getitemcount
in
3076 if n = 5 && m_first
+ fstate
.maxrows
>= len
3080 let first = m_first
+ (if n == 4 then -1 else 1) in
3081 bound
first 0 (len - 1)
3083 G.postRedisplay "listview wheel";
3084 Some
(coe {< m_first
= first >})
3085 | n when (n = 6 || n = 7) && not down
->
3086 let inc = if n = 7 then -1 else 1 in
3087 G.postRedisplay "listview hwheel";
3088 Some
(coe {< m_pan
= m_pan
+ inc >})
3093 | None
-> m_prev_uioh
3096 method multiclick
_ x y = self#button
1 true x y
3099 match state
.mstate
with
3101 let s = float (max
0 (y - conf
.scrollh
)) /. float state
.winh
in
3102 let first = truncate
(s *. float source#getitemcount
) in
3103 let first = min source#getitemcount
first in
3104 G.postRedisplay "listview motion";
3105 coe {< m_first
= first; m_active
= first >}
3113 method pmotion
x y =
3114 if x < state
.winw
- conf
.scrollbw
3117 match self#elemunder
y with
3118 | None
-> Wsi.setcursor
Wsi.CURSOR_INHERIT
; m_active
3119 | Some
n -> Wsi.setcursor
Wsi.CURSOR_INFO
; n
3123 then (G.postRedisplay "listview pmotion"; {< m_active
= n >})
3128 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
3132 method infochanged
_ = ()
3134 method scrollpw
= (0, 0.0, 0.0)
3136 let nfs = fstate
.fontsize
+ 1 in
3137 let y = m_first
* nfs in
3138 let itemcount = source#getitemcount
in
3139 let maxi = max
0 (itemcount - fstate
.maxrows
) in
3140 let maxy = maxi * nfs in
3141 let p, h = scrollph y maxy in
3144 method modehash
= modehash
3145 method eformsgs
= false
3146 method alwaysscrolly
= true
3149 class outlinelistview ~zebra ~source
=
3150 let settext autonarrow
s =
3153 let ss = source#statestr
in
3157 else "{" ^
ss ^
"} [" ^
s ^
"]"
3158 else state
.text <- s
3164 ~source
:(source
:> lvsource
)
3166 ~modehash
:(findkeyhash conf
"outline")
3169 val m_autonarrow
= false
3171 method! key key mask
=
3173 if emptystr state
.text
3175 else fstate
.maxrows - 2
3177 let calcfirst first active =
3180 let rows = active - first in
3181 if rows > maxrows then active - maxrows else first
3185 let active = m_active
+ incr in
3186 let active = bound
active 0 (source#getitemcount
- 1) in
3187 let first = calcfirst m_first
active in
3188 G.postRedisplay "outline navigate";
3189 coe {< m_active
= active; m_first
= first >}
3191 let navscroll first =
3193 let dist = m_active
- first in
3199 else first + maxrows
3202 G.postRedisplay "outline navscroll";
3203 coe {< m_first
= first; m_active
= active >}
3205 let ctrl = Wsi.withctrl mask
in
3210 then (source#denarrow
; E.s)
3212 let pattern = source#renarrow
in
3213 if nonemptystr m_qsearch
3214 then (source#narrow m_qsearch
; m_qsearch
)
3218 settext (not m_autonarrow
) text;
3219 G.postRedisplay "toggle auto narrowing";
3220 coe {< m_first
= 0; m_active
= 0; m_autonarrow
= not m_autonarrow
>}
3222 | @slash
when emptystr m_qsearch
&& not m_autonarrow
->
3224 G.postRedisplay "toggle auto narrowing";
3225 coe {< m_first
= 0; m_active
= 0; m_autonarrow
= true >}
3228 source#narrow m_qsearch
;
3230 then source#add_narrow_pattern m_qsearch
;
3231 G.postRedisplay "outline ctrl-n";
3232 coe {< m_first
= 0; m_active
= 0 >}
3235 let active = source#calcactive
(getanchor
()) in
3236 let first = firstof m_first
active in
3237 G.postRedisplay "outline ctrl-s";
3238 coe {< m_first
= first; m_active
= active >}
3241 G.postRedisplay "outline ctrl-u";
3242 if m_autonarrow
&& nonemptystr m_qsearch
3244 ignore
(source#renarrow
);
3245 settext m_autonarrow
E.s;
3246 coe {< m_first
= 0; m_active
= 0; m_qsearch
= E.s >}
3249 source#del_narrow_pattern
;
3250 let pattern = source#renarrow
in
3252 if emptystr
pattern then E.s else "Narrowed to " ^
pattern
3254 settext m_autonarrow
text;
3255 coe {< m_first
= 0; m_active
= 0; m_qsearch
= E.s >}
3259 let first = max
0 (m_active
- (fstate
.maxrows / 2)) in
3260 G.postRedisplay "outline ctrl-l";
3261 coe {< m_first
= first >}
3263 | @tab
when m_autonarrow
->
3264 if nonemptystr m_qsearch
3266 G.postRedisplay "outline list view tab";
3267 source#add_narrow_pattern m_qsearch
;
3269 coe {< m_qsearch
= E.s >}
3273 | @escape
when m_autonarrow
->
3274 if nonemptystr m_qsearch
3275 then source#add_narrow_pattern m_qsearch
;
3278 | @enter
| @kpenter
when m_autonarrow
->
3279 if nonemptystr m_qsearch
3280 then source#add_narrow_pattern m_qsearch
;
3283 | key when m_autonarrow
&& (key != 0 && key land 0xff00 != 0xff00) ->
3284 let pattern = m_qsearch ^ toutf8
key in
3285 G.postRedisplay "outlinelistview autonarrow add";
3286 source#narrow
pattern;
3287 settext true pattern;
3288 coe {< m_first
= 0; m_active
= 0; m_qsearch
= pattern >}
3290 | key when m_autonarrow
&& key = @backspace
->
3291 if emptystr m_qsearch
3294 let pattern = withoutlastutf8 m_qsearch
in
3295 G.postRedisplay "outlinelistview autonarrow backspace";
3296 ignore
(source#renarrow
);
3297 source#narrow
pattern;
3298 settext true pattern;
3299 coe {< m_first
= 0; m_active
= 0; m_qsearch
= pattern >}
3301 | @delete
| @kpdelete
->
3302 source#remove m_active
;
3303 G.postRedisplay "outline delete";
3304 let active = max
0 (m_active
-1) in
3305 coe {< m_first
= firstof m_first
active;
3306 m_active
= active >}
3308 | @up
| @kpup
when ctrl ->
3309 navscroll (max
0 (m_first
- 1))
3311 | @down
| @kpdown
when ctrl ->
3312 navscroll (min
(source#getitemcount
- 1) (m_first
+ 1))
3314 | @up
| @kpup
-> navigate ~
-1
3315 | @down
| @kpdown
-> navigate 1
3316 | @prior
| @kpprior
-> navigate ~
-(fstate
.maxrows)
3317 | @next | @kpnext
-> navigate fstate
.maxrows
3319 | @right
| @kpright
->
3323 G.postRedisplay "outline ctrl right";
3324 {< m_pan
= m_pan
+ 1 >}
3326 else self#updownlevel
1
3330 | @left | @kpleft
->
3334 G.postRedisplay "outline ctrl left";
3335 {< m_pan
= m_pan
- 1 >}
3337 else self#updownlevel ~
-1
3341 | @home
| @kphome
->
3342 G.postRedisplay "outline home";
3343 coe {< m_first
= 0; m_active
= 0 >}
3346 let active = source#getitemcount
- 1 in
3347 let first = max
0 (active - fstate
.maxrows) in
3348 G.postRedisplay "outline end";
3349 coe {< m_active
= active; m_first
= first >}
3351 | _ -> super#
key key mask
3354 let genhistoutlines =
3355 let order ty
(p1
, c1
, _, _, _, _) (p2
, c2
, _, _, _, _) =
3357 | `lastvisit
-> compare c1
.lastvisit c2
.lastvisit
3358 | `path
-> compare p2 p1
3359 | `file
-> compare
(Filename.basename p2
) (Filename.basename p1
)
3361 let e1 = emptystr c1
.title
3362 and e2
= emptystr c2
.title
in
3364 then compare
(Filename.basename p2
) (Filename.basename p1
)
3367 else compare c1
.title c2
.title
3369 let showfullpath = ref false in
3370 let showorigin = ref true in
3371 let orderty : historder
ref = ref `lastvisit
in
3374 let s = if !orderty = t
then "[@Uradical] " ^
s else "[ ] " ^
s in
3375 s, 0, Oreaction
(fun () -> orderty := t
; f ())
3377 match Config.gethist
() with
3382 (fun accu (path
, c, b, x, a, o) ->
3383 let hist = (path
, (c, b, x, a, o)) in
3385 let s = if nonemptystr
o && !showorigin then o else path
in
3386 if !showfullpath then s else Filename.basename
s
3388 let base = mbtoutf8
s in
3389 (base ^
"\000" ^
c.title
, 1, Ohistory
hist) :: accu
3391 [ setorty "Sort by time of last visit" `lastvisit
;
3392 setorty "Sort by file name" `file
;
3393 setorty "Sort by path" `path
;
3394 setorty "Sort by title" `title
;
3395 (if !showfullpath then "@Uradical "
3396 else " ") ^
"Show full path", 0, Oreaction
(fun () ->
3397 showfullpath := not
!showfullpath;
3399 (if !showorigin then "@Uradical "
3400 else " ") ^
"Show origin", 0, Oreaction
(fun () ->
3401 showorigin := not
!showorigin;
3403 ] (List.sort
(order !orderty) list
)
3409 let gotohist (path
, (c, bookmarks
, x, anchor, origin
)) =
3410 Config.save
leavebirdseye;
3411 state
.anchor <- anchor;
3412 state
.bookmarks
<- bookmarks
;
3413 state
.origin
<- origin
;
3416 let x0, y0, x1, y1 = conf
.trimfuzz
in
3417 wcmd "trimset %d %d %d %d %d" (btod conf
.trimmargins
) x0 y0 x1 y1;
3418 reshape ~firsttime
:true state
.winw state
.winh
;
3419 opendoc path origin
;
3423 let makecheckers () =
3424 (* Based on lablGL-1.04/LablGlut/examples/lablGL/checker.ml which had
3426 converted by Issac Trotts. July 25, 2002 *)
3427 let image = GlPix.create `ubyte ~format
:`luminance ~width
:2 ~height
:2 in
3428 Raw.sets_string
(GlPix.to_raw
image) ~
pos:0 "\255\200\200\255";
3429 let id = GlTex.gen_texture
() in
3430 GlTex.bind_texture ~target
:`texture_2d
id;
3431 GlPix.store
(`unpack_alignment
1);
3432 GlTex.image2d
image;
3433 List.iter
(GlTex.parameter ~target
:`texture_2d
)
3434 [ `mag_filter `nearest
; `min_filter `nearest
];
3438 let setcheckers enabled
=
3439 match state
.checkerstexid
with
3441 if enabled
then state
.checkerstexid
<- Some
(makecheckers ())
3443 | Some checkerstexid
->
3446 GlTex.delete_texture checkerstexid
;
3447 state
.checkerstexid
<- None
;
3451 let describe_location () =
3452 let fn = page_of_y state
.y in
3453 let ln = page_of_y
(state
.y + state
.winh
- hscrollh () - 1) in
3454 let maxy = state
.maxy - (if conf
.maxhfit
then state
.winh
else 0) in
3458 else (100. *. (float state
.y /. float maxy))
3462 Printf.sprintf
"page %d of %d [%.2f%%]"
3463 (fn+1) state
.pagecount
percent
3466 "pages %d-%d of %d [%.2f%%]"
3467 (fn+1) (ln+1) state
.pagecount
percent
3470 let setpresentationmode v
=
3471 let n = page_of_y state
.y in
3472 state
.anchor <- (n, 0.0, 1.0);
3473 conf
.presentation
<- v
;
3474 if conf
.fitmodel
= FitPage
3475 then reqlayout conf
.angle conf
.fitmodel
;
3480 let btos b = if b then "@Uradical" else E.s in
3481 let showextended = ref false in
3482 let leave mode
_ = state
.mode
<- mode
in
3485 val mutable m_first_time
= true
3486 val mutable m_l
= []
3487 val mutable m_a
= E.a
3488 val mutable m_prev_uioh
= nouioh
3489 val mutable m_prev_mode
= View
3491 inherit lvsourcebase
3493 method reset prev_mode prev_uioh
=
3494 m_a
<- Array.of_list
(List.rev m_l
);
3496 m_prev_mode
<- prev_mode
;
3497 m_prev_uioh
<- prev_uioh
;
3501 if n >= Array.length m_a
3505 | _, _, _, Action
_ -> m_active
<- n
3506 | _, _, _, Noaction
-> loop (n+1)
3509 m_first_time
<- false;
3512 method int name get
set =
3514 (name
, `
int get
, 1, Action
(
3517 try set (int_of_string
s)
3519 state
.text <- Printf.sprintf
"bad integer `%s': %s"
3523 let te = name ^
": ", E.s, None
, intentry, ondone, true in
3524 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3528 method int_with_suffix name get
set =
3530 (name
, `intws get
, 1, Action
(
3533 try set (int_of_string_with_suffix
s)
3535 state
.text <- Printf.sprintf
"bad integer `%s': %s"
3540 name ^
": ", E.s, None
, intentry_with_suffix, ondone, true
3542 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3546 method bool ?
(offset
=1) ?
(btos=btos) name get
set =
3548 (name
, `
bool (btos, get
), offset
, Action
(
3555 method color name get
set =
3557 (name
, `color get
, 1, Action
(
3559 let invalid = (nan
, nan
, nan
) in
3562 try color_of_string
s
3564 state
.text <- Printf.sprintf
"bad color `%s': %s"
3571 let te = name ^
": ", E.s, None
, textentry, ondone, true in
3572 state
.text <- color_to_string
(get
());
3573 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3577 method string name get
set =
3579 (name
, `
string get
, 1, Action
(
3581 let ondone s = set s in
3582 let te = name ^
": ", E.s, None
, textentry, ondone, true in
3583 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3587 method colorspace name get
set =
3589 (name
, `
string get
, 1, Action
(
3593 inherit lvsourcebase
3596 m_active
<- CSTE.to_int conf
.colorspace
;
3599 method getitemcount
=
3600 Array.length
CSTE.names
3603 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3604 ignore
(uioh
, first, pan
);
3605 if not cancel
then set active;
3607 method hasaction
_ = true
3611 let modehash = findkeyhash conf
"info" in
3612 coe (new listview ~zebra
:false ~helpmode
:false
3613 ~
source ~trusted
:true ~
modehash)
3616 method paxmark name get
set =
3618 (name
, `
string get
, 1, Action
(
3622 inherit lvsourcebase
3625 m_active
<- MTE.to_int conf
.paxmark
;
3628 method getitemcount
= Array.length
MTE.names
3629 method getitem
n = (MTE.names
.(n), 0)
3630 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3631 ignore
(uioh
, first, pan
);
3632 if not cancel
then set active;
3634 method hasaction
_ = true
3638 let modehash = findkeyhash conf
"info" in
3639 coe (new listview ~zebra
:false ~helpmode
:false
3640 ~
source ~trusted
:true ~
modehash)
3643 method fitmodel name get
set =
3645 (name
, `
string get
, 1, Action
(
3649 inherit lvsourcebase
3652 m_active
<- FMTE.to_int conf
.fitmodel
;
3655 method getitemcount
= Array.length
FMTE.names
3656 method getitem
n = (FMTE.names
.(n), 0)
3657 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3658 ignore
(uioh
, first, pan
);
3659 if not cancel
then set active;
3661 method hasaction
_ = true
3665 let modehash = findkeyhash conf
"info" in
3666 coe (new listview ~zebra
:false ~helpmode
:false
3667 ~
source ~trusted
:true ~
modehash)
3670 method caption
s offset
=
3671 m_l
<- (s, `empty
, offset
, Noaction
) :: m_l
3673 method caption2
s f offset
=
3674 m_l
<- (s, `
string f, offset
, Noaction
) :: m_l
3676 method getitemcount
= Array.length m_a
3679 let tostr = function
3680 | `
int f -> string_of_int
(f ())
3681 | `intws
f -> string_with_suffix_of_int
(f ())
3683 | `color
f -> color_to_string
(f ())
3684 | `
bool (btos, f) -> btos (f ())
3687 let name, t
, offset
, _ = m_a
.(n) in
3688 ((let s = tostr t
in
3690 then Printf.sprintf
"%s\t%s" name s
3694 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3699 match m_a
.(active) with
3700 | _, _, _, Action
f -> f uioh
3701 | _, _, _, Noaction
-> uioh
3712 method hasaction
n =
3714 | _, _, _, Action
_ -> true
3715 | _, _, _, Noaction
-> false
3718 let rec fillsrc prevmode prevuioh
=
3719 let sep () = src#caption
E.s 0 in
3720 let colorp name get
set =
3722 (fun () -> color_to_string
(get
()))
3725 let c = color_of_string
v in
3728 state
.text <- Printf.sprintf
"bad color `%s': %s" v (exntos exn
)
3731 let oldmode = state
.mode
in
3732 let birdseye = isbirdseye state
.mode
in
3734 src#caption
(if birdseye then "Setup (Bird's eye)" else "Setup") 0;
3736 src#
bool "presentation mode"
3737 (fun () -> conf
.presentation
)
3738 (fun v -> setpresentationmode v);
3740 src#
bool "ignore case in searches"
3741 (fun () -> conf
.icase
)
3742 (fun v -> conf
.icase
<- v);
3745 (fun () -> conf
.preload)
3746 (fun v -> conf
.preload <- v);
3748 src#
bool "highlight links"
3749 (fun () -> conf
.hlinks
)
3750 (fun v -> conf
.hlinks
<- v);
3752 src#
bool "under info"
3753 (fun () -> conf
.underinfo
)
3754 (fun v -> conf
.underinfo
<- v);
3756 src#
bool "persistent bookmarks"
3757 (fun () -> conf
.savebmarks
)
3758 (fun v -> conf
.savebmarks
<- v);
3760 src#fitmodel
"fit model"
3761 (fun () -> FMTE.to_string conf
.fitmodel
)
3762 (fun v -> reqlayout conf
.angle
(FMTE.of_int
v));
3764 src#
bool "trim margins"
3765 (fun () -> conf
.trimmargins
)
3766 (fun v -> settrim v conf
.trimfuzz
; fillsrc prevmode prevuioh
);
3768 src#
bool "persistent location"
3769 (fun () -> conf
.jumpback
)
3770 (fun v -> conf
.jumpback
<- v);
3773 src#
int "inter-page space"
3774 (fun () -> conf
.interpagespace
)
3776 conf
.interpagespace
<- n;
3777 docolumns conf
.columns
;
3779 match state
.layout with
3784 state
.maxy <- calcheight
();
3785 let y = getpagey
pageno in
3790 (fun () -> conf
.pagebias
)
3791 (fun v -> conf
.pagebias
<- v);
3793 src#
int "scroll step"
3794 (fun () -> conf
.scrollstep
)
3795 (fun n -> conf
.scrollstep
<- n);
3797 src#
int "horizontal scroll step"
3798 (fun () -> conf
.hscrollstep
)
3799 (fun v -> conf
.hscrollstep
<- v);
3801 src#
int "auto scroll step"
3803 match state
.autoscroll
with
3805 | _ -> conf
.autoscrollstep
)
3807 let n = boundastep state
.winh
n in
3808 if state
.autoscroll
<> None
3809 then state
.autoscroll
<- Some
n;
3810 conf
.autoscrollstep
<- n);
3813 (fun () -> truncate
(conf
.zoom *. 100.))
3814 (fun v -> setzoom ((float v) /. 100.));
3817 (fun () -> conf
.angle
)
3818 (fun v -> reqlayout v conf
.fitmodel
);
3820 src#
int "scroll bar width"
3821 (fun () -> conf
.scrollbw
)
3824 reshape state
.winw state
.winh
;
3827 src#
int "scroll handle height"
3828 (fun () -> conf
.scrollh
)
3829 (fun v -> conf
.scrollh
<- v;);
3831 src#
int "thumbnail width"
3832 (fun () -> conf
.thumbw
)
3834 conf
.thumbw
<- min
4096 v;
3837 leavebirdseye beye
false;
3844 let mode = state
.mode in
3845 src#
string "columns"
3847 match conf
.columns
with
3849 | Cmulti
(multi
, _) -> multicolumns_to_string multi
3850 | Csplit
(count
, _) -> "-" ^ string_of_int count
3853 let n, a, b = multicolumns_of_string
v in
3854 setcolumns mode n a b);
3857 src#caption
"Pixmap cache" 0;
3858 src#int_with_suffix
"size (advisory)"
3859 (fun () -> conf
.memlimit
)
3860 (fun v -> conf
.memlimit
<- v);
3863 (fun () -> Printf.sprintf
"%s bytes, %d tiles"
3864 (string_with_suffix_of_int state
.memused
)
3865 (Hashtbl.length state
.tilemap
)) 1;
3868 src#caption
"Layout" 0;
3869 src#caption2
"Dimension"
3871 Printf.sprintf
"%dx%d (virtual %dx%d)"
3872 state
.winw state
.winh
3877 src#caption2
"Position" (fun () ->
3878 Printf.sprintf
"%dx%d" state
.x state
.y
3881 src#caption2
"Position" (fun () -> describe_location ()) 1
3885 src#
bool ~offset
:0 ~
btos:(fun v -> if v then "(on)" else "(off)")
3886 "Save these parameters as global defaults at exit"
3887 (fun () -> conf
.bedefault
)
3888 (fun v -> conf
.bedefault
<- v)
3892 let btos b = if b then "@Ulguillemet" else "@Urguillemet" in
3893 src#
bool ~offset
:0 ~
btos "Extended parameters"
3894 (fun () -> !showextended)
3895 (fun v -> showextended := v; fillsrc prevmode prevuioh
);
3899 (fun () -> conf
.checkers
)
3900 (fun v -> conf
.checkers
<- v; setcheckers v);
3901 src#
bool "update cursor"
3902 (fun () -> conf
.updatecurs
)
3903 (fun v -> conf
.updatecurs
<- v);
3904 src#
bool "scroll-bar on the left"
3905 (fun () -> conf
.leftscroll
)
3906 (fun v -> conf
.leftscroll
<- v);
3908 (fun () -> conf
.verbose
)
3909 (fun v -> conf
.verbose
<- v);
3910 src#
bool "invert colors"
3911 (fun () -> conf
.invert
)
3912 (fun v -> conf
.invert
<- v);
3914 (fun () -> conf
.maxhfit
)
3915 (fun v -> conf
.maxhfit
<- v);
3916 src#
bool "redirect stderr"
3917 (fun () -> conf
.redirectstderr)
3918 (fun v -> conf
.redirectstderr <- v; redirectstderr ());
3920 (fun () -> conf
.pax
!= None
)
3923 then conf
.pax
<- Some
(ref (now
(), 0, 0))
3924 else conf
.pax
<- None
);
3925 src#
string "uri launcher"
3926 (fun () -> conf
.urilauncher
)
3927 (fun v -> conf
.urilauncher
<- v);
3928 src#
string "path launcher"
3929 (fun () -> conf
.pathlauncher
)
3930 (fun v -> conf
.pathlauncher
<- v);
3931 src#
string "tile size"
3932 (fun () -> Printf.sprintf
"%dx%d" conf
.tilew conf
.tileh
)
3935 let w, h = Scanf.sscanf
v "%dx%d" (fun w h -> w, h) in
3936 conf
.tilew
<- max
64 w;
3937 conf
.tileh
<- max
64 h;
3940 state
.text <- Printf.sprintf
"bad tile size `%s': %s"
3943 src#
int "texture count"
3944 (fun () -> conf
.texcount
)
3947 then conf
.texcount
<- v
3948 else showtext '
!'
" Failed to set texture count please retry later"
3950 src#
int "slice height"
3951 (fun () -> conf
.sliceheight
)
3953 conf
.sliceheight
<- v;
3954 wcmd "sliceh %d" conf
.sliceheight
;
3956 src#
int "anti-aliasing level"
3957 (fun () -> conf
.aalevel
)
3959 conf
.aalevel
<- bound
v 0 8;
3960 state
.anchor <- getanchor
();
3961 opendoc state
.path state
.password;
3963 src#
string "page scroll scaling factor"
3964 (fun () -> string_of_float conf
.pgscale)
3967 let s = float_of_string
v in
3970 state
.text <- Printf.sprintf
3971 "bad page scroll scaling factor `%s': %s" v (exntos exn
)
3974 src#
int "ui font size"
3975 (fun () -> fstate
.fontsize
)
3976 (fun v -> setfontsize (bound
v 5 100));
3977 src#
int "hint font size"
3978 (fun () -> conf
.hfsize
)
3979 (fun v -> conf
.hfsize
<- bound
v 5 100);
3980 colorp "background color"
3981 (fun () -> conf
.bgcolor
)
3982 (fun v -> conf
.bgcolor
<- v);
3983 src#
bool "crop hack"
3984 (fun () -> conf
.crophack
)
3985 (fun v -> conf
.crophack
<- v);
3986 src#
string "trim fuzz"
3987 (fun () -> irect_to_string conf
.trimfuzz
)
3990 conf
.trimfuzz
<- irect_of_string
v;
3992 then settrim true conf
.trimfuzz
;
3994 state
.text <- Printf.sprintf
"bad irect `%s': %s" v (exntos exn
)
3996 src#
string "throttle"
3998 match conf
.maxwait
with
3999 | None
-> "show place holder if page is not ready"
4002 then "wait for page to fully render"
4004 "wait " ^ string_of_float
time
4005 ^
" seconds before showing placeholder"
4009 let f = float_of_string
v in
4011 then conf
.maxwait
<- None
4012 else conf
.maxwait
<- Some
f
4014 state
.text <- Printf.sprintf
"bad time `%s': %s" v (exntos exn
)
4016 src#
string "ghyll scroll"
4018 match conf
.ghyllscroll
with
4020 | Some nab
-> ghyllscroll_to_string nab
4023 try conf
.ghyllscroll
<- ghyllscroll_of_string
v
4025 state
.text <- Printf.sprintf
"bad ghyll `%s': %s" v (exntos exn
)
4027 src#
string "selection command"
4028 (fun () -> conf
.selcmd
)
4029 (fun v -> conf
.selcmd
<- v);
4030 src#
string "synctex command"
4031 (fun () -> conf
.stcmd
)
4032 (fun v -> conf
.stcmd
<- v);
4033 src#
string "pax command"
4034 (fun () -> conf
.paxcmd
)
4035 (fun v -> conf
.paxcmd
<- v);
4036 src#
string "ask password command"
4037 (fun () -> conf
.passcmd)
4038 (fun v -> conf
.passcmd <- v);
4039 src#
string "save path command"
4040 (fun () -> conf
.savecmd
)
4041 (fun v -> conf
.savecmd
<- v);
4042 src#colorspace
"color space"
4043 (fun () -> CSTE.to_string conf
.colorspace
)
4045 conf
.colorspace
<- CSTE.of_int
v;
4049 src#paxmark
"pax mark method"
4050 (fun () -> MTE.to_string conf
.paxmark
)
4051 (fun v -> conf
.paxmark
<- MTE.of_int
v);
4055 (fun () -> conf
.usepbo
)
4056 (fun v -> conf
.usepbo
<- v);
4057 src#
bool "mouse wheel scrolls pages"
4058 (fun () -> conf
.wheelbypage
)
4059 (fun v -> conf
.wheelbypage
<- v);
4060 src#
bool "open remote links in a new instance"
4061 (fun () -> conf
.riani
)
4062 (fun v -> conf
.riani
<- v);
4063 src#
bool "edit annotations inline"
4064 (fun () -> conf
.annotinline
)
4065 (fun v -> conf
.annotinline
<- v);
4069 src#caption
"Document" 0;
4070 List.iter
(fun (_, s) -> src#caption
s 1) state
.docinfo
;
4071 src#caption2
"Pages"
4072 (fun () -> string_of_int state
.pagecount
) 1;
4073 src#caption2
"Dimensions"
4074 (fun () -> string_of_int
(List.length state
.pdims
)) 1;
4078 src#caption
"Trimmed margins" 0;
4079 src#caption2
"Dimensions"
4080 (fun () -> string_of_int
(List.length state
.pdims
)) 1;
4084 src#caption
"OpenGL" 0;
4085 src#caption
(Printf.sprintf
"Vendor\t%s" (GlMisc.get_string `vendor
)) 1;
4086 src#caption
(Printf.sprintf
"Renderer\t%s" (GlMisc.get_string `renderer
)) 1;
4089 src#caption
"Location" 0;
4090 if nonemptystr state
.origin
4091 then src#caption
("Orign\t" ^ mbtoutf8 state
.origin
) 1;
4092 src#caption
("Path\t" ^ mbtoutf8 state
.path
) 1;
4094 src#reset prevmode prevuioh
;
4099 let prevmode = state
.mode
4100 and prevuioh
= state
.uioh in
4101 fillsrc prevmode prevuioh
;
4102 let source = (src :> lvsource
) in
4103 let modehash = findkeyhash conf
"info" in
4104 state
.uioh <- coe (object (self)
4105 inherit listview ~zebra
:false ~helpmode
:false
4106 ~
source ~trusted
:true ~
modehash as super
4107 val mutable m_prevmemused
= 0
4108 method! infochanged
= function
4110 if m_prevmemused
!= state
.memused
4112 m_prevmemused
<- state
.memused
;
4113 G.postRedisplay "memusedchanged";
4115 | Pdim
-> G.postRedisplay "pdimchanged"
4116 | Docinfo
-> fillsrc prevmode prevuioh
4118 method! key key mask
=
4119 if not
(Wsi.withctrl mask
)
4122 | @left | @kpleft
-> coe (self#updownlevel ~
-1)
4123 | @right
| @kpright
-> coe (self#updownlevel
1)
4124 | _ -> super#
key key mask
4125 else super#
key key mask
4127 G.postRedisplay "info";
4133 inherit lvsourcebase
4134 method getitemcount
= Array.length state
.help
4136 let s, l, _ = state
.help
.(n) in
4139 method exit ~
uioh ~cancel ~
active ~
first ~pan
=
4143 match state
.help
.(active) with
4144 | _, _, Action
f -> Some
(f uioh)
4145 | _, _, Noaction
-> Some
uioh
4154 method hasaction
n =
4155 match state
.help
.(n) with
4156 | _, _, Action
_ -> true
4157 | _, _, Noaction
-> false
4163 let modehash = findkeyhash conf
"help" in
4165 state
.uioh <- coe (new listview
4166 ~zebra
:false ~helpmode
:true
4167 ~
source ~trusted
:true ~
modehash);
4168 G.postRedisplay "help";
4174 inherit lvsourcebase
4175 val mutable m_items
= E.a
4177 method getitemcount
= 1 + Array.length m_items
4182 else m_items
.(n-1), 0
4184 method exit ~
uioh ~cancel ~
active ~
first ~pan
=
4189 then Buffer.clear state
.errmsgs
;
4196 method hasaction
n =
4200 state
.newerrmsgs
<- false;
4201 let l = Str.split newlinere
(Buffer.contents state
.errmsgs
) in
4202 m_items
<- Array.of_list
l
4211 let source = (msgsource :> lvsource
) in
4212 let modehash = findkeyhash conf
"listview" in
4213 state
.uioh <- coe (object
4214 inherit listview ~zebra
:false ~helpmode
:false
4215 ~
source ~trusted
:false ~
modehash as super
4218 then msgsource#reset
;
4221 G.postRedisplay "msgs";
4225 let editor = getenvwithdef
"EDITOR" E.s in
4229 let tmppath = Filename.temp_file
"llpp" "note" in
4232 let oc = open_out
tmppath in
4236 let execstr = editor ^
" " ^
tmppath in
4238 match popen
execstr [] with
4239 | (exception exn
) ->
4241 Printf.sprintf
"popen(%S) failed: %s" execstr (exntos exn
);
4244 match Unix.waitpid
[] pid with
4245 | (exception exn
) ->
4247 Printf.sprintf
"waitpid(%d) failed: %s" pid (exntos exn
);
4251 | Unix.WEXITED
0 -> filecontents
tmppath
4254 Printf.sprintf
"editor process(%s) exited abnormally: %d"
4257 | Unix.WSIGNALED
n ->
4259 Printf.sprintf
"editor process(%s) was killed by signal %d"
4262 | Unix.WSTOPPED
n ->
4264 Printf.sprintf
"editor(%s) process was stopped by signal %d"
4268 match Unix.unlink
tmppath with
4269 | (exception exn
) ->
4270 showtext '
!'
@@ Printf.sprintf
"failed to ulink %S: %s"
4271 tmppath (exntos exn
);
4276 let enterannotmode opaque slinkindex
=
4279 inherit lvsourcebase
4280 val mutable m_text
= E.s
4281 val mutable m_items
= E.a
4283 method getitemcount
= Array.length m_items
4286 let label, _func
= m_items
.(n) in
4289 method exit ~
uioh ~cancel ~
active ~
first ~pan
=
4290 ignore
(uioh, first, pan
);
4293 let _label, func
= m_items
.(active) in
4298 method hasaction
n = nonemptystr
@@ fst m_items
.(n)
4301 let rec split accu b i
=
4303 if p = String.length
s
4304 then (String.sub
s b (p-b), unit) :: accu
4306 if (i
> 70 && s.[p] = ' '
) || s.[p] = '
\r'
|| s.[p] = '
\n'
4308 let ss = if i
= 0 then E.s else String.sub
s b i
in
4309 split ((ss, unit)::accu) (p+1) 0
4314 wcmd "freepage %s" (~
> opaque);
4316 Hashtbl.fold (fun key opaque'
accu ->
4317 if opaque'
= opaque'
4318 then key :: accu else accu) state
.pagemap
[]
4320 List.iter
(Hashtbl.remove state
.pagemap
) keys;
4325 delannot
opaque slinkindex
;
4328 let edit inline
() =
4333 modannot
opaque slinkindex
s;
4339 let mode = state
.mode in
4342 ("annotation: ", m_text
, None
, textentry, update, true),
4343 fun _ -> state
.mode <- mode);
4347 let s = getusertext m_text
in
4352 ( "[Copy]", fun () -> selstring m_text
)
4353 :: ("[Delete]", dele)
4354 :: ("[Edit]", edit conf
.annotinline
)
4356 :: split [] 0 0 |> List.rev
|> Array.of_list
4363 let s = getannotcontents
opaque slinkindex
in
4366 let source = (msgsource :> lvsource
) in
4367 let modehash = findkeyhash conf
"listview" in
4368 state
.uioh <- coe (object
4369 inherit listview ~zebra
:false ~helpmode
:false
4370 ~
source ~trusted
:false ~
modehash
4372 G.postRedisplay "enterannotmode";
4375 let gotounder under =
4376 let getpath filename
=
4378 if nonemptystr filename
4380 if Filename.is_relative filename
4382 let dir = Filename.dirname state
.path in
4384 if Filename.is_implicit
dir
4385 then Filename.concat
(Sys.getcwd
()) dir
4388 Filename.concat
dir filename
4392 if Sys.file_exists
path
4397 | Ulinkgoto
(pageno, top) ->
4401 gotopage1 pageno top;
4407 | Uremote
(filename
, pageno) ->
4408 let path = getpath filename
in
4413 let command = Printf.sprintf
"%s -page %d %S" !selfexec pageno path in
4414 try addpid
@@ popen
command []
4415 with exn
-> dolog
"failed to execute `%s': %s" command (exntos exn
)
4417 let anchor = getanchor
() in
4418 let ranchor = state
.path, state
.password, anchor, state
.origin
in
4419 state
.origin
<- E.s;
4420 state
.anchor <- (pageno, 0.0, 0.0);
4421 state
.ranchors
<- ranchor :: state
.ranchors
;
4424 else showtext '
!'
("Could not find " ^ filename
)
4426 | Uremotedest
(filename
, destname
) ->
4427 let path = getpath filename
in
4432 let command = !selfexec ^
" " ^
path ^
" -dest " ^ destname
in
4433 try addpid
@@ popen
command []
4434 with exn
-> dolog
"failed to execute `%s': %s" command (exntos exn
)
4436 let anchor = getanchor
() in
4437 let ranchor = state
.path, state
.password, anchor, state
.origin
in
4438 state
.origin
<- E.s;
4439 state
.nameddest
<- destname
;
4440 state
.ranchors
<- ranchor :: state
.ranchors
;
4443 else showtext '
!'
("Could not find " ^ filename
)
4445 | Uunexpected
_ | Ulaunch
_ | Unamed
_ | Utext
_ | Unone
-> ()
4446 | Uannotation
(opaque, slinkindex
) -> enterannotmode opaque slinkindex
4449 let gotooutline (_, _, kind
) =
4453 let (pageno, y, _) = anchor in
4455 (if conf
.presentation
then (pageno, y, 1.0) else anchor)
4460 | Ouri
uri -> gotounder (Ulinkuri
uri); None
4461 | Olaunch cmd
-> gotounder (Ulaunch cmd
); None
4462 | Oremote remote
-> gotounder (Uremote remote
); None
4463 | Ohistory
hist -> gotohist hist; None
4464 | Oremotedest remotedest
-> gotounder (Uremotedest remotedest
); None
4465 | Oaction
f -> f (); None
4466 | Oreaction
f -> Some
(f ())
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
4502 if not
confrimremoval
4506 match gotooutline m_items
.(active) with
4509 self#reset emptyanchor outlines
;
4513 state
.bookmarks
<- Array.to_list m_items
;
4514 m_orig_items
<- m_items
;
4515 m_orig_minfo
<- m_minfo
;
4525 method hasaction
_ = true
4528 if Array.length m_items
!= Array.length m_orig_items
4531 match m_narrow_patterns
with
4533 | many
-> String.concat
"@Uellipsis" (List.rev many
)
4535 "Narrowed to " ^
s ^
" (ctrl-u to restore)"
4539 match m_narrow_patterns
with
4542 | head
:: _ -> "@Uellipsis" ^ head
4544 method narrow
pattern =
4545 match Str.regexp_case_fold
pattern with
4548 let rec loop accu minfo n =
4551 m_items
<- Array.of_list
accu;
4552 m_minfo
<- Array.of_list
minfo;
4555 let (s, _, t
) as o = m_items
.(n) in
4558 | Oaction
_ | Oreaction
_ -> o :: accu, (0, 0) :: minfo
4559 | Onone
| Oanchor
_ | Ouri
_ | Olaunch
_
4560 | Oremote
_ | Oremotedest
_ | Ohistory
_ ->
4561 match Str.search_forward
re s 0 with
4562 | exception Not_found
-> accu, minfo
4563 | first -> 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 ()
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
_ | Oreaction
_ ->
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 enteroutlinemode, enterbookmarkmode
, enterhistmode
=
4656 let mkselector 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 ()
4665 if Array.length
outlines = 0
4667 showtext ' ' errmsg
;
4671 state
.text <- source#greetmsg
;
4672 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
4673 let anchor = getanchor
() in
4674 source#reset
anchor outlines;
4676 coe (new outlinelistview ~zebra
:(sourcetype
=`history
) ~
source);
4677 G.postRedisplay "enter selector";
4680 let mkenter sourcetype errmsg
=
4681 let enter = mkselector sourcetype
in
4682 fun () -> enter errmsg
4684 (**)mkenter `
outlines "Document has no outline"
4685 , mkenter `bookmarks
"Document has no bookmarks (yet)"
4686 , mkenter `history
"History is empty"
4689 let quickbookmark ?title
() =
4690 match state
.layout with
4696 let tm = Unix.localtime
(now
()) in
4698 "Quick (page %d) (bookmarked at %02d/%02d/%d %02d:%02d)"
4702 (tm.Unix.tm_year
+ 1900)
4705 | Some
title -> title
4707 state
.bookmarks
<- (title, 0, Oanchor
(getanchor1
l)) :: state
.bookmarks
4710 let setautoscrollspeed step goingdown
=
4711 let incr = max
1 ((abs step
) / 2) in
4712 let incr = if goingdown
then incr else -incr in
4713 let astep = boundastep state
.winh
(step
+ incr) in
4714 state
.autoscroll
<- Some
astep;
4718 match conf
.columns
with
4720 | Csingle
_ | Cmulti
_ -> state
.x != 0 || conf
.zoom > 1.0
4723 let panbound x = bound
x (-state
.w) (wadjsb () + state
.winw
);;
4725 let existsinrow pageno (columns
, coverA
, coverB
) p =
4726 let last = ((pageno - coverA
) mod columns
) + columns
in
4727 let rec any = function
4730 if l.pageno = coverA
- 1 || l.pageno = state
.pagecount
- coverB
4734 then (if l.pageno = last then false else any rest
)
4742 match state
.layout with
4744 let pageno = page_of_y state
.y in
4745 gotoghyll (getpagey
(pageno+1))
4747 match conf
.columns
with
4749 if conf
.presentation
&& rest
== [] && l.pageh
> l.pagey + l.pagevh
4751 let y = clamp (pgscale state
.winh
) in
4754 let pageno = min
(l.pageno+1) (state
.pagecount
-1) in
4755 gotoghyll (getpagey
pageno)
4756 | Cmulti
((c, _, _) as cl, _) ->
4757 if conf
.presentation
4758 && (existsinrow l.pageno cl
4759 (fun l -> l.pageh
> l.pagey + l.pagevh))
4761 let y = clamp (pgscale state
.winh
) in
4764 let pageno = min
(l.pageno+c) (state
.pagecount
-1) in
4765 gotoghyll (getpagey
pageno)
4767 if l.pageno < state
.pagecount
- 1 || l.pagecol
< n - 1
4769 let pagey, pageh
= getpageyh
l.pageno in
4770 let pagey = pagey + pageh
* l.pagecol
in
4771 let ips = if l.pagecol
= 0 then 0 else conf
.interpagespace
in
4772 gotoghyll (pagey + pageh
+ ips)
4776 match state
.layout with
4778 let pageno = page_of_y state
.y in
4779 gotoghyll (getpagey
(pageno-1))
4781 match conf
.columns
with
4783 if conf
.presentation
&& l.pagey != 0
4785 gotoghyll (clamp (pgscale ~
-(state
.winh
)))
4787 let pageno = max
0 (l.pageno-1) in
4788 gotoghyll (getpagey
pageno)
4789 | Cmulti
((c, _, coverB
) as cl, _) ->
4790 if conf
.presentation
&&
4791 (existsinrow l.pageno cl (fun l -> l.pagey != 0))
4793 gotoghyll (clamp (pgscale ~
-(state
.winh
)))
4796 if l.pageno = state
.pagecount
- coverB
4800 let pageno = max
0 (l.pageno-decr) in
4801 gotoghyll (getpagey
pageno)
4809 let pageno = max
0 (l.pageno-1) in
4810 let pagey, pageh
= getpageyh
pageno in
4813 let pagey, pageh
= getpageyh
l.pageno in
4814 pagey + pageh
* (l.pagecol
-1) - conf
.interpagespace
4820 if emptystr conf
.savecmd
4821 then error
"don't know where to save modified document"
4823 let savecmd = Str.global_replace percentsre state
.path conf
.savecmd in
4826 (fun s -> error
"failed to obtain path to the saved copy: %s" s)
4831 let tmp = path ^
".tmp" in
4833 Unix.rename
tmp path;
4836 let viewkeyboard key mask
=
4838 let mode = state
.mode in
4839 state
.mode <- Textentry
(te, fun _ -> state
.mode <- mode);
4842 G.postRedisplay "view:enttext"
4844 let ctrl = Wsi.withctrl mask
in
4846 if key >= 0xffb0 && key < 0xffb9 then key - 0xffb0 + 48 else key
4852 if hasunsavedchanges
()
4856 if conf
.angle
mod 360 = 0 && not
(isbirdseye state
.mode)
4858 state
.mode <- LinkNav
(Ltgendir
0);
4861 else showtext '
!'
"Keyboard link navigation does not work under rotation"
4864 begin match state
.mstate
with
4867 G.postRedisplay "kill rect";
4870 | Mscrolly
| Mscrollx
4873 begin match state
.mode with
4876 G.postRedisplay "esc leave linknav"
4880 match state
.ranchors
with
4882 | (path, password, anchor, origin
) :: rest
->
4883 state
.ranchors
<- rest
;
4884 state
.anchor <- anchor;
4885 state
.origin
<- origin
;
4886 state
.nameddest
<- E.s;
4887 opendoc path password
4892 gotoghyll (getnav ~
-1)
4903 Hashtbl.iter
(fun _ opaque -> clearmark
opaque) state
.pagemap
;
4904 G.postRedisplay "dehighlight";
4906 | @slash
| @question
->
4907 let ondone isforw
s =
4908 cbput state
.hists
.pat
s;
4909 state
.searchpattern
<- s;
4912 let s = String.make
1 (Char.chr
key) in
4913 enttext (s, E.s, Some
(onhist state
.hists
.pat
),
4914 textentry, ondone (key = @slash
), true)
4916 | @plus
| @kpplus
| @equals
when ctrl ->
4917 let incr = if conf
.zoom +. 0.01 > 0.1 then 0.1 else 0.01 in
4918 setzoom (conf
.zoom +. incr)
4920 | @plus
| @kpplus
->
4923 try int_of_string
s with exc
->
4924 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
);
4930 state
.text <- "page bias is now " ^ string_of_int
n;
4933 enttext ("page bias: ", E.s, None
, intentry, ondone, true)
4935 | @minus
| @kpminus
when ctrl ->
4936 let decr = if conf
.zoom -. 0.1 < 0.1 then 0.01 else 0.1 in
4937 setzoom (max
0.01 (conf
.zoom -. decr))
4939 | @minus
| @kpminus
->
4940 let ondone msg
= state
.text <- msg
in
4942 "option [acfhilpstvxACFPRSZTISM]: ", E.s, None
,
4943 optentry state
.mode, ondone, true
4954 | (@1 | @2) when ctrl && conf
.fitmodel
!= FitPage
-> (* ctrl-1/2 *)
4956 match conf
.columns
with
4957 | Csingle
_ | Cmulti
_ -> 1
4958 | Csplit
(n, _) -> n
4960 let h = state
.winh
-
4961 conf
.interpagespace
lsl (if conf
.presentation
then 1 else 0)
4963 let zoom = zoomforh state
.winw
h (vscrollw ()) cols in
4964 if zoom > 0.0 && (key = 50 || zoom < 1.0)
4969 match conf
.fitmodel
with
4970 | FitWidth
-> FitProportional
4971 | FitProportional
-> FitPage
4972 | FitPage
-> FitWidth
4974 state
.text <- "fit model: " ^
FMTE.to_string
fm;
4975 reqlayout conf
.angle
fm
4983 | (48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57)
4984 when not
ctrl -> (* 0..9 *)
4987 try int_of_string
s with exc
->
4988 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
);
4994 cbput state
.hists
.pag
(string_of_int
n);
4995 gotopage1 (n + conf
.pagebias
- 1) 0;
4998 let pageentry text key =
4999 match Char.unsafe_chr
key with
5000 | '
g'
-> TEdone
text
5001 | _ -> intentry text key
5003 let text = String.make
1 (Char.chr
key) in
5004 enttext (":", text, Some
(onhist state
.hists
.pag
),
5005 pageentry, ondone, true)
5008 conf
.scrollb
<- if conf
.scrollb
= 0 then (scrollbvv
lor scrollbhv
) else 0;
5009 reshape state
.winw state
.winh
;
5012 state
.bzoom
<- not state
.bzoom
;
5014 showtext ' '
("block zoom " ^
if state
.bzoom
then "on" else "off")
5017 conf
.hlinks
<- not conf
.hlinks
;
5018 state
.text <- "highlightlinks " ^
if conf
.hlinks
then "on" else "off";
5019 G.postRedisplay "toggle highlightlinks";
5022 state
.glinks
<- true;
5023 let mode = state
.mode in
5024 state
.mode <- Textentry
(
5025 (":", E.s, None
, linknentry, linknact gotounder, false),
5027 state
.glinks
<- false;
5031 G.postRedisplay "view:linkent(F)"
5034 state
.glinks
<- true;
5035 let mode = state
.mode in
5036 state
.mode <- Textentry
(
5038 ":", E.s, None
, linknentry, linknact (fun under ->
5039 selstring (undertext under);
5043 state
.glinks
<- false;
5047 G.postRedisplay "view:linkent"
5050 begin match state
.autoscroll
with
5052 conf
.autoscrollstep
<- step
;
5053 state
.autoscroll
<- None
5055 if conf
.autoscrollstep
= 0
5056 then state
.autoscroll
<- Some
1
5057 else state
.autoscroll
<- Some conf
.autoscrollstep
5064 setpresentationmode (not conf
.presentation
);
5065 showtext ' '
("presentation mode " ^
5066 if conf
.presentation
then "on" else "off");
5069 if List.mem
Wsi.Fullscreen state
.winstate
5070 then Wsi.reshape conf
.cwinw conf
.cwinh
5071 else Wsi.fullscreen
()
5074 search state
.searchpattern
false
5077 search state
.searchpattern
true
5080 begin match state
.layout with
5083 gotoghyll (getpagey
l.pageno)
5089 | @delete
| @kpdelete
-> (* delete *)
5093 showtext ' '
(describe_location ());
5096 begin match state
.layout with
5099 Wsi.reshape (l.pagew
+ vscrollw ()) l.pageh
;
5104 enterbookmarkmode
()
5112 | @e when Buffer.length state
.errmsgs
> 0 ->
5117 match state
.layout with
5122 (s, 0, Oanchor
(getanchor1
l)) :: state
.bookmarks
5125 enttext ("bookmark: ", E.s, None
, textentry, ondone, true)
5129 showtext ' '
"Quick bookmark added";
5132 begin match state
.layout with
5134 let rect = getpdimrect
l.pagedimno
in
5138 (truncate
(1.8 *. (rect.(1) -. rect.(0))),
5139 truncate
(1.2 *. (rect.(3) -. rect.(0))))
5141 (truncate
(rect.(1) -. rect.(0)),
5142 truncate
(rect.(3) -. rect.(0)))
5144 let w = truncate
((float w)*.conf
.zoom)
5145 and h = truncate
((float h)*.conf
.zoom) in
5148 state
.anchor <- getanchor
();
5149 Wsi.reshape (w + vscrollw ()) (h + conf
.interpagespace
)
5151 G.postRedisplay "z";
5156 | @x -> state
.roam
()
5159 reqlayout (conf
.angle
+
5160 (if key = @Gt
then 30 else -30)) conf
.fitmodel
5164 bound
(conf
.colorscale
+. (if key = 93 then 0.1 else -0.1)) 0.0 1.0
5166 G.postRedisplay "brightness";
5168 | @c when state
.mode = View
->
5173 let m = (wadjsb () + state
.winw
- state
.w) / 2 in
5175 gotoy_and_clear_text state
.y
5179 match state
.prevcolumns
with
5180 | None
-> (1, 0, 0), 1.0
5181 | Some
(columns
, z
) ->
5184 | Csplit
(c, _) -> -c, 0, 0
5185 | Cmulti
((c, a, b), _) -> c, a, b
5186 | Csingle
_ -> 1, 0, 0
5190 setcolumns View
c a b;
5193 | @down
| @up
when ctrl && Wsi.withshift mask
->
5194 let zoom, x = state
.prevzoom
in
5198 | @k
| @up
| @kpup
->
5199 begin match state
.autoscroll
with
5201 begin match state
.mode with
5202 | Birdseye beye
-> upbirdseye 1 beye
5207 then gotoy_and_clear_text (clamp ~
-(state
.winh
/2))
5209 if not
(Wsi.withshift mask
) && conf
.presentation
5211 else gotoghyll1 true (clamp (-conf
.scrollstep
))
5215 setautoscrollspeed n false
5218 | @j
| @down
| @kpdown
->
5219 begin match state
.autoscroll
with
5221 begin match state
.mode with
5222 | Birdseye beye
-> downbirdseye 1 beye
5227 then gotoy_and_clear_text (clamp (state
.winh
/2))
5229 if not
(Wsi.withshift mask
) && conf
.presentation
5231 else gotoghyll1 true (clamp (conf
.scrollstep
))
5235 setautoscrollspeed n true
5238 | @left | @right
| @kpleft
| @kpright
when not
(Wsi.withalt mask
) ->
5244 else conf
.hscrollstep
5246 let dx = if key = @left || key = @kpleft
then dx else -dx in
5247 state
.x <- panbound (state
.x + dx);
5248 gotoy_and_clear_text state
.y
5251 G.postRedisplay "left/right"
5254 | @prior
| @kpprior
->
5258 match state
.layout with
5260 | l :: _ -> state
.y - l.pagey
5262 clamp (pgscale (-state
.winh
))
5266 | @next | @kpnext
->
5270 match List.rev state
.layout with
5272 | l :: _ -> getpagey
l.pageno
5274 clamp (pgscale state
.winh
)
5278 | @g | @home
| @kphome
->
5281 | @G
| @jend
| @kpend
->
5283 gotoghyll (clamp state
.maxy)
5285 | @right
| @kpright
when Wsi.withalt mask
->
5286 gotoghyll (getnav 1)
5287 | @left | @kpleft
when Wsi.withalt mask
->
5288 gotoghyll (getnav ~
-1)
5293 | @v when conf
.debug
->
5296 match getopaque l.pageno with
5299 let x0, y0, x1, y1 = pagebbox
opaque in
5300 let a,b = float x0, float y0 in
5301 let c,d = float x1, float y0 in
5302 let e,f = float x1, float y1 in
5303 let h,j
= float x0, float y1 in
5304 let rect = (a,b,c,d,e,f,h,j
) in
5306 state
.rects
<- (l.pageno, l.pageno mod 3, rect) :: state
.rects
;
5308 G.postRedisplay "v";
5311 let mode = state
.mode in
5312 let cmd = ref E.s in
5313 let onleave = function
5314 | Cancel
-> state
.mode <- mode
5317 match getopaque l.pageno with
5318 | Some
opaque -> pipesel opaque !cmd
5319 | None
-> ()) state
.layout;
5323 cbput state
.hists
.sel
s;
5327 "| ", !cmd, Some
(onhist state
.hists
.sel
), textentry, ondone, true
5329 G.postRedisplay "|";
5330 state
.mode <- Textentry
(te, onleave);
5333 vlog "huh? %s" (Wsi.keyname
key)
5336 let linknavkeyboard key mask
linknav =
5337 let getpage pageno =
5338 let rec loop = function
5340 | l :: _ when l.pageno = pageno -> Some
l
5341 | _ :: rest
-> loop rest
5342 in loop state
.layout
5344 let doexact (pageno, n) =
5345 match getopaque pageno, getpage pageno with
5346 | Some
opaque, Some
l ->
5347 if key = @enter || key = @kpenter
5349 let under = getlink
opaque n in
5350 G.postRedisplay "link gotounder";
5357 Some
(findlink
opaque LDfirst
), -1
5360 Some
(findlink
opaque LDlast
), 1
5363 Some
(findlink
opaque (LDleft
n)), -1
5366 Some
(findlink
opaque (LDright
n)), 1
5369 Some
(findlink
opaque (LDup
n)), -1
5372 Some
(findlink
opaque (LDdown
n)), 1
5377 begin match findpwl
l.pageno dir with
5381 state
.mode <- LinkNav
(Ltgendir
dir);
5382 let y, h = getpageyh
pageno in
5385 then y + h - state
.winh
5390 begin match getopaque pageno, getpage pageno with
5391 | Some
opaque, Some
_ ->
5393 let ld = if dir > 0 then LDfirst
else LDlast
in
5396 begin match link with
5398 showlinktype (getlink
opaque m);
5399 state
.mode <- LinkNav
(Ltexact
(pageno, m));
5400 G.postRedisplay "linknav jpage";
5401 | Lnotfound
-> notfound dir
5407 begin match opt with
5408 | Some Lnotfound
-> pwl l dir;
5409 | Some
(Lfound
m) ->
5413 let _, y0, _, y1 = getlinkrect
opaque m in
5415 then gotopage1 l.pageno y0
5417 let d = fstate
.fontsize
+ 1 in
5418 if y1 - l.pagey > l.pagevh - d
5419 then gotopage1 l.pageno (y1 - state
.winh
- hscrollh () + d)
5420 else G.postRedisplay "linknav";
5422 showlinktype (getlink
opaque m);
5423 state
.mode <- LinkNav
(Ltexact
(l.pageno, m));
5426 | None
-> viewkeyboard key mask
5428 | _ -> viewkeyboard key mask
5433 G.postRedisplay "leave linknav"
5437 | Ltgendir
_ | Ltnotready
_ -> viewkeyboard key mask
5438 | Ltexact exact
-> doexact exact
5441 let keyboard key mask
=
5442 if (key = 103 && Wsi.withctrl mask
) && not
(istextentry state
.mode)
5443 then wcmd "interrupt"
5444 else state
.uioh <- state
.uioh#
key key mask
5447 let birdseyekeyboard key mask
5448 ((oconf
, leftx
, pageno, hooverpageno
, anchor) as beye
) =
5450 match conf
.columns
with
5452 | Cmulti
((c, _, _), _) -> c
5453 | Csplit
_ -> failwith
"bird's eye split mode"
5455 let pgh layout = List.fold_left
5456 (fun m l -> max
l.pageh
m) state
.winh
layout in
5458 | @l when Wsi.withctrl mask
->
5459 let y, h = getpageyh
pageno in
5460 let top = (state
.winh
- h) / 2 in
5461 gotoy (max
0 (y - top))
5462 | @enter | @kpenter
-> leavebirdseye beye
false
5463 | @escape
-> leavebirdseye beye
true
5464 | @up
-> upbirdseye incr beye
5465 | @down
-> downbirdseye incr beye
5466 | @left -> upbirdseye 1 beye
5467 | @right
-> downbirdseye 1 beye
5470 begin match state
.layout with
5474 state
.mode <- Birdseye
(
5475 oconf
, leftx
, l.pageno, hooverpageno
, anchor
5477 gotopage1 l.pageno 0;
5480 let layout = layout (state
.y-state
.winh
) (pgh state
.layout) in
5482 | [] -> gotoy (clamp (-state
.winh
))
5484 state
.mode <- Birdseye
(
5485 oconf
, leftx
, l.pageno, hooverpageno
, anchor
5487 gotopage1 l.pageno 0
5490 | [] -> gotoy (clamp (-state
.winh
))
5494 begin match List.rev state
.layout with
5496 let layout = layout (state
.y + (pgh state
.layout)) state
.winh
in
5497 begin match layout with
5499 let incr = l.pageh
- l.pagevh in
5504 oconf
, leftx
, state
.pagecount
- 1, hooverpageno
, anchor
5506 G.postRedisplay "birdseye pagedown";
5508 else gotoy (clamp (incr + conf
.interpagespace
*2));
5512 Birdseye
(oconf
, leftx
, l.pageno, hooverpageno
, anchor);
5513 gotopage1 l.pageno 0;
5516 | [] -> gotoy (clamp state
.winh
)
5520 state
.mode <- Birdseye
(oconf
, leftx
, 0, hooverpageno
, anchor);
5524 let pageno = state
.pagecount
- 1 in
5525 state
.mode <- Birdseye
(oconf
, leftx
, pageno, hooverpageno
, anchor);
5526 if not
(pagevisible state
.layout pageno)
5529 match List.rev state
.pdims
with
5531 | (_, _, h, _) :: _ -> h
5533 gotoy (max
0 (getpagey
pageno - (state
.winh
- h - conf
.interpagespace
)))
5534 else G.postRedisplay "birdseye end";
5536 | _ -> viewkeyboard key mask
5541 match state
.mode with
5542 | Textentry
_ -> scalecolor 0.4
5544 | View
-> scalecolor 1.0
5545 | Birdseye
(_, _, pageno, hooverpageno
, _) ->
5546 if l.pageno = hooverpageno
5549 if l.pageno = pageno
5551 let c = scalecolor 1.0 in
5553 GlDraw.line_width
3.0;
5554 let dispx = xadjsb () + l.pagedispx in
5556 (float (dispx-1)) (float (l.pagedispy-1))
5557 (float (dispx+l.pagevw+1))
5558 (float (l.pagedispy+l.pagevh+1))
5560 GlDraw.line_width
1.0;
5569 let postdrawpage l linkindexbase
=
5570 match getopaque l.pageno with
5572 if tileready l l.pagex
l.pagey
5574 let x = l.pagedispx - l.pagex
+ xadjsb ()
5575 and y = l.pagedispy - l.pagey in
5577 match conf
.columns
with
5578 | Csingle
_ | Cmulti
_ ->
5579 (if conf
.hlinks
then 1 else 0)
5581 && not
(isbirdseye state
.mode) then 2 else 0)
5585 match state
.mode with
5586 | Textentry
((_, s, _, _, _, _), _) when state
.glinks
-> s
5592 postprocess
opaque hlmask x y (linkindexbase
, s, conf
.hfsize
);
5597 let scrollindicator () =
5598 let sbw, ph
, sh = state
.uioh#
scrollph in
5599 let sbh, pw, sw = state
.uioh#scrollpw
in
5604 else ((state
.winw
- sbw), state
.winw
, 0)
5607 GlDraw.color (0.64, 0.64, 0.64);
5608 filledrect (float x0) 0. (float x1) (float state
.winh
);
5610 (float hx0
) (float (state
.winh
- sbh))
5611 (float (hx0
+ wadjsb () + state
.winw
)) (float state
.winh
)
5613 GlDraw.color (0.0, 0.0, 0.0);
5615 filledrect (float x0) ph
(float x1) (ph
+. sh);
5616 let pw = pw +. float hx0
in
5617 filledrect pw (float (state
.winh
- sbh)) (pw +. sw) (float state
.winh
);
5621 match state
.mstate
with
5622 | Mnone
| Mscrolly
| Mscrollx
| Mpan
_ | Mzoom
_ | Mzoomrect
_ ->
5625 | Msel
((x0, y0), (x1, y1)) ->
5626 let identify opaque l px py = Some
(opaque, l.pageno, px, py) in
5627 let o0,n0
,px0
,py0
= onppundermouse identify x0 y0 (~
< E.s, -1, 0, 0) in
5628 let _o1,n1
,px1
,py1
= onppundermouse identify x1 y1 (~
< E.s, -1, 0, 0) in
5629 if n0
!= -1 && n0
= n1
then seltext
o0 (px0
, py0
, px1
, py1
);
5632 let showrects = function [] -> () | rects
->
5634 GlDraw.color (0.0, 0.0, 1.0) ~
alpha:0.5;
5635 GlFunc.blend_func ~
src:`src_alpha ~dst
:`one_minus_src_alpha
;
5637 (fun (pageno, c, (x0, y0, x1, y1, x2
, y2
, x3
, y3
)) ->
5639 if l.pageno = pageno
5641 let dx = float (l.pagedispx - l.pagex
) in
5642 let dy = float (l.pagedispy - l.pagey) in
5643 GlDraw.color (0.0, 0.0, 1.0 /. float c) ~
alpha:0.5;
5644 Raw.sets_float state
.vraw ~
pos:0
5649 GlArray.vertex `two state
.vraw
;
5650 GlArray.draw_arrays `triangle_strip ~
first:0 ~count
:4;
5659 GlClear.color (scalecolor2 conf
.bgcolor
);
5660 GlClear.clear
[`
color];
5661 List.iter
drawpage state
.layout;
5663 match state
.mode with
5664 | LinkNav
(Ltexact
(pageno, linkno
)) ->
5665 begin match getopaque pageno with
5667 let dx = xadjsb () in
5668 let x0, y0, x1, y1 = getlinkrect
opaque linkno
in
5669 let x0 = x0 + dx and x1 = x1 + dx in
5676 | None
-> state
.rects
5678 | LinkNav
(Ltgendir
_) | LinkNav
(Ltnotready
_)
5681 | View
-> state
.rects
5684 let rec postloop linkindexbase
= function
5686 let linkindexbase = linkindexbase + postdrawpage l linkindexbase in
5687 postloop linkindexbase rest
5691 postloop 0 state
.layout;
5693 begin match state
.mstate
with
5694 | Mzoomrect
((x0, y0), (x1, y1)) ->
5696 GlDraw.color (0.3, 0.3, 0.3) ~
alpha:0.5;
5697 GlFunc.blend_func ~
src:`src_alpha ~dst
:`one_minus_src_alpha
;
5698 filledrect (float x0) (float y0) (float x1) (float y1);
5702 | Mscrolly
| Mscrollx
5711 let zoomrect x y x1 y1 =
5714 and y0 = min
y y1 in
5715 gotoy (state
.y + y0);
5716 state
.anchor <- getanchor
();
5717 let zoom = (float state
.w) /. float (x1 - x0) in
5720 let adjw = wadjsb () + state
.winw
in
5722 then (adjw - state
.w) / 2
5725 match conf
.fitmodel
with
5726 | FitWidth
| FitProportional
-> simple ()
5728 match conf
.columns
with
5730 onppundermouse (fun _ l _ _ -> Some
l.pagedispx) x0 y0 x0
5731 | Cmulti
_ | Csingle
_ -> simple ()
5733 state
.x <- (state
.x + margin) - x0;
5738 let annot inline
x y =
5739 match unproject x y with
5740 | Some
(opaque, n, ux
, uy
) ->
5742 addannot
opaque ux uy
text;
5743 wcmd "freepage %s" (~
> opaque);
5744 Hashtbl.remove state
.pagemap
(n, state
.gen
);
5750 let ondone s = add s in
5751 let mode = state
.mode in
5752 state
.mode <- Textentry
(
5753 ("annotation: ", E.s, None
, textentry, ondone, true),
5754 fun _ -> state
.mode <- mode);
5757 G.postRedisplay "annot"
5759 add @@ getusertext E.s
5764 let g opaque l px py =
5765 match rectofblock
opaque px py with
5767 let x0 = a.(0) -. 20. in
5768 let x1 = a.(1) +. 20. in
5769 let y0 = a.(2) -. 20. in
5770 let zoom = (float state
.w) /. (x1 -. x0) in
5771 let pagey = getpagey
l.pageno in
5772 gotoy_and_clear_text (pagey + truncate
y0);
5773 state
.anchor <- getanchor
();
5774 let margin = (state
.w - l.pagew
)/2 in
5775 state
.x <- -truncate
x0 - margin;
5780 match conf
.columns
with
5782 showtext '
!'
"block zooming does not work properly in split columns mode"
5783 | Cmulti
_ | Csingle
_ -> onppundermouse g x y ()
5787 let winw = wadjsb () + state
.winw - 1 in
5788 let s = float x /. float winw in
5789 let destx = truncate
(float (state
.w + winw) *. s) in
5790 state
.x <- winw - destx;
5791 gotoy_and_clear_text state
.y;
5792 state
.mstate
<- Mscrollx
;
5796 let s = float y /. float state
.winh
in
5797 let desty = truncate
(float (state
.maxy - state
.winh
) *. s) in
5798 gotoy_and_clear_text desty;
5799 state
.mstate
<- Mscrolly
;
5802 let viewmulticlick clicks
x y mask
=
5803 let g opaque l px py =
5811 if markunder
opaque px py mark
5815 match getopaque l.pageno with
5817 | Some
opaque -> pipesel opaque cmd
5819 state
.roam
<- (fun () -> dopipe conf
.paxcmd
);
5820 if not
(Wsi.withctrl mask
) then dopipe conf
.selcmd
;
5825 G.postRedisplay "viewmulticlick";
5826 onppundermouse g x y (fun () -> showtext '
!'
"Nothing to select") ();
5830 match conf
.columns
with
5832 | Csingle
_ | Cmulti
_ -> conf
.angle
mod 360 = 0
5835 let viewmouse button down
x y mask
=
5837 | n when (n == 4 || n == 5) && not down
->
5838 if Wsi.withctrl mask
5840 match state
.mstate
with
5841 | Mzoom
(oldn
, i
) ->
5849 if conf
.zoom +. 0.01 > 0.1 then 0.1 else 0.01
5851 if conf
.zoom -. 0.1 < 0.1 then -0.01 else -0.1
5853 let zoom = conf
.zoom -. incr in
5855 state
.mstate
<- Mzoom
(n, 0);
5857 state
.mstate
<- Mzoom
(n, i
+1);
5859 else state
.mstate
<- Mzoom
(n, 0)
5863 | Mscrolly
| Mscrollx
5865 | Mnone
-> state
.mstate
<- Mzoom
(n, 0)
5868 match state
.autoscroll
with
5869 | Some step
-> setautoscrollspeed step
(n=4)
5871 if conf
.wheelbypage
|| conf
.presentation
5880 then -conf
.scrollstep
5881 else conf
.scrollstep
5883 let incr = incr * 2 in
5884 let y = clamp incr in
5885 gotoy_and_clear_text y
5888 | n when (n = 6 || n = 7) && not down
&& canpan () ->
5890 panbound (state
.x + (if n = 7 then -2 else 2) * conf
.hscrollstep
);
5891 gotoy_and_clear_text state
.y
5893 | 1 when Wsi.withshift mask
->
5894 state
.mstate
<- Mnone
;
5897 match unproject x y with
5898 | Some
(_, pageno, ux
, uy
) ->
5899 let cmd = Printf.sprintf
5901 conf
.stcmd state
.path pageno ux uy
5903 addpid
@@ popen
cmd []
5907 | 1 when Wsi.withctrl mask
->
5910 Wsi.setcursor
Wsi.CURSOR_FLEUR
;
5911 state
.mstate
<- Mpan
(x, y)
5914 state
.mstate
<- Mnone
5919 if Wsi.withshift mask
5921 annot conf
.annotinline
x y;
5922 G.postRedisplay "addannot"
5926 Wsi.setcursor
Wsi.CURSOR_CYCLE
;
5927 state
.mstate
<- Mzoomrect
(p, p)
5930 match state
.mstate
with
5931 | Mzoomrect
((x0, y0), _) ->
5932 if abs
(x-x0) > 10 && abs
(y - y0) > 10
5933 then zoomrect x0 y0 x y
5936 G.postRedisplay "kill accidental zoom rect";
5940 | Mscrolly
| Mscrollx
5946 | 1 when x > state
.winw - vscrollw () ->
5949 let _, position, sh = state
.uioh#
scrollph in
5950 if y > truncate
position && y < truncate
(position +. sh)
5951 then state
.mstate
<- Mscrolly
5954 state
.mstate
<- Mnone
5956 | 1 when y > state
.winh
- hscrollh () ->
5959 let _, position, sw = state
.uioh#scrollpw
in
5960 if x > truncate
position && x < truncate
(position +. sw)
5961 then state
.mstate
<- Mscrollx
5964 state
.mstate
<- Mnone
5966 | 1 when state
.bzoom
-> if not down
then zoomblock x y
5969 let dest = if down
then getunder x y else Unone
in
5970 begin match dest with
5973 | Uremote
_ | Uremotedest
_
5974 | Uunexpected
_ | Ulaunch
_ | Unamed
_ ->
5977 | Unone
when down
->
5978 Wsi.setcursor
Wsi.CURSOR_FLEUR
;
5979 state
.mstate
<- Mpan
(x, y);
5981 | Uannotation
(opaque, slinkindex
) -> enterannotmode opaque slinkindex
5983 | Unone
| Utext
_ ->
5988 state
.mstate
<- Msel
((x, y), (x, y));
5989 G.postRedisplay "mouse select";
5993 match state
.mstate
with
5996 | Mzoom
_ | Mscrollx
| Mscrolly
->
5997 state
.mstate
<- Mnone
5999 | Mzoomrect
((x0, y0), _) ->
6003 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
6004 state
.mstate
<- Mnone
6006 | Msel
((x0, y0), (x1, y1)) ->
6007 let rec loop = function
6011 let a0 = l.pagedispy in
6012 let a1 = a0 + l.pagevh in
6013 let b0 = l.pagedispx in
6014 let b1 = b0 + l.pagevw in
6015 ((y0 >= a0 && y0 <= a1) || (y1 >= a0 && y1 <= a1))
6016 && ((x0 >= b0 && x0 <= b1) || (x1 >= b0 && x1 <= b1))
6020 match getopaque l.pageno with
6023 match Unix.pipe
() with
6027 "can not create sel pipe: %s"
6031 Ne.clo fd
(fun msg
->
6032 dolog
"%s close failed: %s" what msg
)
6035 try popen
cmd [r
, 0; w, -1]
6037 dolog
"can not execute %S: %s"
6044 G.postRedisplay "copysel";
6046 else clo "Msel pipe/w" w;
6047 clo "Msel pipe/r" r
;
6049 dosel conf
.selcmd
();
6050 state
.roam
<- dosel conf
.paxcmd
;
6062 let birdseyemouse button down
x y mask
6063 (conf
, leftx
, _, hooverpageno
, anchor) =
6066 let rec loop = function
6069 if y > l.pagedispy && y < l.pagedispy + l.pagevh
6070 && x > l.pagedispx && x < l.pagedispx + l.pagevw
6072 leavebirdseye (conf
, leftx
, l.pageno, hooverpageno
, anchor) false;
6078 | _ -> viewmouse button down
x y mask
6084 method key key mask
=
6085 begin match state
.mode with
6086 | Textentry
textentry -> textentrykeyboard key mask
textentry
6087 | Birdseye
birdseye -> birdseyekeyboard key mask
birdseye
6088 | View
-> viewkeyboard key mask
6089 | LinkNav
linknav -> linknavkeyboard key mask
linknav
6093 method button button bstate
x y mask
=
6094 begin match state
.mode with
6096 | View
-> viewmouse button bstate
x y mask
6097 | Birdseye beye
-> birdseyemouse button bstate
x y mask beye
6102 method multiclick clicks
x y mask
=
6103 begin match state
.mode with
6105 | View
-> viewmulticlick clicks
x y mask
6112 begin match state
.mode with
6114 | View
| Birdseye
_ | LinkNav
_ ->
6115 match state
.mstate
with
6116 | Mzoom
_ | Mnone
-> ()
6121 state
.mstate
<- Mpan
(x, y);
6123 then state
.x <- panbound (state
.x + dx);
6125 gotoy_and_clear_text y
6128 state
.mstate
<- Msel
(a, (x, y));
6129 G.postRedisplay "motion select";
6132 let y = min state
.winh
(max
0 y) in
6136 let x = min state
.winw (max
0 x) in
6139 | Mzoomrect
(p0
, _) ->
6140 state
.mstate
<- Mzoomrect
(p0
, (x, y));
6141 G.postRedisplay "motion zoomrect";
6145 method pmotion
x y =
6146 begin match state
.mode with
6147 | Birdseye
(conf
, leftx
, pageno, hooverpageno
, anchor) ->
6148 let rec loop = function
6150 if hooverpageno
!= -1
6152 state
.mode <- Birdseye
(conf
, leftx
, pageno, -1, anchor);
6153 G.postRedisplay "pmotion birdseye no hoover";
6156 if y > l.pagedispy && y < l.pagedispy + l.pagevh
6157 && x > l.pagedispx && x < l.pagedispx + l.pagevw
6159 state
.mode <- Birdseye
(conf
, leftx
, pageno, l.pageno, anchor);
6160 G.postRedisplay "pmotion birdseye hoover";
6170 match state
.mstate
with
6171 | Mpan
_ | Msel
_ | Mzoom
_ | Mscrolly
| Mscrollx
| Mzoomrect
_ -> ()
6179 let past, _, _ = !r
in
6181 let delta = now -. past in
6184 else r
:= (now, x, y)
6188 method infochanged
_ = ()
6191 let maxy = state
.maxy - (if conf
.maxhfit
then state
.winh
else 0) in
6194 then 0.0, float state
.winh
6195 else scrollph state
.y maxy
6200 let winw = wadjsb () + state
.winw in
6201 let fwinw = float winw in
6203 let sw = fwinw /. float state
.w in
6204 let sw = fwinw *. sw in
6205 max
sw (float conf
.scrollh
)
6208 let maxx = state
.w + winw in
6209 let x = winw - state
.x in
6210 let percent = float x /. float maxx in
6211 (fwinw -. sw) *. percent
6213 hscrollh (), position, sw
6217 match state
.mode with
6218 | LinkNav
_ -> "links"
6219 | Textentry
_ -> "textentry"
6220 | Birdseye
_ -> "birdseye"
6223 findkeyhash conf
modename
6225 method eformsgs
= true
6226 method alwaysscrolly
= false
6229 let adderrmsg src msg
=
6230 Buffer.add_string state
.errmsgs msg
;
6231 state
.newerrmsgs
<- true;
6235 let adderrfmt src fmt
=
6236 Format.ksprintf
(fun s -> adderrmsg src s) fmt
;
6240 let cl = splitatspace cmds
in
6242 try Scanf.sscanf
s fmt
f
6244 adderrfmt "remote exec"
6245 "error processing '%S': %s\n" cmds
(exntos exn
)
6248 | "reload" :: [] -> reload ()
6249 | "goto" :: args
:: [] ->
6250 scan args
"%u %f %f"
6252 let cmd, _ = state
.geomcmds
in
6254 then gotopagexy pageno x y
6257 gotopagexy pageno x y;
6260 state
.reprf
<- f state
.reprf
6262 | "goto1" :: args
:: [] -> scan args
"%u %f" gotopage
6263 | "gotor" :: args
:: [] ->
6265 (fun filename
pageno -> gotounder (Uremote
(filename
, pageno)))
6266 | "gotord" :: args
:: [] ->
6268 (fun filename
dest -> gotounder (Uremotedest
(filename
, dest)))
6269 | "rect" :: args
:: [] ->
6270 scan args
"%u %u %f %f %f %f"
6271 (fun pageno color x0 y0 x1 y1 ->
6272 onpagerect pageno (fun w h ->
6273 let _,w1,h1
,_ = getpagedim
pageno in
6274 let sw = float w1 /. float w
6275 and sh = float h1
/. float h in
6279 and y1s
= y1 *. sh in
6280 let rect = (x0s,y0s
,x1s
,y0s
,x1s
,y1s
,x0s,y1s
) in
6282 state
.rects <- (pageno, color, rect) :: state
.rects;
6283 G.postRedisplay "rect";
6286 | "activatewin" :: [] -> Wsi.activatewin
()
6287 | "quit" :: [] -> raise Quit
6289 adderrfmt "remote command"
6290 "error processing remote command: %S\n" cmds
;
6294 let scratch = Bytes.create
80 in
6295 let buf = Buffer.create
80 in
6297 match tempfailureretry
(Unix.read fd
scratch 0) 80 with
6298 | exception Unix.Unix_error
(Unix.EAGAIN
, _, _) -> None
6301 if Buffer.length
buf > 0
6303 let s = Buffer.contents
buf in
6311 match Bytes.index_from
scratch ppos '
\n'
with
6312 | pos -> if pos >= n then -1 else pos
6313 | exception Not_found
-> -1
6317 Buffer.add_subbytes
buf scratch ppos
(nlpos-ppos
);
6318 let s = Buffer.contents
buf in
6324 Buffer.add_subbytes
buf scratch ppos
(n-ppos
);
6330 let remoteopen path =
6331 try Some
(Unix.openfile
path [Unix.O_NONBLOCK
; Unix.O_RDONLY
] 0o0)
6333 adderrfmt "remoteopen" "error opening %S: %s" path (exntos exn
);
6338 let gcconfig = ref E.s in
6339 let trimcachepath = ref E.s in
6340 let rcmdpath = ref E.s in
6341 let pageno = ref None
in
6342 let rootwid = ref 0 in
6343 let openlast = ref false in
6344 let nofc = ref false in
6345 let doreap = ref false in
6346 selfexec := Sys.executable_name
;
6349 [("-p", Arg.String
(fun s -> state
.password <- s),
6350 "<password> Set password");
6354 Config.fontpath
:= s;
6355 selfexec := !selfexec ^
" -f " ^
Filename.quote
s;
6357 "<path> Set path to the user interface font");
6361 selfexec := !selfexec ^
" -c " ^
Filename.quote
s;
6362 Config.confpath
:= s),
6363 "<path> Set path to the configuration file");
6365 ("-last", Arg.Set
openlast, " Open last document");
6367 ("-page", Arg.Int
(fun pageno1
-> pageno := Some
(pageno1
-1)),
6368 "<page-number> Jump to page");
6370 ("-tcf", Arg.String
(fun s -> trimcachepath := s),
6371 "<path> Set path to the trim cache file");
6373 ("-dest", Arg.String
(fun s -> state
.nameddest
<- s),
6374 "<named-destination> Set named destination");
6376 ("-wtmode", Arg.Set
wtmode, " Operate in wt mode");
6377 ("-cxack", Arg.Set
cxack, " Cut corners");
6379 ("-remote", Arg.String
(fun s -> rcmdpath := s),
6380 "<path> Set path to the remote commands source");
6382 ("-origin", Arg.String
(fun s -> state
.origin
<- s),
6383 "<original-path> Set original path");
6385 ("-gc", Arg.Set_string
gcconfig,
6386 "<script-path> Collect garbage with the help of a script");
6388 ("-nofc", Arg.Set
nofc, " Do not use fontconfig");
6390 ("-v", Arg.Unit
(fun () ->
6392 "%s\nconfiguration path: %s\n"
6396 exit
0), " Print version and exit");
6398 ("-embed", Arg.Set_int
rootwid,
6399 "<window-id> Embed into window")
6402 (fun s -> state
.path <- s)
6403 ("Usage: " ^
Sys.argv
.(0) ^
" [options] some.pdf\nOptions:")
6406 then selfexec := !selfexec ^
" -wtmode";
6408 let histmode = emptystr state
.path && not
!openlast in
6410 if not
(Config.load !openlast)
6411 then prerr_endline
"failed to load configuration";
6412 begin match !pageno with
6413 | Some
pageno -> state
.anchor <- (pageno, 0.0, 0.0)
6417 if nonemptystr
!gcconfig
6420 match Unix.socketpair
Unix.PF_UNIX
Unix.SOCK_STREAM
0 with
6422 error
"gc socketpair failed: %s" (exntos exn
)
6425 match addpid
@@ popen
!gcconfig [(c, 0); (c, 1)] with
6427 error
"failed to popen gc script: %s" (exntos exn
);
6433 let wsfd, winw, winh
= Wsi.init
(object (self)
6434 val mutable m_clicks
= 0
6435 val mutable m_click_x
= 0
6436 val mutable m_click_y
= 0
6437 val mutable m_lastclicktime
= infinity
6439 method private cleanup =
6440 state
.roam
<- noroam
;
6441 Hashtbl.iter
(fun _ opaque -> clearmark
opaque) state
.pagemap
6442 method expose
= G.postRedisplay"expose"
6446 | Wsi.Unobscured
-> "unobscured"
6447 | Wsi.PartiallyObscured
-> "partiallyobscured"
6448 | Wsi.FullyObscured
-> "fullyobscured"
6450 vlog "visibility change %s" name
6451 method display = display ()
6452 method map mapped
= vlog "mappped %b" mapped
6453 method reshape w h =
6456 method mouse
b d x y m =
6457 if d && canselect ()
6459 (* http://blogs.msdn.com/b/oldnewthing/archive/2004/10/18/243925.aspx *)
6465 if abs
x - m_click_x
> 10
6466 || abs
y - m_click_y
> 10
6467 || abs_float
(t -. m_lastclicktime
) > 0.3
6469 m_clicks
<- m_clicks
+ 1;
6470 m_lastclicktime
<- t;
6474 G.postRedisplay "cleanup";
6475 state
.uioh <- state
.uioh#button
b d x y m;
6477 else state
.uioh <- state
.uioh#multiclick m_clicks
x y m
6482 m_lastclicktime
<- infinity
;
6483 state
.uioh <- state
.uioh#button
b d x y m
6487 state
.uioh <- state
.uioh#button
b d x y m
6490 state
.mpos
<- (x, y);
6491 state
.uioh <- state
.uioh#motion
x y
6492 method pmotion
x y =
6493 state
.mpos
<- (x, y);
6494 state
.uioh <- state
.uioh#pmotion
x y
6496 let mascm = m land (
6497 Wsi.altmask
+ Wsi.shiftmask
+ Wsi.ctrlmask
+ Wsi.metamask
6500 let x = state
.x and y = state
.y in
6502 if x != state
.x || y != state
.y then self#
cleanup
6504 match state
.keystate
with
6506 let km = k
, mascm in
6509 let modehash = state
.uioh#
modehash in
6510 try Hashtbl.find modehash km
6512 try Hashtbl.find (findkeyhash conf
"global") km
6513 with Not_found
-> KMinsrt
(k
, m)
6515 | KMinsrt
(k
, m) -> keyboard k
m
6516 | KMinsrl
l -> List.iter
(fun (k
, m) -> keyboard k
m) l
6517 | KMmulti
(l, r
) -> state
.keystate
<- KSinto
(l, r
)
6519 | KSinto
((k'
, m'
) :: [], insrt
) when k'
=k
&& m'
land mascm = m'
->
6520 List.iter
(fun (k
, m) -> keyboard k
m) insrt
;
6521 state
.keystate
<- KSnone
6522 | KSinto
((k'
, m'
) :: keys, insrt
) when k'
=k
&& m'
land mascm = m'
->
6523 state
.keystate
<- KSinto
(keys, insrt
)
6524 | KSinto
_ -> state
.keystate
<- KSnone
6527 state
.mpos
<- (x, y);
6528 state
.uioh <- state
.uioh#pmotion
x y
6529 method leave = state
.mpos
<- (-1, -1)
6530 method winstate wsl
= state
.winstate
<- wsl
6531 method quit
= raise Quit
6532 end) !rootwid conf
.cwinw conf
.cwinh platform
in
6537 List.exists
GlMisc.check_extension
6538 [ "GL_ARB_texture_rectangle"
6539 ; "GL_EXT_texture_recangle"
6540 ; "GL_NV_texture_rectangle" ]
6542 then (prerr_endline
"OpenGL does not suppport rectangular textures"; exit
1);
6545 let r = GlMisc.get_string `renderer
in
6546 let p = "Mesa DRI Intel(" in
6547 let l = String.length
p in
6548 String.length
r > l && String.sub
r 0 l = p
6551 defconf
.sliceheight
<- 1024;
6552 defconf
.texcount
<- 32;
6553 defconf
.usepbo
<- true;
6557 match Unix.socketpair
Unix.PF_UNIX
Unix.SOCK_STREAM
0 with
6559 dolog
"socketpair failed: %s" (exntos exn
);
6567 setcheckers conf
.checkers
;
6569 if conf
.redirectstderr
6573 (Buffer.to_bytes state
.errmsgs
)
6574 (match state
.errfd
with
6576 let s = Bytes.create
(80*24) in
6579 let r, _, _ = Unix.select
[fd
] [] [] 0.0 in
6581 then Unix.read fd
s 0 (Bytes.length
s)
6587 else Bytes.sub
s 0 n
6591 try ignore
(Unix.write state
.stderr
s 0 (Bytes.length
s))
6592 with exn
-> print_endline
(exntos exn
)
6597 conf
.angle
, conf
.fitmodel
, (conf
.trimmargins
, conf
.trimfuzz
),
6598 conf
.texcount
, conf
.sliceheight
, conf
.mustoresize
, conf
.colorspace
,
6599 !Config.fontpath
, !trimcachepath,
6600 GlMisc.check_extension
"GL_ARB_pixel_buffer_object",
6603 List.iter
GlArray.enable
[`texture_coord
; `vertex
];
6605 reshape ~firsttime
:true winw winh
;
6609 Wsi.settitle
"llpp (history)";
6613 state
.text <- "Opening " ^
(mbtoutf8 state
.path);
6614 opendoc state
.path state
.password;
6618 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
6619 Sys.set_signal
Sys.sighup
(Sys.Signal_handle
(fun _ -> reload ()));
6622 match Unix.waitpid
[Unix.WNOHANG
] ~
-1 with
6623 | (exception (Unix.Unix_error
(Unix.ECHILD
, _, _))) -> ()
6624 | (exception exn
) -> dolog
"Unix.waitpid: %s" @@ exntos exn
6626 | _pid
, _status
-> reap ()
6628 Sys.set_signal
Sys.sigchld
(Sys.Signal_handle
(fun _ -> doreap := true));
6632 if nonemptystr
!rcmdpath
6633 then remoteopen !rcmdpath
6638 let rec loop deadline
=
6645 match state
.errfd
with
6646 | None
-> [state
.ss; state
.wsfd]
6647 | Some fd
-> [state
.ss; state
.wsfd; fd
]
6652 | Some fd
-> fd
:: r
6656 state
.redisplay
<- false;
6663 if deadline
= infinity
6665 else max
0.0 (deadline
-. now)
6670 try Unix.select
r [] [] timeout
6671 with Unix.Unix_error
(Unix.EINTR
, _, _) -> [], [], []
6677 if state
.ghyll
== noghyll
6679 match state
.autoscroll
with
6680 | Some step
when step
!= 0 ->
6681 let y = state
.y + step
in
6685 else if y >= state
.maxy then 0 else y
6688 if state
.mode = View
6689 then state
.text <- E.s;
6692 else deadline
+. 0.01
6697 let rec checkfds = function
6699 | fd
:: rest
when fd
= state
.ss ->
6700 let cmd = readcmd state
.ss in
6704 | fd
:: rest
when fd
= state
.wsfd ->
6708 | fd
:: rest
when Some fd
= !optrfd ->
6709 begin match remote fd
with
6710 | None
-> optrfd := remoteopen !rcmdpath;
6711 | opt -> optrfd := opt
6716 let s = Bytes.create
80 in
6717 let n = tempfailureretry
(Unix.read fd
s 0) 80 in
6718 if conf
.redirectstderr
6720 Buffer.add_subbytes state
.errmsgs
s 0 n;
6721 state
.newerrmsgs
<- true;
6722 state
.redisplay
<- true;
6725 prerr_string
@@ Bytes.sub_string
s 0 n;
6733 if deadline
= infinity
6737 match state
.autoscroll
with
6738 | Some step
when step
!= 0 -> deadline1
6739 | _ -> if state
.ghyll
== noghyll
then infinity
else deadline1
6747 Config.save leavebirdseye;
6748 if hasunsavedchanges
()