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 let reopt = try Some
(Str.regexp_case_fold
pattern) with _ -> None
in
4549 let rec loop accu minfo n =
4552 m_items
<- Array.of_list
accu;
4553 m_minfo
<- Array.of_list
minfo;
4556 let (s, _, t
) as o = m_items
.(n) in
4559 | Oaction
_ | Oreaction
_ -> o :: accu, (0, 0) :: minfo
4560 | Onone
| Oanchor
_ | Ouri
_ | Olaunch
_
4561 | Oremote
_ | Oremotedest
_ | Ohistory
_ ->
4563 try Str.search_forward
re s 0
4564 with Not_found
-> -1
4567 then o :: accu, (first, Str.match_end
()) :: minfo
4570 loop accu minfo (n-1)
4572 loop [] [] (Array.length m_items
- 1)
4574 method! getminfo
= m_minfo
4578 match sourcetype
with
4579 | `bookmarks
-> Array.of_list state
.bookmarks
4580 | `outlines
-> state
.outlines
4581 | `history
-> genhistoutlines ()
4583 m_minfo
<- m_orig_minfo
;
4584 m_items
<- m_orig_items
4587 if sourcetype
= `bookmarks
4589 if m >= 0 && m < Array.length m_items
4591 m_hadremovals
<- true;
4592 m_items
<- Array.init
(Array.length m_items
- 1) (fun n ->
4593 let n = if n >= m then n+1 else n in
4598 method add_narrow_pattern
pattern =
4599 m_narrow_patterns
<- pattern :: m_narrow_patterns
4601 method del_narrow_pattern
=
4602 match m_narrow_patterns
with
4603 | _ :: rest
-> m_narrow_patterns
<- rest
4608 match m_narrow_patterns
with
4609 | pattern :: [] -> self#narrow
pattern; pattern
4611 List.fold_left
(fun accu pattern ->
4612 self#narrow
pattern;
4613 pattern ^
"@Uellipsis" ^
accu) E.s list
4615 method calcactive
anchor =
4616 let rely = getanchory anchor in
4617 let rec loop n best bestd
=
4618 if n = Array.length m_items
4621 let _, _, kind
= m_items
.(n) in
4624 let orely = getanchory anchor in
4625 let d = abs
(orely - rely) in
4628 else loop (n+1) best bestd
4629 | Onone
| Oremote
_ | Olaunch
_
4630 | Oremotedest
_ | Ouri
_ | Ohistory
_ | Oaction
_ | Oreaction
_ ->
4631 loop (n+1) best bestd
4635 method reset
anchor items =
4636 m_hadremovals
<- false;
4637 if state
.gen
!= m_gen
4639 m_orig_items
<- items;
4641 m_narrow_patterns
<- [];
4643 m_orig_minfo
<- E.a;
4647 if items != m_orig_items
4649 m_orig_items
<- items;
4650 if m_narrow_patterns
== []
4651 then m_items
<- items;
4654 let active = self#calcactive
anchor in
4656 m_first
<- firstof m_first
active
4660 let enteroutlinemode, enterbookmarkmode
, enterhistmode
=
4661 let mkselector sourcetype
=
4662 let source = outlinesource sourcetype
in
4665 match sourcetype
with
4666 | `bookmarks
-> Array.of_list state
.bookmarks
4667 | `
outlines -> state
.outlines
4668 | `history
-> genhistoutlines ()
4670 if Array.length
outlines = 0
4672 showtext ' ' errmsg
;
4676 state
.text <- source#greetmsg
;
4677 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
4678 let anchor = getanchor
() in
4679 source#reset
anchor outlines;
4681 coe (new outlinelistview ~zebra
:(sourcetype
=`history
) ~
source);
4682 G.postRedisplay "enter selector";
4685 let mkenter sourcetype errmsg
=
4686 let enter = mkselector sourcetype
in
4687 fun () -> enter errmsg
4689 (**)mkenter `
outlines "Document has no outline"
4690 , mkenter `bookmarks
"Document has no bookmarks (yet)"
4691 , mkenter `history
"History is empty"
4694 let quickbookmark ?title
() =
4695 match state
.layout with
4701 let tm = Unix.localtime
(now
()) in
4703 "Quick (page %d) (bookmarked at %02d/%02d/%d %02d:%02d)"
4707 (tm.Unix.tm_year
+ 1900)
4710 | Some
title -> title
4712 state
.bookmarks
<- (title, 0, Oanchor
(getanchor1
l)) :: state
.bookmarks
4715 let setautoscrollspeed step goingdown
=
4716 let incr = max
1 ((abs step
) / 2) in
4717 let incr = if goingdown
then incr else -incr in
4718 let astep = boundastep state
.winh
(step
+ incr) in
4719 state
.autoscroll
<- Some
astep;
4723 match conf
.columns
with
4725 | Csingle
_ | Cmulti
_ -> state
.x != 0 || conf
.zoom > 1.0
4728 let panbound x = bound
x (-state
.w) (wadjsb () + state
.winw
);;
4730 let existsinrow pageno (columns
, coverA
, coverB
) p =
4731 let last = ((pageno - coverA
) mod columns
) + columns
in
4732 let rec any = function
4735 if l.pageno = coverA
- 1 || l.pageno = state
.pagecount
- coverB
4739 then (if l.pageno = last then false else any rest
)
4747 match state
.layout with
4749 let pageno = page_of_y state
.y in
4750 gotoghyll (getpagey
(pageno+1))
4752 match conf
.columns
with
4754 if conf
.presentation
&& rest
== [] && l.pageh
> l.pagey + l.pagevh
4756 let y = clamp (pgscale state
.winh
) in
4759 let pageno = min
(l.pageno+1) (state
.pagecount
-1) in
4760 gotoghyll (getpagey
pageno)
4761 | Cmulti
((c, _, _) as cl, _) ->
4762 if conf
.presentation
4763 && (existsinrow l.pageno cl
4764 (fun l -> l.pageh
> l.pagey + l.pagevh))
4766 let y = clamp (pgscale state
.winh
) in
4769 let pageno = min
(l.pageno+c) (state
.pagecount
-1) in
4770 gotoghyll (getpagey
pageno)
4772 if l.pageno < state
.pagecount
- 1 || l.pagecol
< n - 1
4774 let pagey, pageh
= getpageyh
l.pageno in
4775 let pagey = pagey + pageh
* l.pagecol
in
4776 let ips = if l.pagecol
= 0 then 0 else conf
.interpagespace
in
4777 gotoghyll (pagey + pageh
+ ips)
4781 match state
.layout with
4783 let pageno = page_of_y state
.y in
4784 gotoghyll (getpagey
(pageno-1))
4786 match conf
.columns
with
4788 if conf
.presentation
&& l.pagey != 0
4790 gotoghyll (clamp (pgscale ~
-(state
.winh
)))
4792 let pageno = max
0 (l.pageno-1) in
4793 gotoghyll (getpagey
pageno)
4794 | Cmulti
((c, _, coverB
) as cl, _) ->
4795 if conf
.presentation
&&
4796 (existsinrow l.pageno cl (fun l -> l.pagey != 0))
4798 gotoghyll (clamp (pgscale ~
-(state
.winh
)))
4801 if l.pageno = state
.pagecount
- coverB
4805 let pageno = max
0 (l.pageno-decr) in
4806 gotoghyll (getpagey
pageno)
4814 let pageno = max
0 (l.pageno-1) in
4815 let pagey, pageh
= getpageyh
pageno in
4818 let pagey, pageh
= getpageyh
l.pageno in
4819 pagey + pageh
* (l.pagecol
-1) - conf
.interpagespace
4825 if emptystr conf
.savecmd
4826 then error
"don't know where to save modified document"
4828 let savecmd = Str.global_replace percentsre state
.path conf
.savecmd in
4831 (fun s -> error
"failed to obtain path to the saved copy: %s" s)
4836 let tmp = path ^
".tmp" in
4838 Unix.rename
tmp path;
4841 let viewkeyboard key mask
=
4843 let mode = state
.mode in
4844 state
.mode <- Textentry
(te, fun _ -> state
.mode <- mode);
4847 G.postRedisplay "view:enttext"
4849 let ctrl = Wsi.withctrl mask
in
4851 if key >= 0xffb0 && key < 0xffb9 then key - 0xffb0 + 48 else key
4857 if hasunsavedchanges
()
4861 if conf
.angle
mod 360 = 0 && not
(isbirdseye state
.mode)
4863 state
.mode <- LinkNav
(Ltgendir
0);
4866 else showtext '
!'
"Keyboard link navigation does not work under rotation"
4869 begin match state
.mstate
with
4872 G.postRedisplay "kill rect";
4875 | Mscrolly
| Mscrollx
4878 begin match state
.mode with
4881 G.postRedisplay "esc leave linknav"
4885 match state
.ranchors
with
4887 | (path, password, anchor, origin
) :: rest
->
4888 state
.ranchors
<- rest
;
4889 state
.anchor <- anchor;
4890 state
.origin
<- origin
;
4891 state
.nameddest
<- E.s;
4892 opendoc path password
4897 gotoghyll (getnav ~
-1)
4908 Hashtbl.iter
(fun _ opaque -> clearmark
opaque) state
.pagemap
;
4909 G.postRedisplay "dehighlight";
4911 | @slash
| @question
->
4912 let ondone isforw
s =
4913 cbput state
.hists
.pat
s;
4914 state
.searchpattern
<- s;
4917 let s = String.make
1 (Char.chr
key) in
4918 enttext (s, E.s, Some
(onhist state
.hists
.pat
),
4919 textentry, ondone (key = @slash
), true)
4921 | @plus
| @kpplus
| @equals
when ctrl ->
4922 let incr = if conf
.zoom +. 0.01 > 0.1 then 0.1 else 0.01 in
4923 setzoom (conf
.zoom +. incr)
4925 | @plus
| @kpplus
->
4928 try int_of_string
s with exc
->
4929 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
);
4935 state
.text <- "page bias is now " ^ string_of_int
n;
4938 enttext ("page bias: ", E.s, None
, intentry, ondone, true)
4940 | @minus
| @kpminus
when ctrl ->
4941 let decr = if conf
.zoom -. 0.1 < 0.1 then 0.01 else 0.1 in
4942 setzoom (max
0.01 (conf
.zoom -. decr))
4944 | @minus
| @kpminus
->
4945 let ondone msg
= state
.text <- msg
in
4947 "option [acfhilpstvxACFPRSZTISM]: ", E.s, None
,
4948 optentry state
.mode, ondone, true
4959 | (@1 | @2) when ctrl && conf
.fitmodel
!= FitPage
-> (* ctrl-1/2 *)
4961 match conf
.columns
with
4962 | Csingle
_ | Cmulti
_ -> 1
4963 | Csplit
(n, _) -> n
4965 let h = state
.winh
-
4966 conf
.interpagespace
lsl (if conf
.presentation
then 1 else 0)
4968 let zoom = zoomforh state
.winw
h (vscrollw ()) cols in
4969 if zoom > 0.0 && (key = 50 || zoom < 1.0)
4974 match conf
.fitmodel
with
4975 | FitWidth
-> FitProportional
4976 | FitProportional
-> FitPage
4977 | FitPage
-> FitWidth
4979 state
.text <- "fit model: " ^
FMTE.to_string
fm;
4980 reqlayout conf
.angle
fm
4988 | (48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57)
4989 when not
ctrl -> (* 0..9 *)
4992 try int_of_string
s with exc
->
4993 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
);
4999 cbput state
.hists
.pag
(string_of_int
n);
5000 gotopage1 (n + conf
.pagebias
- 1) 0;
5003 let pageentry text key =
5004 match Char.unsafe_chr
key with
5005 | '
g'
-> TEdone
text
5006 | _ -> intentry text key
5008 let text = String.make
1 (Char.chr
key) in
5009 enttext (":", text, Some
(onhist state
.hists
.pag
),
5010 pageentry, ondone, true)
5013 conf
.scrollb
<- if conf
.scrollb
= 0 then (scrollbvv
lor scrollbhv
) else 0;
5014 reshape state
.winw state
.winh
;
5017 state
.bzoom
<- not state
.bzoom
;
5019 showtext ' '
("block zoom " ^
if state
.bzoom
then "on" else "off")
5022 conf
.hlinks
<- not conf
.hlinks
;
5023 state
.text <- "highlightlinks " ^
if conf
.hlinks
then "on" else "off";
5024 G.postRedisplay "toggle highlightlinks";
5027 state
.glinks
<- true;
5028 let mode = state
.mode in
5029 state
.mode <- Textentry
(
5030 (":", E.s, None
, linknentry, linknact gotounder, false),
5032 state
.glinks
<- false;
5036 G.postRedisplay "view:linkent(F)"
5039 state
.glinks
<- true;
5040 let mode = state
.mode in
5041 state
.mode <- Textentry
(
5043 ":", E.s, None
, linknentry, linknact (fun under ->
5044 selstring (undertext under);
5048 state
.glinks
<- false;
5052 G.postRedisplay "view:linkent"
5055 begin match state
.autoscroll
with
5057 conf
.autoscrollstep
<- step
;
5058 state
.autoscroll
<- None
5060 if conf
.autoscrollstep
= 0
5061 then state
.autoscroll
<- Some
1
5062 else state
.autoscroll
<- Some conf
.autoscrollstep
5069 setpresentationmode (not conf
.presentation
);
5070 showtext ' '
("presentation mode " ^
5071 if conf
.presentation
then "on" else "off");
5074 if List.mem
Wsi.Fullscreen state
.winstate
5075 then Wsi.reshape conf
.cwinw conf
.cwinh
5076 else Wsi.fullscreen
()
5079 search state
.searchpattern
false
5082 search state
.searchpattern
true
5085 begin match state
.layout with
5088 gotoghyll (getpagey
l.pageno)
5094 | @delete
| @kpdelete
-> (* delete *)
5098 showtext ' '
(describe_location ());
5101 begin match state
.layout with
5104 Wsi.reshape (l.pagew
+ vscrollw ()) l.pageh
;
5109 enterbookmarkmode
()
5117 | @e when Buffer.length state
.errmsgs
> 0 ->
5122 match state
.layout with
5127 (s, 0, Oanchor
(getanchor1
l)) :: state
.bookmarks
5130 enttext ("bookmark: ", E.s, None
, textentry, ondone, true)
5134 showtext ' '
"Quick bookmark added";
5137 begin match state
.layout with
5139 let rect = getpdimrect
l.pagedimno
in
5143 (truncate
(1.8 *. (rect.(1) -. rect.(0))),
5144 truncate
(1.2 *. (rect.(3) -. rect.(0))))
5146 (truncate
(rect.(1) -. rect.(0)),
5147 truncate
(rect.(3) -. rect.(0)))
5149 let w = truncate
((float w)*.conf
.zoom)
5150 and h = truncate
((float h)*.conf
.zoom) in
5153 state
.anchor <- getanchor
();
5154 Wsi.reshape (w + vscrollw ()) (h + conf
.interpagespace
)
5156 G.postRedisplay "z";
5161 | @x -> state
.roam
()
5164 reqlayout (conf
.angle
+
5165 (if key = @Gt
then 30 else -30)) conf
.fitmodel
5169 bound
(conf
.colorscale
+. (if key = 93 then 0.1 else -0.1)) 0.0 1.0
5171 G.postRedisplay "brightness";
5173 | @c when state
.mode = View
->
5178 let m = (wadjsb () + state
.winw
- state
.w) / 2 in
5180 gotoy_and_clear_text state
.y
5184 match state
.prevcolumns
with
5185 | None
-> (1, 0, 0), 1.0
5186 | Some
(columns
, z
) ->
5189 | Csplit
(c, _) -> -c, 0, 0
5190 | Cmulti
((c, a, b), _) -> c, a, b
5191 | Csingle
_ -> 1, 0, 0
5195 setcolumns View
c a b;
5198 | @down
| @up
when ctrl && Wsi.withshift mask
->
5199 let zoom, x = state
.prevzoom
in
5203 | @k
| @up
| @kpup
->
5204 begin match state
.autoscroll
with
5206 begin match state
.mode with
5207 | Birdseye beye
-> upbirdseye 1 beye
5212 then gotoy_and_clear_text (clamp ~
-(state
.winh
/2))
5214 if not
(Wsi.withshift mask
) && conf
.presentation
5216 else gotoghyll1 true (clamp (-conf
.scrollstep
))
5220 setautoscrollspeed n false
5223 | @j
| @down
| @kpdown
->
5224 begin match state
.autoscroll
with
5226 begin match state
.mode with
5227 | Birdseye beye
-> downbirdseye 1 beye
5232 then gotoy_and_clear_text (clamp (state
.winh
/2))
5234 if not
(Wsi.withshift mask
) && conf
.presentation
5236 else gotoghyll1 true (clamp (conf
.scrollstep
))
5240 setautoscrollspeed n true
5243 | @left | @right
| @kpleft
| @kpright
when not
(Wsi.withalt mask
) ->
5249 else conf
.hscrollstep
5251 let dx = if key = @left || key = @kpleft
then dx else -dx in
5252 state
.x <- panbound (state
.x + dx);
5253 gotoy_and_clear_text state
.y
5256 G.postRedisplay "left/right"
5259 | @prior
| @kpprior
->
5263 match state
.layout with
5265 | l :: _ -> state
.y - l.pagey
5267 clamp (pgscale (-state
.winh
))
5271 | @next | @kpnext
->
5275 match List.rev state
.layout with
5277 | l :: _ -> getpagey
l.pageno
5279 clamp (pgscale state
.winh
)
5283 | @g | @home
| @kphome
->
5286 | @G
| @jend
| @kpend
->
5288 gotoghyll (clamp state
.maxy)
5290 | @right
| @kpright
when Wsi.withalt mask
->
5291 gotoghyll (getnav 1)
5292 | @left | @kpleft
when Wsi.withalt mask
->
5293 gotoghyll (getnav ~
-1)
5298 | @v when conf
.debug
->
5301 match getopaque l.pageno with
5304 let x0, y0, x1, y1 = pagebbox
opaque in
5305 let a,b = float x0, float y0 in
5306 let c,d = float x1, float y0 in
5307 let e,f = float x1, float y1 in
5308 let h,j
= float x0, float y1 in
5309 let rect = (a,b,c,d,e,f,h,j
) in
5311 state
.rects
<- (l.pageno, l.pageno mod 3, rect) :: state
.rects
;
5313 G.postRedisplay "v";
5316 let mode = state
.mode in
5317 let cmd = ref E.s in
5318 let onleave = function
5319 | Cancel
-> state
.mode <- mode
5322 match getopaque l.pageno with
5323 | Some
opaque -> pipesel opaque !cmd
5324 | None
-> ()) state
.layout;
5328 cbput state
.hists
.sel
s;
5332 "| ", !cmd, Some
(onhist state
.hists
.sel
), textentry, ondone, true
5334 G.postRedisplay "|";
5335 state
.mode <- Textentry
(te, onleave);
5338 vlog "huh? %s" (Wsi.keyname
key)
5341 let linknavkeyboard key mask
linknav =
5342 let getpage pageno =
5343 let rec loop = function
5345 | l :: _ when l.pageno = pageno -> Some
l
5346 | _ :: rest
-> loop rest
5347 in loop state
.layout
5349 let doexact (pageno, n) =
5350 match getopaque pageno, getpage pageno with
5351 | Some
opaque, Some
l ->
5352 if key = @enter || key = @kpenter
5354 let under = getlink
opaque n in
5355 G.postRedisplay "link gotounder";
5362 Some
(findlink
opaque LDfirst
), -1
5365 Some
(findlink
opaque LDlast
), 1
5368 Some
(findlink
opaque (LDleft
n)), -1
5371 Some
(findlink
opaque (LDright
n)), 1
5374 Some
(findlink
opaque (LDup
n)), -1
5377 Some
(findlink
opaque (LDdown
n)), 1
5382 begin match findpwl
l.pageno dir with
5386 state
.mode <- LinkNav
(Ltgendir
dir);
5387 let y, h = getpageyh
pageno in
5390 then y + h - state
.winh
5395 begin match getopaque pageno, getpage pageno with
5396 | Some
opaque, Some
_ ->
5398 let ld = if dir > 0 then LDfirst
else LDlast
in
5401 begin match link with
5403 showlinktype (getlink
opaque m);
5404 state
.mode <- LinkNav
(Ltexact
(pageno, m));
5405 G.postRedisplay "linknav jpage";
5406 | Lnotfound
-> notfound dir
5412 begin match opt with
5413 | Some Lnotfound
-> pwl l dir;
5414 | Some
(Lfound
m) ->
5418 let _, y0, _, y1 = getlinkrect
opaque m in
5420 then gotopage1 l.pageno y0
5422 let d = fstate
.fontsize
+ 1 in
5423 if y1 - l.pagey > l.pagevh - d
5424 then gotopage1 l.pageno (y1 - state
.winh
- hscrollh () + d)
5425 else G.postRedisplay "linknav";
5427 showlinktype (getlink
opaque m);
5428 state
.mode <- LinkNav
(Ltexact
(l.pageno, m));
5431 | None
-> viewkeyboard key mask
5433 | _ -> viewkeyboard key mask
5438 G.postRedisplay "leave linknav"
5442 | Ltgendir
_ | Ltnotready
_ -> viewkeyboard key mask
5443 | Ltexact exact
-> doexact exact
5446 let keyboard key mask
=
5447 if (key = 103 && Wsi.withctrl mask
) && not
(istextentry state
.mode)
5448 then wcmd "interrupt"
5449 else state
.uioh <- state
.uioh#
key key mask
5452 let birdseyekeyboard key mask
5453 ((oconf
, leftx
, pageno, hooverpageno
, anchor) as beye
) =
5455 match conf
.columns
with
5457 | Cmulti
((c, _, _), _) -> c
5458 | Csplit
_ -> failwith
"bird's eye split mode"
5460 let pgh layout = List.fold_left
5461 (fun m l -> max
l.pageh
m) state
.winh
layout in
5463 | @l when Wsi.withctrl mask
->
5464 let y, h = getpageyh
pageno in
5465 let top = (state
.winh
- h) / 2 in
5466 gotoy (max
0 (y - top))
5467 | @enter | @kpenter
-> leavebirdseye beye
false
5468 | @escape
-> leavebirdseye beye
true
5469 | @up
-> upbirdseye incr beye
5470 | @down
-> downbirdseye incr beye
5471 | @left -> upbirdseye 1 beye
5472 | @right
-> downbirdseye 1 beye
5475 begin match state
.layout with
5479 state
.mode <- Birdseye
(
5480 oconf
, leftx
, l.pageno, hooverpageno
, anchor
5482 gotopage1 l.pageno 0;
5485 let layout = layout (state
.y-state
.winh
) (pgh state
.layout) in
5487 | [] -> gotoy (clamp (-state
.winh
))
5489 state
.mode <- Birdseye
(
5490 oconf
, leftx
, l.pageno, hooverpageno
, anchor
5492 gotopage1 l.pageno 0
5495 | [] -> gotoy (clamp (-state
.winh
))
5499 begin match List.rev state
.layout with
5501 let layout = layout (state
.y + (pgh state
.layout)) state
.winh
in
5502 begin match layout with
5504 let incr = l.pageh
- l.pagevh in
5509 oconf
, leftx
, state
.pagecount
- 1, hooverpageno
, anchor
5511 G.postRedisplay "birdseye pagedown";
5513 else gotoy (clamp (incr + conf
.interpagespace
*2));
5517 Birdseye
(oconf
, leftx
, l.pageno, hooverpageno
, anchor);
5518 gotopage1 l.pageno 0;
5521 | [] -> gotoy (clamp state
.winh
)
5525 state
.mode <- Birdseye
(oconf
, leftx
, 0, hooverpageno
, anchor);
5529 let pageno = state
.pagecount
- 1 in
5530 state
.mode <- Birdseye
(oconf
, leftx
, pageno, hooverpageno
, anchor);
5531 if not
(pagevisible state
.layout pageno)
5534 match List.rev state
.pdims
with
5536 | (_, _, h, _) :: _ -> h
5538 gotoy (max
0 (getpagey
pageno - (state
.winh
- h - conf
.interpagespace
)))
5539 else G.postRedisplay "birdseye end";
5541 | _ -> viewkeyboard key mask
5546 match state
.mode with
5547 | Textentry
_ -> scalecolor 0.4
5549 | View
-> scalecolor 1.0
5550 | Birdseye
(_, _, pageno, hooverpageno
, _) ->
5551 if l.pageno = hooverpageno
5554 if l.pageno = pageno
5556 let c = scalecolor 1.0 in
5558 GlDraw.line_width
3.0;
5559 let dispx = xadjsb () + l.pagedispx in
5561 (float (dispx-1)) (float (l.pagedispy-1))
5562 (float (dispx+l.pagevw+1))
5563 (float (l.pagedispy+l.pagevh+1))
5565 GlDraw.line_width
1.0;
5574 let postdrawpage l linkindexbase
=
5575 match getopaque l.pageno with
5577 if tileready l l.pagex
l.pagey
5579 let x = l.pagedispx - l.pagex
+ xadjsb ()
5580 and y = l.pagedispy - l.pagey in
5582 match conf
.columns
with
5583 | Csingle
_ | Cmulti
_ ->
5584 (if conf
.hlinks
then 1 else 0)
5586 && not
(isbirdseye state
.mode) then 2 else 0)
5590 match state
.mode with
5591 | Textentry
((_, s, _, _, _, _), _) when state
.glinks
-> s
5597 postprocess
opaque hlmask x y (linkindexbase
, s, conf
.hfsize
);
5602 let scrollindicator () =
5603 let sbw, ph
, sh = state
.uioh#
scrollph in
5604 let sbh, pw, sw = state
.uioh#scrollpw
in
5609 else ((state
.winw
- sbw), state
.winw
, 0)
5612 GlDraw.color (0.64, 0.64, 0.64);
5613 filledrect (float x0) 0. (float x1) (float state
.winh
);
5615 (float hx0
) (float (state
.winh
- sbh))
5616 (float (hx0
+ wadjsb () + state
.winw
)) (float state
.winh
)
5618 GlDraw.color (0.0, 0.0, 0.0);
5620 filledrect (float x0) ph
(float x1) (ph
+. sh);
5621 let pw = pw +. float hx0
in
5622 filledrect pw (float (state
.winh
- sbh)) (pw +. sw) (float state
.winh
);
5626 match state
.mstate
with
5627 | Mnone
| Mscrolly
| Mscrollx
| Mpan
_ | Mzoom
_ | Mzoomrect
_ ->
5630 | Msel
((x0, y0), (x1, y1)) ->
5631 let identify opaque l px py = Some
(opaque, l.pageno, px, py) in
5632 let o0,n0
,px0
,py0
= onppundermouse identify x0 y0 (~
< E.s, -1, 0, 0) in
5633 let _o1,n1
,px1
,py1
= onppundermouse identify x1 y1 (~
< E.s, -1, 0, 0) in
5634 if n0
!= -1 && n0
= n1
then seltext
o0 (px0
, py0
, px1
, py1
);
5637 let showrects = function [] -> () | rects
->
5639 GlDraw.color (0.0, 0.0, 1.0) ~
alpha:0.5;
5640 GlFunc.blend_func ~
src:`src_alpha ~dst
:`one_minus_src_alpha
;
5642 (fun (pageno, c, (x0, y0, x1, y1, x2
, y2
, x3
, y3
)) ->
5644 if l.pageno = pageno
5646 let dx = float (l.pagedispx - l.pagex
) in
5647 let dy = float (l.pagedispy - l.pagey) in
5648 GlDraw.color (0.0, 0.0, 1.0 /. float c) ~
alpha:0.5;
5649 Raw.sets_float state
.vraw ~
pos:0
5654 GlArray.vertex `two state
.vraw
;
5655 GlArray.draw_arrays `triangle_strip ~
first:0 ~count
:4;
5664 GlClear.color (scalecolor2 conf
.bgcolor
);
5665 GlClear.clear
[`
color];
5666 List.iter
drawpage state
.layout;
5668 match state
.mode with
5669 | LinkNav
(Ltexact
(pageno, linkno
)) ->
5670 begin match getopaque pageno with
5672 let dx = xadjsb () in
5673 let x0, y0, x1, y1 = getlinkrect
opaque linkno
in
5674 let x0 = x0 + dx and x1 = x1 + dx in
5681 | None
-> state
.rects
5683 | LinkNav
(Ltgendir
_) | LinkNav
(Ltnotready
_)
5686 | View
-> state
.rects
5689 let rec postloop linkindexbase
= function
5691 let linkindexbase = linkindexbase + postdrawpage l linkindexbase in
5692 postloop linkindexbase rest
5696 postloop 0 state
.layout;
5698 begin match state
.mstate
with
5699 | Mzoomrect
((x0, y0), (x1, y1)) ->
5701 GlDraw.color (0.3, 0.3, 0.3) ~
alpha:0.5;
5702 GlFunc.blend_func ~
src:`src_alpha ~dst
:`one_minus_src_alpha
;
5703 filledrect (float x0) (float y0) (float x1) (float y1);
5707 | Mscrolly
| Mscrollx
5716 let zoomrect x y x1 y1 =
5719 and y0 = min
y y1 in
5720 gotoy (state
.y + y0);
5721 state
.anchor <- getanchor
();
5722 let zoom = (float state
.w) /. float (x1 - x0) in
5725 let adjw = wadjsb () + state
.winw
in
5727 then (adjw - state
.w) / 2
5730 match conf
.fitmodel
with
5731 | FitWidth
| FitProportional
-> simple ()
5733 match conf
.columns
with
5735 onppundermouse (fun _ l _ _ -> Some
l.pagedispx) x0 y0 x0
5736 | Cmulti
_ | Csingle
_ -> simple ()
5738 state
.x <- (state
.x + margin) - x0;
5743 let annot inline
x y =
5744 match unproject x y with
5745 | Some
(opaque, n, ux
, uy
) ->
5747 addannot
opaque ux uy
text;
5748 wcmd "freepage %s" (~
> opaque);
5749 Hashtbl.remove state
.pagemap
(n, state
.gen
);
5755 let ondone s = add s in
5756 let mode = state
.mode in
5757 state
.mode <- Textentry
(
5758 ("annotation: ", E.s, None
, textentry, ondone, true),
5759 fun _ -> state
.mode <- mode);
5762 G.postRedisplay "annot"
5764 add @@ getusertext E.s
5769 let g opaque l px py =
5770 match rectofblock
opaque px py with
5772 let x0 = a.(0) -. 20. in
5773 let x1 = a.(1) +. 20. in
5774 let y0 = a.(2) -. 20. in
5775 let zoom = (float state
.w) /. (x1 -. x0) in
5776 let pagey = getpagey
l.pageno in
5777 gotoy_and_clear_text (pagey + truncate
y0);
5778 state
.anchor <- getanchor
();
5779 let margin = (state
.w - l.pagew
)/2 in
5780 state
.x <- -truncate
x0 - margin;
5785 match conf
.columns
with
5787 showtext '
!'
"block zooming does not work properly in split columns mode"
5788 | Cmulti
_ | Csingle
_ -> onppundermouse g x y ()
5792 let winw = wadjsb () + state
.winw - 1 in
5793 let s = float x /. float winw in
5794 let destx = truncate
(float (state
.w + winw) *. s) in
5795 state
.x <- winw - destx;
5796 gotoy_and_clear_text state
.y;
5797 state
.mstate
<- Mscrollx
;
5801 let s = float y /. float state
.winh
in
5802 let desty = truncate
(float (state
.maxy - state
.winh
) *. s) in
5803 gotoy_and_clear_text desty;
5804 state
.mstate
<- Mscrolly
;
5807 let viewmulticlick clicks
x y mask
=
5808 let g opaque l px py =
5816 if markunder
opaque px py mark
5820 match getopaque l.pageno with
5822 | Some
opaque -> pipesel opaque cmd
5824 state
.roam
<- (fun () -> dopipe conf
.paxcmd
);
5825 if not
(Wsi.withctrl mask
) then dopipe conf
.selcmd
;
5830 G.postRedisplay "viewmulticlick";
5831 onppundermouse g x y (fun () -> showtext '
!'
"Nothing to select") ();
5835 match conf
.columns
with
5837 | Csingle
_ | Cmulti
_ -> conf
.angle
mod 360 = 0
5840 let viewmouse button down
x y mask
=
5842 | n when (n == 4 || n == 5) && not down
->
5843 if Wsi.withctrl mask
5845 match state
.mstate
with
5846 | Mzoom
(oldn
, i
) ->
5854 if conf
.zoom +. 0.01 > 0.1 then 0.1 else 0.01
5856 if conf
.zoom -. 0.1 < 0.1 then -0.01 else -0.1
5858 let zoom = conf
.zoom -. incr in
5860 state
.mstate
<- Mzoom
(n, 0);
5862 state
.mstate
<- Mzoom
(n, i
+1);
5864 else state
.mstate
<- Mzoom
(n, 0)
5868 | Mscrolly
| Mscrollx
5870 | Mnone
-> state
.mstate
<- Mzoom
(n, 0)
5873 match state
.autoscroll
with
5874 | Some step
-> setautoscrollspeed step
(n=4)
5876 if conf
.wheelbypage
|| conf
.presentation
5885 then -conf
.scrollstep
5886 else conf
.scrollstep
5888 let incr = incr * 2 in
5889 let y = clamp incr in
5890 gotoy_and_clear_text y
5893 | n when (n = 6 || n = 7) && not down
&& canpan () ->
5895 panbound (state
.x + (if n = 7 then -2 else 2) * conf
.hscrollstep
);
5896 gotoy_and_clear_text state
.y
5898 | 1 when Wsi.withshift mask
->
5899 state
.mstate
<- Mnone
;
5902 match unproject x y with
5903 | Some
(_, pageno, ux
, uy
) ->
5904 let cmd = Printf.sprintf
5906 conf
.stcmd state
.path pageno ux uy
5908 addpid
@@ popen
cmd []
5912 | 1 when Wsi.withctrl mask
->
5915 Wsi.setcursor
Wsi.CURSOR_FLEUR
;
5916 state
.mstate
<- Mpan
(x, y)
5919 state
.mstate
<- Mnone
5924 if Wsi.withshift mask
5926 annot conf
.annotinline
x y;
5927 G.postRedisplay "addannot"
5931 Wsi.setcursor
Wsi.CURSOR_CYCLE
;
5932 state
.mstate
<- Mzoomrect
(p, p)
5935 match state
.mstate
with
5936 | Mzoomrect
((x0, y0), _) ->
5937 if abs
(x-x0) > 10 && abs
(y - y0) > 10
5938 then zoomrect x0 y0 x y
5941 G.postRedisplay "kill accidental zoom rect";
5945 | Mscrolly
| Mscrollx
5951 | 1 when x > state
.winw - vscrollw () ->
5954 let _, position, sh = state
.uioh#
scrollph in
5955 if y > truncate
position && y < truncate
(position +. sh)
5956 then state
.mstate
<- Mscrolly
5959 state
.mstate
<- Mnone
5961 | 1 when y > state
.winh
- hscrollh () ->
5964 let _, position, sw = state
.uioh#scrollpw
in
5965 if x > truncate
position && x < truncate
(position +. sw)
5966 then state
.mstate
<- Mscrollx
5969 state
.mstate
<- Mnone
5971 | 1 when state
.bzoom
-> if not down
then zoomblock x y
5974 let dest = if down
then getunder x y else Unone
in
5975 begin match dest with
5978 | Uremote
_ | Uremotedest
_
5979 | Uunexpected
_ | Ulaunch
_ | Unamed
_ ->
5982 | Unone
when down
->
5983 Wsi.setcursor
Wsi.CURSOR_FLEUR
;
5984 state
.mstate
<- Mpan
(x, y);
5986 | Uannotation
(opaque, slinkindex
) -> enterannotmode opaque slinkindex
5988 | Unone
| Utext
_ ->
5993 state
.mstate
<- Msel
((x, y), (x, y));
5994 G.postRedisplay "mouse select";
5998 match state
.mstate
with
6001 | Mzoom
_ | Mscrollx
| Mscrolly
->
6002 state
.mstate
<- Mnone
6004 | Mzoomrect
((x0, y0), _) ->
6008 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
6009 state
.mstate
<- Mnone
6011 | Msel
((x0, y0), (x1, y1)) ->
6012 let rec loop = function
6016 let a0 = l.pagedispy in
6017 let a1 = a0 + l.pagevh in
6018 let b0 = l.pagedispx in
6019 let b1 = b0 + l.pagevw in
6020 ((y0 >= a0 && y0 <= a1) || (y1 >= a0 && y1 <= a1))
6021 && ((x0 >= b0 && x0 <= b1) || (x1 >= b0 && x1 <= b1))
6025 match getopaque l.pageno with
6028 match Unix.pipe
() with
6032 "can not create sel pipe: %s"
6036 Ne.clo fd
(fun msg
->
6037 dolog
"%s close failed: %s" what msg
)
6040 try popen
cmd [r
, 0; w, -1]
6042 dolog
"can not execute %S: %s"
6049 G.postRedisplay "copysel";
6051 else clo "Msel pipe/w" w;
6052 clo "Msel pipe/r" r
;
6054 dosel conf
.selcmd
();
6055 state
.roam
<- dosel conf
.paxcmd
;
6067 let birdseyemouse button down
x y mask
6068 (conf
, leftx
, _, hooverpageno
, anchor) =
6071 let rec loop = function
6074 if y > l.pagedispy && y < l.pagedispy + l.pagevh
6075 && x > l.pagedispx && x < l.pagedispx + l.pagevw
6077 leavebirdseye (conf
, leftx
, l.pageno, hooverpageno
, anchor) false;
6083 | _ -> viewmouse button down
x y mask
6089 method key key mask
=
6090 begin match state
.mode with
6091 | Textentry
textentry -> textentrykeyboard key mask
textentry
6092 | Birdseye
birdseye -> birdseyekeyboard key mask
birdseye
6093 | View
-> viewkeyboard key mask
6094 | LinkNav
linknav -> linknavkeyboard key mask
linknav
6098 method button button bstate
x y mask
=
6099 begin match state
.mode with
6101 | View
-> viewmouse button bstate
x y mask
6102 | Birdseye beye
-> birdseyemouse button bstate
x y mask beye
6107 method multiclick clicks
x y mask
=
6108 begin match state
.mode with
6110 | View
-> viewmulticlick clicks
x y mask
6117 begin match state
.mode with
6119 | View
| Birdseye
_ | LinkNav
_ ->
6120 match state
.mstate
with
6121 | Mzoom
_ | Mnone
-> ()
6126 state
.mstate
<- Mpan
(x, y);
6128 then state
.x <- panbound (state
.x + dx);
6130 gotoy_and_clear_text y
6133 state
.mstate
<- Msel
(a, (x, y));
6134 G.postRedisplay "motion select";
6137 let y = min state
.winh
(max
0 y) in
6141 let x = min state
.winw (max
0 x) in
6144 | Mzoomrect
(p0
, _) ->
6145 state
.mstate
<- Mzoomrect
(p0
, (x, y));
6146 G.postRedisplay "motion zoomrect";
6150 method pmotion
x y =
6151 begin match state
.mode with
6152 | Birdseye
(conf
, leftx
, pageno, hooverpageno
, anchor) ->
6153 let rec loop = function
6155 if hooverpageno
!= -1
6157 state
.mode <- Birdseye
(conf
, leftx
, pageno, -1, anchor);
6158 G.postRedisplay "pmotion birdseye no hoover";
6161 if y > l.pagedispy && y < l.pagedispy + l.pagevh
6162 && x > l.pagedispx && x < l.pagedispx + l.pagevw
6164 state
.mode <- Birdseye
(conf
, leftx
, pageno, l.pageno, anchor);
6165 G.postRedisplay "pmotion birdseye hoover";
6175 match state
.mstate
with
6176 | Mpan
_ | Msel
_ | Mzoom
_ | Mscrolly
| Mscrollx
| Mzoomrect
_ -> ()
6184 let past, _, _ = !r
in
6186 let delta = now -. past in
6189 else r
:= (now, x, y)
6193 method infochanged
_ = ()
6196 let maxy = state
.maxy - (if conf
.maxhfit
then state
.winh
else 0) in
6199 then 0.0, float state
.winh
6200 else scrollph state
.y maxy
6205 let winw = wadjsb () + state
.winw in
6206 let fwinw = float winw in
6208 let sw = fwinw /. float state
.w in
6209 let sw = fwinw *. sw in
6210 max
sw (float conf
.scrollh
)
6213 let maxx = state
.w + winw in
6214 let x = winw - state
.x in
6215 let percent = float x /. float maxx in
6216 (fwinw -. sw) *. percent
6218 hscrollh (), position, sw
6222 match state
.mode with
6223 | LinkNav
_ -> "links"
6224 | Textentry
_ -> "textentry"
6225 | Birdseye
_ -> "birdseye"
6228 findkeyhash conf
modename
6230 method eformsgs
= true
6231 method alwaysscrolly
= false
6234 let adderrmsg src msg
=
6235 Buffer.add_string state
.errmsgs msg
;
6236 state
.newerrmsgs
<- true;
6240 let adderrfmt src fmt
=
6241 Format.ksprintf
(fun s -> adderrmsg src s) fmt
;
6245 let cl = splitatspace cmds
in
6247 try Scanf.sscanf
s fmt
f
6249 adderrfmt "remote exec"
6250 "error processing '%S': %s\n" cmds
(exntos exn
)
6253 | "reload" :: [] -> reload ()
6254 | "goto" :: args
:: [] ->
6255 scan args
"%u %f %f"
6257 let cmd, _ = state
.geomcmds
in
6259 then gotopagexy pageno x y
6262 gotopagexy pageno x y;
6265 state
.reprf
<- f state
.reprf
6267 | "goto1" :: args
:: [] -> scan args
"%u %f" gotopage
6268 | "gotor" :: args
:: [] ->
6270 (fun filename
pageno -> gotounder (Uremote
(filename
, pageno)))
6271 | "gotord" :: args
:: [] ->
6273 (fun filename
dest -> gotounder (Uremotedest
(filename
, dest)))
6274 | "rect" :: args
:: [] ->
6275 scan args
"%u %u %f %f %f %f"
6276 (fun pageno color x0 y0 x1 y1 ->
6277 onpagerect pageno (fun w h ->
6278 let _,w1,h1
,_ = getpagedim
pageno in
6279 let sw = float w1 /. float w
6280 and sh = float h1
/. float h in
6284 and y1s
= y1 *. sh in
6285 let rect = (x0s,y0s
,x1s
,y0s
,x1s
,y1s
,x0s,y1s
) in
6287 state
.rects <- (pageno, color, rect) :: state
.rects;
6288 G.postRedisplay "rect";
6291 | "activatewin" :: [] -> Wsi.activatewin
()
6292 | "quit" :: [] -> raise Quit
6294 adderrfmt "remote command"
6295 "error processing remote command: %S\n" cmds
;
6299 let scratch = Bytes.create
80 in
6300 let buf = Buffer.create
80 in
6303 try Some
(Unix.read fd
scratch 0 80)
6305 | Unix.Unix_error
(Unix.EAGAIN
, _, _) -> None
6306 | Unix.Unix_error
(Unix.EINTR
, _, _) -> tempfr ()
6309 match tempfr () with
6315 if Buffer.length
buf > 0
6317 let s = Buffer.contents
buf in
6327 let pos = Bytes.index_from
scratch ppos '
\n'
in
6328 if pos >= n then -1 else pos
6329 with Not_found
-> -1
6333 Buffer.add_subbytes
buf scratch ppos
(nlpos-ppos
);
6334 let s = Buffer.contents
buf in
6340 Buffer.add_subbytes
buf scratch ppos
(n-ppos
);
6346 let remoteopen path =
6347 try Some
(Unix.openfile
path [Unix.O_NONBLOCK
; Unix.O_RDONLY
] 0o0)
6349 adderrfmt "remoteopen" "error opening %S: %s" path (exntos exn
);
6354 let gcconfig = ref E.s in
6355 let trimcachepath = ref E.s in
6356 let rcmdpath = ref E.s in
6357 let pageno = ref None
in
6358 let rootwid = ref 0 in
6359 let openlast = ref false in
6360 let nofc = ref false in
6361 let doreap = ref false in
6362 selfexec := Sys.executable_name
;
6365 [("-p", Arg.String
(fun s -> state
.password <- s),
6366 "<password> Set password");
6370 Config.fontpath
:= s;
6371 selfexec := !selfexec ^
" -f " ^
Filename.quote
s;
6373 "<path> Set path to the user interface font");
6377 selfexec := !selfexec ^
" -c " ^
Filename.quote
s;
6378 Config.confpath
:= s),
6379 "<path> Set path to the configuration file");
6381 ("-last", Arg.Set
openlast, " Open last document");
6383 ("-page", Arg.Int
(fun pageno1
-> pageno := Some
(pageno1
-1)),
6384 "<page-number> Jump to page");
6386 ("-tcf", Arg.String
(fun s -> trimcachepath := s),
6387 "<path> Set path to the trim cache file");
6389 ("-dest", Arg.String
(fun s -> state
.nameddest
<- s),
6390 "<named-destination> Set named destination");
6392 ("-wtmode", Arg.Set
wtmode, " Operate in wt mode");
6393 ("-cxack", Arg.Set
cxack, " Cut corners");
6395 ("-remote", Arg.String
(fun s -> rcmdpath := s),
6396 "<path> Set path to the remote commands source");
6398 ("-origin", Arg.String
(fun s -> state
.origin
<- s),
6399 "<original-path> Set original path");
6401 ("-gc", Arg.Set_string
gcconfig,
6402 "<script-path> Collect garbage with the help of a script");
6404 ("-nofc", Arg.Set
nofc, " Do not use fontconfig");
6406 ("-v", Arg.Unit
(fun () ->
6408 "%s\nconfiguration path: %s\n"
6412 exit
0), " Print version and exit");
6414 ("-embed", Arg.Set_int
rootwid,
6415 "<window-id> Embed into window")
6418 (fun s -> state
.path <- s)
6419 ("Usage: " ^
Sys.argv
.(0) ^
" [options] some.pdf\nOptions:")
6422 then selfexec := !selfexec ^
" -wtmode";
6424 let histmode = emptystr state
.path && not
!openlast in
6426 if not
(Config.load !openlast)
6427 then prerr_endline
"failed to load configuration";
6428 begin match !pageno with
6429 | Some
pageno -> state
.anchor <- (pageno, 0.0, 0.0)
6433 if nonemptystr
!gcconfig
6436 match Unix.socketpair
Unix.PF_UNIX
Unix.SOCK_STREAM
0 with
6438 error
"gc socketpair failed: %s" (exntos exn
)
6441 match addpid
@@ popen
!gcconfig [(c, 0); (c, 1)] with
6443 error
"failed to popen gc script: %s" (exntos exn
);
6449 let wsfd, winw, winh
= Wsi.init
(object (self)
6450 val mutable m_clicks
= 0
6451 val mutable m_click_x
= 0
6452 val mutable m_click_y
= 0
6453 val mutable m_lastclicktime
= infinity
6455 method private cleanup =
6456 state
.roam
<- noroam
;
6457 Hashtbl.iter
(fun _ opaque -> clearmark
opaque) state
.pagemap
6458 method expose
= G.postRedisplay"expose"
6462 | Wsi.Unobscured
-> "unobscured"
6463 | Wsi.PartiallyObscured
-> "partiallyobscured"
6464 | Wsi.FullyObscured
-> "fullyobscured"
6466 vlog "visibility change %s" name
6467 method display = display ()
6468 method map mapped
= vlog "mappped %b" mapped
6469 method reshape w h =
6472 method mouse
b d x y m =
6473 if d && canselect ()
6475 (* http://blogs.msdn.com/b/oldnewthing/archive/2004/10/18/243925.aspx *)
6481 if abs
x - m_click_x
> 10
6482 || abs
y - m_click_y
> 10
6483 || abs_float
(t -. m_lastclicktime
) > 0.3
6485 m_clicks
<- m_clicks
+ 1;
6486 m_lastclicktime
<- t;
6490 G.postRedisplay "cleanup";
6491 state
.uioh <- state
.uioh#button
b d x y m;
6493 else state
.uioh <- state
.uioh#multiclick m_clicks
x y m
6498 m_lastclicktime
<- infinity
;
6499 state
.uioh <- state
.uioh#button
b d x y m
6503 state
.uioh <- state
.uioh#button
b d x y m
6506 state
.mpos
<- (x, y);
6507 state
.uioh <- state
.uioh#motion
x y
6508 method pmotion
x y =
6509 state
.mpos
<- (x, y);
6510 state
.uioh <- state
.uioh#pmotion
x y
6512 let mascm = m land (
6513 Wsi.altmask
+ Wsi.shiftmask
+ Wsi.ctrlmask
+ Wsi.metamask
6516 let x = state
.x and y = state
.y in
6518 if x != state
.x || y != state
.y then self#
cleanup
6520 match state
.keystate
with
6522 let km = k
, mascm in
6525 let modehash = state
.uioh#
modehash in
6526 try Hashtbl.find modehash km
6528 try Hashtbl.find (findkeyhash conf
"global") km
6529 with Not_found
-> KMinsrt
(k
, m)
6531 | KMinsrt
(k
, m) -> keyboard k
m
6532 | KMinsrl
l -> List.iter
(fun (k
, m) -> keyboard k
m) l
6533 | KMmulti
(l, r
) -> state
.keystate
<- KSinto
(l, r
)
6535 | KSinto
((k'
, m'
) :: [], insrt
) when k'
=k
&& m'
land mascm = m'
->
6536 List.iter
(fun (k
, m) -> keyboard k
m) insrt
;
6537 state
.keystate
<- KSnone
6538 | KSinto
((k'
, m'
) :: keys, insrt
) when k'
=k
&& m'
land mascm = m'
->
6539 state
.keystate
<- KSinto
(keys, insrt
)
6540 | KSinto
_ -> state
.keystate
<- KSnone
6543 state
.mpos
<- (x, y);
6544 state
.uioh <- state
.uioh#pmotion
x y
6545 method leave = state
.mpos
<- (-1, -1)
6546 method winstate wsl
= state
.winstate
<- wsl
6547 method quit
= raise Quit
6548 end) !rootwid conf
.cwinw conf
.cwinh platform
in
6553 List.exists
GlMisc.check_extension
6554 [ "GL_ARB_texture_rectangle"
6555 ; "GL_EXT_texture_recangle"
6556 ; "GL_NV_texture_rectangle" ]
6558 then (prerr_endline
"OpenGL does not suppport rectangular textures"; exit
1);
6561 let r = GlMisc.get_string `renderer
in
6562 let p = "Mesa DRI Intel(" in
6563 let l = String.length
p in
6564 String.length
r > l && String.sub
r 0 l = p
6567 defconf
.sliceheight
<- 1024;
6568 defconf
.texcount
<- 32;
6569 defconf
.usepbo
<- true;
6573 match Unix.socketpair
Unix.PF_UNIX
Unix.SOCK_STREAM
0 with
6575 dolog
"socketpair failed: %s" (exntos exn
);
6583 setcheckers conf
.checkers
;
6585 if conf
.redirectstderr
6589 (Buffer.to_bytes state
.errmsgs
)
6590 (match state
.errfd
with
6592 let s = Bytes.create
(80*24) in
6595 let r, _, _ = Unix.select
[fd
] [] [] 0.0 in
6597 then Unix.read fd
s 0 (Bytes.length
s)
6603 else Bytes.sub
s 0 n
6607 try ignore
(Unix.write state
.stderr
s 0 (Bytes.length
s))
6608 with exn
-> print_endline
(exntos exn
)
6613 conf
.angle
, conf
.fitmodel
, (conf
.trimmargins
, conf
.trimfuzz
),
6614 conf
.texcount
, conf
.sliceheight
, conf
.mustoresize
, conf
.colorspace
,
6615 !Config.fontpath
, !trimcachepath,
6616 GlMisc.check_extension
"GL_ARB_pixel_buffer_object",
6619 List.iter
GlArray.enable
[`texture_coord
; `vertex
];
6621 reshape ~firsttime
:true winw winh
;
6625 Wsi.settitle
"llpp (history)";
6629 state
.text <- "Opening " ^
(mbtoutf8 state
.path);
6630 opendoc state
.path state
.password;
6634 Sys.set_signal
Sys.sighup
(Sys.Signal_handle
(fun _ -> reload ()));
6637 match Unix.waitpid
[Unix.WNOHANG
] ~
-1 with
6638 | (exception (Unix.Unix_error
(Unix.ECHILD
, _, _))) -> ()
6639 | (exception exn
) -> dolog
"Unix.waitpid: %s" @@ exntos exn
6641 | _pid
, _status
-> reap ()
6643 Sys.set_signal
Sys.sigchld
(Sys.Signal_handle
(fun _ -> doreap := true));
6647 if nonemptystr
!rcmdpath
6648 then remoteopen !rcmdpath
6653 let rec loop deadline
=
6660 match state
.errfd
with
6661 | None
-> [state
.ss; state
.wsfd]
6662 | Some fd
-> [state
.ss; state
.wsfd; fd
]
6667 | Some fd
-> fd
:: r
6671 state
.redisplay
<- false;
6678 if deadline
= infinity
6680 else max
0.0 (deadline
-. now)
6685 try Unix.select
r [] [] timeout
6686 with Unix.Unix_error
(Unix.EINTR
, _, _) -> [], [], []
6692 if state
.ghyll
== noghyll
6694 match state
.autoscroll
with
6695 | Some step
when step
!= 0 ->
6696 let y = state
.y + step
in
6700 else if y >= state
.maxy then 0 else y
6703 if state
.mode = View
6704 then state
.text <- E.s;
6707 else deadline
+. 0.01
6712 let rec checkfds = function
6714 | fd
:: rest
when fd
= state
.ss ->
6715 let cmd = readcmd state
.ss in
6719 | fd
:: rest
when fd
= state
.wsfd ->
6723 | fd
:: rest
when Some fd
= !optrfd ->
6724 begin match remote fd
with
6725 | None
-> optrfd := remoteopen !rcmdpath;
6726 | opt -> optrfd := opt
6731 let s = Bytes.create
80 in
6732 let n = tempfailureretry
(Unix.read fd
s 0) 80 in
6733 if conf
.redirectstderr
6735 Buffer.add_substring state
.errmsgs
(Bytes.to_string
s) 0 n;
6736 state
.newerrmsgs
<- true;
6737 state
.redisplay
<- true;
6740 prerr_string
(String.sub
(Bytes.to_string
s) 0 n);
6748 if deadline
= infinity
6752 match state
.autoscroll
with
6753 | Some step
when step
!= 0 -> deadline1
6754 | _ -> if state
.ghyll
== noghyll
then infinity
else deadline1
6762 Config.save leavebirdseye;
6763 if hasunsavedchanges
()