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 reenterhist = ref false;;
48 let selfexec = ref E.s
;;
50 let drawstring size x y s
=
52 Gl.enable `texture_2d
;
53 GlFunc.blend_func ~src
:`src_alpha ~dst
:`one_minus_src_alpha
;
54 ignore
(drawstr size x y s
);
56 Gl.disable `texture_2d
;
59 let drawstring1 size x y s
=
63 let drawstring2 size x y fmt
=
64 Printf.kprintf
(drawstring size
(x
+1) (y
+size
+1)) fmt
68 dolog
"l %d dim=%d {" l
.pageno l
.pagedimno
;
69 dolog
" WxH %dx%d" l
.pagew l
.pageh
;
70 dolog
" vWxH %dx%d" l
.pagevw l
.pagevh
;
71 dolog
" pagex,y %d,%d" l
.pagex l
.pagey
;
72 dolog
" dispx,y %d,%d" l
.pagedispx l
.pagedispy
;
73 dolog
" column %d" l
.pagecol
;
77 let debugrect (x0
, y0
, x1
, y1
, x2
, y2
, x3
, y3
) =
79 dolog
" x0,y0=(% f, % f)" x0 y0
;
80 dolog
" x1,y1=(% f, % f)" x1 y1
;
81 dolog
" x2,y2=(% f, % f)" x2 y2
;
82 dolog
" x3,y3=(% f, % f)" x3 y3
;
86 let isbirdseye = function
93 let istextentry = function
100 let wtmode = ref false;;
101 let cxack = ref false;;
103 let pgscale h
= truncate
(float h
*. conf
.pgscale);;
106 if not state
.uioh#alwaysscrolly
&& (conf
.scrollb
land scrollbhv
= 0)
107 || (state
.x
= 0 && state
.w
<= state
.winw
- conf
.scrollbw
)
113 if not state
.uioh#alwaysscrolly
&& (conf
.scrollb
land scrollbvv
= 0)
118 let wadjsb () = -vscrollw ();;
119 let xadjsb () = if conf
.leftscroll
then vscrollw () else 0;;
122 fstate
.fontsize
<- n
;
123 fstate
.wwidth
<- measurestr fstate
.fontsize
"w";
124 fstate
.maxrows
<- (state
.winh
- fstate
.fontsize
- 1) / (fstate
.fontsize
+ 1);
130 Printf.kprintf prerr_endline fmt
132 Printf.kprintf ignore fmt
136 if emptystr conf
.pathlauncher
137 then print_endline state
.path
139 let command = Str.global_replace percentsre state
.path conf
.pathlauncher
in
140 try addpid
@@ popen
command []
142 Printf.eprintf
"failed to execute `%s': %s\n" command (exntos exn
);
147 let redirectstderr () =
148 let clofail what errmsg
= dolog
"failed to close %s: %s" what errmsg
in
149 if conf
.redirectstderr
151 match Unix.pipe
() with
153 dolog
"failed to create stderr redirection pipes: %s" (exntos exn
)
156 begin match Unix.dup
Unix.stderr
with
158 dolog
"failed to dup stderr: %s" (exntos exn
);
159 Ne.clo r
(clofail "pipe/r");
160 Ne.clo w
(clofail "pipe/w");
163 begin match Unix.dup2 w
Unix.stderr
with
165 dolog
"failed to dup2 to stderr: %s" (exntos exn
);
166 Ne.clo dupstderr
(clofail "stderr duplicate");
167 Ne.clo r
(clofail "redir pipe/r");
168 Ne.clo w
(clofail "redir pipe/w");
171 state
.stderr
<- dupstderr
;
172 state
.errfd
<- Some r
;
176 state
.newerrmsgs
<- false;
177 begin match state
.errfd
with
179 begin match Unix.dup2 state
.stderr
Unix.stderr
with
181 dolog
"failed to dup2 original stderr: %s" (exntos exn
)
183 Ne.clo fd
(clofail "dup of stderr");
188 prerr_string
(Buffer.contents state
.errmsgs
);
190 Buffer.clear state
.errmsgs
;
196 let postRedisplay who
=
198 then prerr_endline
("redisplay for " ^ who
);
199 state
.redisplay
<- true;
203 let getopaque pageno
=
204 try Some
(Hashtbl.find state
.pagemap
(pageno
, state
.gen
))
205 with Not_found
-> None
208 let putopaque pageno opaque
=
209 Hashtbl.replace state
.pagemap
(pageno
, state
.gen
) opaque
212 let pagetranslatepoint l x y
=
213 let dy = y
- l
.pagedispy
in
214 let y = dy + l
.pagey
in
215 let dx = x
- l
.pagedispx
in
216 let x = dx + l
.pagex
in
220 let onppundermouse g
x y d
=
223 begin match getopaque l
.pageno
with
225 let x0 = l
.pagedispx
in
226 let x1 = x0 + l
.pagevw
in
227 let y0 = l
.pagedispy
in
228 let y1 = y0 + l
.pagevh
in
229 if y >= y0 && y <= y1 && x >= x0 && x <= x1
231 let px, py
= pagetranslatepoint l
x y in
232 match g opaque l
px py
with
245 let g opaque l
px py
=
248 match rectofblock opaque
px py
with
250 let rect = (a
.(0),a
.(2),a
.(1),a
.(2),a
.(1),a
.(3),a
.(0),a
.(3)) in
251 state
.rects
<- [l
.pageno
, l
.pageno
mod 3, rect];
252 G.postRedisplay "getunder";
255 let under = whatsunder opaque
px py
in
256 if under = Unone
then None
else Some
under
258 onppundermouse g x y Unone
263 match unproject opaque
x y with
264 | Some
(x, y) -> Some
(Some
(opaque
, l
.pageno
, x, y))
267 onppundermouse g x y None
;
271 state
.text
<- Printf.sprintf
"%c%s" c s
;
272 G.postRedisplay "showtext";
275 let pipesel opaque cmd
=
278 match Unix.pipe
() with
281 (Printf.sprintf
"pipesel can not create pipe: %s" (exntos exn
));
283 let doclose what fd
=
284 Ne.clo fd
(fun msg
-> dolog
"%s close failed: %s" what msg
)
287 try popen cmd
[r
, 0; w
, -1]
289 dolog
"can not execute %S: %s" cmd
(exntos exn
);
295 G.postRedisplay "pipesel";
297 else doclose "pipesel pipe/w" w
;
298 doclose "pipesel pipe/r" r
;
302 let g opaque l
px py
=
303 if markunder opaque
px py conf
.paxmark
306 match getopaque l
.pageno
with
308 | Some opaque
-> pipesel opaque conf
.paxcmd
313 G.postRedisplay "paxunder";
314 if conf
.paxmark
= Mark_page
317 match getopaque l
.pageno
with
319 | Some opaque
-> clearmark opaque
) state
.layout
;
321 onppundermouse g x y (fun () -> showtext '
!'
"Whoopsie daisy");
325 match Unix.pipe
() with
327 showtext '
!'
(Printf.sprintf
"pipe failed: %s" (exntos exn
))
330 Ne.clo fd
(fun msg
->
331 showtext '
!'
(Printf.sprintf
"failed to close %s: %s" cap msg
)
335 try popen conf
.selcmd
[r
, 0; w
, -1]
338 (Printf.sprintf
"failed to execute %s: %s"
339 conf
.selcmd
(exntos exn
));
345 let l = String.length s
in
346 let bytes = Bytes.unsafe_of_string s
in
347 let n = tempfailureretry
(Unix.write w
bytes 0) l in
352 "failed to write %d characters to sel pipe, wrote %d"
357 (Printf.sprintf
"failed to write to sel pipe: %s"
362 clo "selstring pipe/r" r
;
363 clo "selstring pipe/w" w
;
366 let undertext ?
(nopath
=false) = function
369 | Ulinkgoto
(pageno
, _
) ->
371 then "page " ^ string_of_int
(pageno
+1)
372 else Printf.sprintf
"%s: page %d" state
.path
(pageno
+1)
373 | Utext s
-> "font: " ^ s
374 | Uunexpected s
-> "unexpected: " ^ s
375 | Ulaunch s
-> "launch: " ^ s
376 | Unamed s
-> "named: " ^ s
377 | Uremote
(filename
, pageno
) ->
378 Printf.sprintf
"%s: page %d" filename
(pageno
+1)
379 | Uremotedest
(filename
, destname
) ->
380 Printf.sprintf
"%s: destination %S" filename destname
381 | Uannotation
(opaque
, slinkindex
) ->
382 "annotation: " ^ getannotcontents opaque slinkindex
385 let updateunder x y =
386 match getunder x y with
387 | Unone
-> Wsi.setcursor
Wsi.CURSOR_INHERIT
389 if conf
.underinfo
then showtext 'u'
("ri: " ^ uri
);
390 Wsi.setcursor
Wsi.CURSOR_INFO
391 | Ulinkgoto
(pageno
, _
) ->
393 then showtext 'p'
("age: " ^ string_of_int
(pageno
+1));
394 Wsi.setcursor
Wsi.CURSOR_INFO
396 if conf
.underinfo
then showtext '
f'
("ont: " ^ s
);
397 Wsi.setcursor
Wsi.CURSOR_TEXT
399 if conf
.underinfo
then showtext 'u'
("nexpected: " ^ s
);
400 Wsi.setcursor
Wsi.CURSOR_INHERIT
402 if conf
.underinfo
then showtext '
l'
("aunch: " ^ s
);
403 Wsi.setcursor
Wsi.CURSOR_INHERIT
405 if conf
.underinfo
then showtext '
n'
("amed: " ^ s
);
406 Wsi.setcursor
Wsi.CURSOR_INHERIT
407 | Uremote
(filename
, pageno
) ->
408 if conf
.underinfo
then showtext 'r'
409 (Printf.sprintf
"emote: %s (%d)" filename
(pageno
+1));
410 Wsi.setcursor
Wsi.CURSOR_INFO
411 | Uremotedest
(filename
, destname
) ->
412 if conf
.underinfo
then showtext 'r'
413 (Printf.sprintf
"emote destination: %s (%S)" filename destname
);
414 Wsi.setcursor
Wsi.CURSOR_INFO
416 if conf
.underinfo
then showtext 'a'
"nnotation";
417 Wsi.setcursor
Wsi.CURSOR_INFO
420 let showlinktype under =
421 if conf
.underinfo
&& under != Unone
422 then showtext ' '
@@ undertext under
425 let intentry_with_suffix text key
=
427 if key
>= 32 && key
< 127
431 match Char.lowercase
c with
433 let text = addchar
text c in
437 let text = addchar
text c in
441 state
.text <- Printf.sprintf
"invalid char (%d, `%c')" key
c;
446 let s = Bytes.create
4 in
447 let n = tempfailureretry
(Unix.read fd
s 0) 4 in
448 if n != 4 then error
"incomplete read(len) = %d" n;
449 let len = (Char.code
(Bytes.get
s 0) lsl 24)
450 lor (Char.code
(Bytes.get
s 1) lsl 16)
451 lor (Char.code
(Bytes.get
s 2) lsl 8)
452 lor (Char.code
(Bytes.get
s 3))
454 let s = Bytes.create
len in
455 let n = tempfailureretry
(Unix.read fd
s 0) len in
456 if n != len then error
"incomplete read(data) %d vs %d" n len;
461 let b = Buffer.create
16 in
462 Buffer.add_string
b "llll";
465 let s = Buffer.to_bytes
b in
466 let n = Bytes.length
s in
468 (* dolog "wcmd %S" (String.sub s 4 len); *)
469 Bytes.set
s 0 (Char.chr
((len lsr 24) land 0xff));
470 Bytes.set
s 1 (Char.chr
((len lsr 16) land 0xff));
471 Bytes.set
s 2 (Char.chr
((len lsr 8) land 0xff));
472 Bytes.set
s 3 (Char.chr
(len land 0xff));
473 let n'
= tempfailureretry
(Unix.write state
.ss
s 0) n in
474 if n'
!= n then error
"write failed %d vs %d" n'
n;
478 let nogeomcmds cmds
=
480 | s, [] -> emptystr
s
484 let layoutN ((columns
, coverA
, coverB
), b) y sh
=
485 let sh = sh - (hscrollh ()) in
486 let wadj = wadjsb () in
487 let rec fold accu
n =
488 if n = Array.length
b
491 let pdimno, dx, vy
, (_
, w
, h
, xoff
) = b.(n) in
494 || n = state
.pagecount
- coverB
495 || (n - coverA
) mod columns
= columns
- 1)
501 let pagey = max
0 (y - vy
) in
502 let pagedispy = if pagey > 0 then 0 else vy
- y in
503 let pagedispx, pagex
=
505 if n = coverA
- 1 || n = state
.pagecount
- coverB
506 then state
.x + (wadj + state
.winw
- w
) / 2
507 else dx + xoff
+ state
.x
514 let vw = wadj + state
.winw
- pagedispx in
515 let pw = w
- pagex
in
518 let pagevh = min
(h
- pagey) (sh - pagedispy) in
519 if pagevw > 0 && pagevh > 0
530 ; pagedispx = pagedispx
531 ; pagedispy = pagedispy
543 if Array.length
b = 0
545 else List.rev
(fold [] (page_of_y
y))
548 let layoutS (columns
, b) y sh =
549 let sh = sh - hscrollh () in
550 let wadj = wadjsb () in
551 let rec fold accu n =
552 if n = Array.length
b
555 let pdimno, px, vy
, (_
, pagew
, pageh
, xoff
) = b.(n) in
562 let x = xoff
+ state
.x in
563 let pagey = max
0 (y - vy
) in
564 let pagedispy = if pagey > 0 then 0 else vy
- y in
565 let pagedispx, pagex
=
579 let pagecolw = pagew
/columns
in
581 if pagecolw < state
.winw
582 then pagedispx + ((wadj + state
.winw
- pagecolw) / 2)
586 let vw = wadj + state
.winw
- pagedispx in
587 let pw = pagew
- pagex
in
590 let pagevw = min
pagevw pagecolw in
591 let pagevh = min
(pageh
- pagey) (sh - pagedispy) in
592 if pagevw > 0 && pagevh > 0
603 ; pagedispx = pagedispx
604 ; pagedispy = pagedispy
605 ; pagecol
= n mod columns
620 if nogeomcmds state
.geomcmds
622 match conf
.columns
with
623 | Csingle
b -> layoutN ((1, 0, 0), b) y sh
624 | Cmulti
c -> layoutN c y sh
625 | Csplit
s -> layoutS s y sh
630 let y = state
.y + incr
in
632 let y = min
y (state
.maxy
- (if conf
.maxhfit
then state
.winh
else 0)) in
637 let tilex = l.pagex
mod conf
.tilew
in
638 let tiley = l.pagey mod conf
.tileh
in
640 let col = l.pagex
/ conf
.tilew
in
641 let row = l.pagey / conf
.tileh
in
643 let xadj = xadjsb () in
644 let rec rowloop row y0 dispy h
=
648 let dh = conf
.tileh
- y0 in
650 let rec colloop col x0 dispx w
=
654 let dw = conf
.tilew
- x0 in
656 let dispx'
= xadj + dispx in
657 f col row dispx' dispy
x0 y0 dw dh;
658 colloop (col+1) 0 (dispx+dw) (w
-dw)
661 colloop col tilex l.pagedispx l.pagevw;
662 rowloop (row+1) 0 (dispy
+dh) (h
-dh)
665 if l.pagevw > 0 && l.pagevh > 0
666 then rowloop row tiley l.pagedispy l.pagevh;
669 let gettileopaque l col row =
671 l.pageno
, state
.gen
, conf
.colorspace
, conf
.angle
, l.pagew
, l.pageh
, col, row
673 try Some
(Hashtbl.find state
.tilemap
key)
674 with Not_found
-> None
677 let puttileopaque l col row gen colorspace angle opaque size elapsed
=
678 let key = l.pageno
, gen
, colorspace
, angle
, l.pagew
, l.pageh
, col, row in
679 Hashtbl.add state
.tilemap
key (opaque
, size
, elapsed
)
682 let filledrect x0 y0 x1 y1 =
683 GlArray.disable `texture_coord
;
684 Raw.sets_float state
.vraw ~pos
:0 [| x0; y0; x0; y1; x1; y0; x1; y1 |];
685 GlArray.vertex `two state
.vraw
;
686 GlArray.draw_arrays `triangle_strip ~first
:0 ~count
:4;
687 GlArray.enable `texture_coord
;
690 let linerect x0 y0 x1 y1 =
691 GlArray.disable `texture_coord
;
692 Raw.sets_float state
.vraw ~pos
:0 [| x0; y0; x0; y1; x1; y1; x1; y0 |];
693 GlArray.vertex `two state
.vraw
;
694 GlArray.draw_arrays `line_loop ~first
:0 ~count
:4;
695 GlArray.enable `texture_coord
;
698 let drawtiles l color
=
700 let wadj = wadjsb () in
702 let f col row x y tilex tiley w h
=
703 match gettileopaque l col row with
704 | Some
(opaque
, _
, t
) ->
705 let params = x, y, w
, h
, tilex, tiley in
707 then GlTex.env
(`mode `blend
);
708 drawtile
params opaque
;
710 then GlTex.env
(`mode `modulate
);
714 let s = Printf.sprintf
718 let w = measurestr fstate
.fontsize
s in
719 GlDraw.color
(0.0, 0.0, 0.0);
720 filledrect (float (x-2))
723 (float (y + fstate
.fontsize
+ 2));
724 GlDraw.color
(1.0, 1.0, 1.0);
725 drawstring fstate
.fontsize
x (y + fstate
.fontsize
- 1) s;
735 let lw = wadj + state
.winw
- x in
738 let lh = state
.winh
- y in
742 then GlTex.env
(`mode `blend
);
743 begin match state
.checkerstexid
with
745 Gl.enable `texture_2d
;
746 GlTex.bind_texture ~target
:`texture_2d id
;
750 and y1 = float (y+h
) in
752 let tw = float w /. 16.0
753 and th
= float h
/. 16.0 in
754 let tx0 = float tilex /. 16.0
755 and ty0
= float tiley /. 16.0 in
757 and ty1
= ty0
+. th
in
758 Raw.sets_float state
.vraw ~pos
:0
759 [| x0; y0; x0; y1; x1; y0; x1; y1 |];
760 Raw.sets_float state
.traw ~pos
:0
761 [| tx0; ty0
; tx0; ty1
; tx1; ty0
; tx1; ty1
|];
762 GlArray.vertex `two state
.vraw
;
763 GlArray.tex_coord `two state
.traw
;
764 GlArray.draw_arrays `triangle_strip ~first
:0 ~count
:4;
765 Gl.disable `texture_2d
;
768 GlDraw.color
(1.0, 1.0, 1.0);
769 filledrect (float x) (float y) (float (x+w)) (float (y+h
));
772 then GlTex.env
(`mode `modulate
);
773 if w > 128 && h
> fstate
.fontsize
+ 10
775 let c = if conf
.invert
then 1.0 else 0.0 in
776 GlDraw.color
(c, c, c);
779 then (col*conf
.tilew
, row*conf
.tileh
)
782 drawstring2 fstate
.fontsize
x y "Loading %d [%d,%d]" l.pageno
c r
;
791 let pagevisible layout n = List.exists
(fun l -> l.pageno
= n) layout;;
793 let tilevisible1 l x y =
795 and ax1
= l.pagex
+ l.pagevw
797 and ay1
= l.pagey + l.pagevh in
801 let bx1 = min
(bx0 + conf
.tilew
) l.pagew
802 and by1
= min
(by0
+ conf
.tileh
) l.pageh
in
804 let rx0 = max
ax0 bx0
805 and ry0
= max ay0 by0
806 and rx1
= min ax1
bx1
807 and ry1
= min ay1 by1
in
809 let nonemptyintersection = rx1
> rx0 && ry1
> ry0
in
813 let tilevisible layout n x y =
814 let rec findpageinlayout m
= function
815 | l :: rest
when l.pageno
= n ->
816 tilevisible1 l x y || (
817 match conf
.columns
with
818 | Csplit
(c, _
) when c > m
-> findpageinlayout (m
+1) rest
823 | _
:: rest
-> findpageinlayout 0 rest
826 findpageinlayout 0 layout;
829 let tileready l x y =
830 tilevisible1 l x y &&
831 gettileopaque l (x/conf
.tilew
) (y/conf
.tileh
) != None
834 let tilepage n p
layout =
835 let rec loop = function
839 let f col row _ _ _ _ _ _
=
840 if state
.currently
= Idle
842 match gettileopaque l col row with
845 let x = col*conf
.tilew
846 and y = row*conf
.tileh
in
848 let w = l.pagew
- x in
852 let h = l.pageh
- y in
857 then getpbo
w h conf
.colorspace
860 wcmd "tile %s %d %d %d %d %s"
861 (~
> p
) x y w h (~
> pbo);
864 l, p
, conf
.colorspace
, conf
.angle
,
865 state
.gen
, col, row, conf
.tilew
, conf
.tileh
874 if nogeomcmds state
.geomcmds
878 let preloadlayout y =
879 let y = if y < state
.winh
then 0 else y - state
.winh
in
880 let h = state
.winh
*3 in
886 if state
.currently
!= Idle
891 begin match getopaque l.pageno
with
893 wcmd "page %d %d" l.pageno
l.pagedimno
;
894 state
.currently
<- Loading
(l, state
.gen
);
896 tilepage l.pageno opaque pages
;
901 if nogeomcmds state
.geomcmds
907 if conf
.preload && state
.currently
= Idle
908 then load (preloadlayout state
.y);
911 let layoutready layout =
912 let rec fold all ls
=
915 let seen = ref false in
916 let allvisible = ref true in
917 let foo col row _ _ _ _ _ _
=
919 allvisible := !allvisible &&
920 begin match gettileopaque l col row with
926 fold (!seen && !allvisible) rest
929 let alltilesvisible = fold true layout in
934 let y = bound
y 0 state
.maxy
in
935 let y, layout, proceed
=
936 match conf
.maxwait
with
937 | Some time
when state
.ghyll
== noghyll
->
938 begin match state
.throttle
with
940 let layout = layout y state
.winh
in
941 let ready = layoutready layout in
945 state
.throttle
<- Some
(layout, y, now
());
947 else G.postRedisplay "gotoy showall (None)";
949 | Some
(_
, _
, started
) ->
950 let dt = now
() -. started
in
953 state
.throttle
<- None
;
954 let layout = layout y state
.winh
in
956 G.postRedisplay "maxwait";
963 let layout = layout y state
.winh
in
964 if not
!wtmode || layoutready layout
965 then G.postRedisplay "gotoy ready";
971 state
.layout <- layout;
972 begin match state
.mode
with
975 | Ltexact
(pageno
, linkno
) ->
976 let rec loop = function
978 state
.mode
<- LinkNav
(Ltgendir
0)
979 | l :: _
when l.pageno
= pageno
->
980 begin match getopaque pageno
with
981 | None
-> state
.mode
<- LinkNav
(Ltnotready
(pageno
, 0))
983 let x0, y0, x1, y1 = getlinkrect opaque linkno
in
984 if not
(x0 >= l.pagex
&& x1 <= l.pagex
+ l.pagevw
985 && y0 >= l.pagey && y1 <= l.pagey + l.pagevh)
986 then state
.mode
<- LinkNav
(Ltgendir
0)
988 | _
:: rest
-> loop rest
991 | Ltnotready _
| Ltgendir _
-> ()
997 begin match state
.mode
with
998 | Birdseye
(conf
, leftx
, pageno
, hooverpageno
, anchor
) ->
999 if not
(pagevisible layout pageno
)
1001 match state
.layout with
1004 state
.mode
<- Birdseye
(
1005 conf
, leftx
, l.pageno
, hooverpageno
, anchor
1010 | Ltnotready
(_
, dir
)
1013 let rec loop = function
1016 match getopaque l.pageno
with
1017 | None
-> Ltnotready
(l.pageno
, dir
)
1022 then LDfirstvisible
(l.pagex
, l.pagey, dir
)
1024 if dir
> 0 then LDfirst
else LDlast
1030 | Lnotfound
-> loop rest
1032 showlinktype (getlink opaque
n);
1033 Ltexact
(l.pageno
, n)
1037 state
.mode
<- LinkNav
linknav
1045 state
.ghyll
<- noghyll
;
1048 let mx, my
= state
.mpos
in
1053 let conttiling pageno opaque
=
1054 tilepage pageno opaque
1055 (if conf
.preload then preloadlayout state
.y else state
.layout)
1058 let gotoy_and_clear_text y =
1059 if not conf
.verbose
then state
.text <- E.s;
1063 let getanchory (n, top
, dtop
) =
1064 let y, h = getpageyh
n in
1065 if conf
.presentation
1067 let ips = calcips
h in
1068 y + truncate
(top
*.float h -. dtop
*.float ips) + ips;
1070 y + truncate
(top
*.float h -. dtop
*.float conf
.interpagespace
)
1073 let gotoanchor anchor
=
1074 gotoy (getanchory anchor
);
1078 cbput state
.hists
.nav
(getanchor
());
1082 let anchor = cbgetc state
.hists
.nav dir
in
1086 let gotoghyll1 single
y =
1087 let scroll f n a
b =
1088 (* http://devmaster.net/forums/topic/9796-ease-in-ease-out-algorithm/ *)
1090 let s x = 3.0*.x**2.0 -. 2.0*.x**3.0 in
1092 then s (float f /. float a
)
1095 then 1.0 -. s ((float (f-b) /. float (n-b)))
1101 let ins = float a
*. 0.5
1102 and outs
= float (n-b) *. 0.5 in
1104 ins +. outs
+. float ones
1106 let rec set nab
y sy
=
1107 let (_N
, _A
, _B
), y =
1110 let scl = if y > sy
then 2 else -2 in
1111 let _N, _
, _
= nab
in
1112 (_N,0,_N), y+conf
.scrollstep
*scl
1114 let sum = summa
_N _A _B
in
1115 let dy = float (y - sy
) in
1119 then state
.ghyll
<- noghyll
1122 let s = scroll n _N _A _B
in
1123 let y1 = y1 +. ((s *. dy) /. sum) in
1124 gotoy_and_clear_text (truncate
y1);
1125 state
.ghyll
<- gf (n+1) y1;
1129 | Some
y'
when single
-> set nab
y' state
.y
1130 | Some
y'
-> set (_N/2, 1, 1) y' state
.y
1132 gf 0 (float state
.y)
1135 match conf
.ghyllscroll
with
1136 | Some nab
when not conf
.presentation
->
1137 if state
.ghyll
== noghyll
1138 then set nab
y state
.y
1139 else state
.ghyll
(Some
y)
1141 gotoy_and_clear_text y
1144 let gotoghyll = gotoghyll1 false;;
1146 let gotopage n top
=
1147 let y, h = getpageyh
n in
1148 let y = y + (truncate
(top
*. float h)) in
1152 let gotopage1 n top
=
1153 let y = getpagey
n in
1158 let invalidate s f =
1163 match state
.geomcmds
with
1164 | ps
, [] when emptystr ps
->
1166 state
.geomcmds
<- s, [];
1169 state
.geomcmds
<- ps
, [s, f];
1171 | ps
, (s'
, _
) :: rest
when s'
= s ->
1172 state
.geomcmds
<- ps
, ((s, f) :: rest
);
1175 state
.geomcmds
<- ps
, ((s, f) :: cmds
);
1179 Hashtbl.iter
(fun _ opaque
->
1180 wcmd "freepage %s" (~
> opaque
);
1182 Hashtbl.clear state
.pagemap
;
1186 if not
(Queue.is_empty state
.tilelru
)
1188 Queue.iter
(fun (k
, p
, s) ->
1189 wcmd "freetile %s" (~
> p
);
1190 state
.memused
<- state
.memused
- s;
1191 Hashtbl.remove state
.tilemap k
;
1193 state
.uioh#infochanged Memused
;
1194 Queue.clear state
.tilelru
;
1200 let h = truncate
(float h*.conf
.zoom
) in
1201 let d = conf
.interpagespace
lsl (if conf
.presentation
then 1 else 0) in
1205 let opendoc path password
=
1207 state
.password
<- password
;
1208 state
.gen
<- state
.gen
+ 1;
1209 state
.docinfo
<- [];
1210 state
.outlines
<- [||];
1213 setaalevel conf
.aalevel
;
1215 if emptystr state
.origin
1219 Wsi.settitle
("llpp " ^
(mbtoutf8
(Filename.basename
titlepath)));
1220 wcmd "open %d %d %s\000%s\000" (btod
!wtmode) (btod
!cxack) path password
;
1221 invalidate "reqlayout"
1223 wcmd "reqlayout %d %d %d %s\000"
1224 conf
.angle
(FMTE.to_int conf
.fitmodel
)
1225 (stateh state
.winh
) state
.nameddest
1230 state
.anchor <- getanchor
();
1231 opendoc state
.path state
.password
;
1235 let c = c *. conf
.colorscale
in
1239 let scalecolor2 (r
, g, b) =
1240 (r
*. conf
.colorscale
, g *. conf
.colorscale
, b *. conf
.colorscale
);
1243 let docolumns columns
=
1244 let wadj = wadjsb () in
1247 let a = Array.make state
.pagecount
(-1, -1, -1, (-1, -1, -1, -1)) in
1248 let wadj = wadjsb () in
1249 let rec loop pageno
pdimno pdim
y ph pdims
=
1250 if pageno
= state
.pagecount
1253 let pdimno, ((_
, w, h, xoff
) as pdim
), pdims
=
1255 | ((pageno'
, _
, _
, _
) as pdim
) :: rest
when pageno'
= pageno
->
1256 pdimno+1, pdim
, rest
1260 let x = max
0 (((wadj + state
.winw
- w) / 2) - xoff
) in
1262 (if conf
.presentation
1263 then (if pageno
= 0 then calcips
h else calcips ph
+ calcips
h)
1264 else (if pageno
= 0 then 0 else conf
.interpagespace
)
1267 a.(pageno
) <- (pdimno, x, y, pdim
);
1268 loop (pageno
+1) pdimno pdim
(y + h) h pdims
1270 loop 0 ~
-1 (-1,-1,-1,-1) 0 0 state
.pdims
;
1271 conf
.columns
<- Csingle
a;
1273 | Cmulti
((columns
, coverA
, coverB
), _
) ->
1274 let a = Array.make state
.pagecount
(-1, -1, -1, (-1, -1, -1, -1)) in
1275 let rec loop pageno
pdimno pdim
x y rowh pdims
=
1276 let rec fixrow m
= if m
= pageno
then () else
1277 let (pdimno, x, y, ((_
, _
, h, _
) as pdim
)) = a.(m
) in
1280 let y = y + (rowh
- h) / 2 in
1281 a.(m
) <- (pdimno, x, y, pdim
);
1285 if pageno
= state
.pagecount
1286 then fixrow (((pageno
- 1) / columns
) * columns
)
1288 let pdimno, ((_
, w, h, xoff
) as pdim
), pdims
=
1290 | ((pageno'
, _
, _
, _
) as pdim
) :: rest
when pageno'
= pageno
->
1291 pdimno+1, pdim
, rest
1296 if pageno
= coverA
- 1 || pageno
= state
.pagecount
- coverB
1298 let x = (wadj + state
.winw
- w) / 2 in
1300 if conf
.presentation
then calcips
h else conf
.interpagespace
in
1301 x, y + ips + rowh
, h
1304 if (pageno
- coverA
) mod columns
= 0
1306 let x = max
0 (wadj + state
.winw
- state
.w) / 2 in
1308 if conf
.presentation
1310 let ips = calcips
h in
1311 y + (if pageno
= 0 then 0 else calcips rowh
+ ips)
1313 y + (if pageno
= 0 then 0 else conf
.interpagespace
)
1317 else x, y, max rowh
h
1321 if pageno
> 1 && (pageno
- coverA
) mod columns
= 0
1324 if pageno
= columns
&& conf
.presentation
1326 let ips = calcips rowh
in
1327 for i
= 0 to pred columns
1329 let (pdimno, x, y, pdim
) = a.(i
) in
1330 a.(i
) <- (pdimno, x, y+ips, pdim
)
1336 fixrow (pageno
- columns
);
1341 a.(pageno
) <- (pdimno, x, y, pdim
);
1342 let x = x + w + xoff
*2 + conf
.interpagespace
in
1343 loop (pageno
+1) pdimno pdim
x y rowh' pdims
1345 loop 0 ~
-1 (-1,-1,-1,-1) 0 0 0 state
.pdims
;
1346 conf
.columns
<- Cmulti
((columns
, coverA
, coverB
), a);
1349 let a = Array.make
(state
.pagecount
*c) (-1, -1, -1, (-1, -1, -1, -1)) in
1350 let rec loop pageno
pdimno pdim
y pdims
=
1351 if pageno
= state
.pagecount
1354 let pdimno, ((_
, w, h, _
) as pdim
), pdims
=
1356 | ((pageno'
, _
, _
, _
) as pdim
) :: rest
when pageno'
= pageno
->
1357 pdimno+1, pdim
, rest
1362 let rec loop1 n x y =
1363 if n = c then y else (
1364 a.(pageno
*c + n) <- (pdimno, x, y, pdim
);
1365 loop1 (n+1) (x+cw) (y + h + conf
.interpagespace
)
1368 let y = loop1 0 0 y in
1369 loop (pageno
+1) pdimno pdim
y pdims
1371 loop 0 ~
-1 (-1,-1,-1,-1) 0 state
.pdims
;
1372 conf
.columns
<- Csplit
(c, a);
1376 docolumns conf
.columns
;
1377 state
.maxy
<- calcheight
();
1378 if state
.reprf
== noreprf
1380 match state
.mode
with
1381 | Birdseye
(_
, _
, pageno
, _
, _
) ->
1382 let y, h = getpageyh pageno
in
1383 let top = (state
.winh
- h) / 2 in
1384 gotoy (max
0 (y - top))
1387 | LinkNav _
-> gotoanchor state
.anchor
1391 state
.reprf
<- noreprf
;
1395 let reshape ?
(firsttime
=false) w h =
1396 GlDraw.viewport ~
x:0 ~
y:0 ~
w:w ~
h:h;
1397 if not firsttime
&& nogeomcmds state
.geomcmds
1398 then state
.anchor <- getanchor
();
1401 let w = wadjsb () + (truncate
(float w *. conf
.zoom
)) in
1404 setfontsize fstate
.fontsize
;
1405 GlMat.mode `modelview
;
1406 GlMat.load_identity
();
1408 GlMat.mode `projection
;
1409 GlMat.load_identity
();
1410 GlMat.rotate ~
x:1.0 ~angle
:180.0 ();
1411 GlMat.translate ~
x:~
-.1.0 ~
y:~
-.1.0 ();
1412 GlMat.scale3
(2.0 /. float state
.winw
, 2.0 /. float state
.winh
, 1.0);
1417 else float state
.x /. float state
.w
1419 invalidate "geometry"
1423 then state
.x <- truncate
(relx *. float w);
1425 match conf
.columns
with
1427 | Cmulti
((c, _
, _
), _
) -> (w - (c-1)*conf
.interpagespace
) / c
1428 | Csplit
(c, _
) -> w * c
1430 wcmd "geometry %d %d %d"
1431 w (stateh h) (FMTE.to_int conf
.fitmodel
)
1436 let len = String.length state
.text in
1437 let x0 = xadjsb () in
1440 match state
.mode
with
1441 | Textentry _
| View
| LinkNav _
->
1442 let h, _
, _
= state
.uioh#scrollpw
in
1447 filledrect x (float (state
.winh
- (fstate
.fontsize
+ 4) - hscrollh))
1448 (x+.w) (float (state
.winh
- hscrollh))
1451 let w = float (wadjsb () + state
.winw
- 1) in
1452 if state
.progress
>= 0.0 && state
.progress
< 1.0
1454 GlDraw.color
(0.3, 0.3, 0.3);
1455 let w1 = w *. state
.progress
in
1457 GlDraw.color
(0.0, 0.0, 0.0);
1458 rect (float x0+.w1) (float x0+.w-.w1)
1461 GlDraw.color
(0.0, 0.0, 0.0);
1465 GlDraw.color
(1.0, 1.0, 1.0);
1466 drawstring fstate
.fontsize
1467 (if conf
.leftscroll
then x0 + 2 else x0 + if len > 0 then 8 else 2)
1468 (state
.winh
- hscrollh - 5) s;
1471 match state
.mode
with
1472 | Textentry
((prefix
, text, _
, _
, _
, _
), _
) ->
1476 Printf.sprintf
"%s%s_ [%s]" prefix
text state
.text
1478 Printf.sprintf
"%s%s_" prefix
text
1484 | LinkNav _
-> state
.text
1489 if not
(istextentry state
.mode
) && state
.uioh#eformsgs
1491 let s1 = "(press 'e' to review error messasges)" in
1492 if nonemptystr
s then s ^
" " ^
s1 else s1
1502 let len = Queue.length state
.tilelru
in
1504 match state
.throttle
with
1507 then preloadlayout state
.y
1509 | Some
(layout, _
, _
) ->
1513 if state
.memused
<= conf
.memlimit
1518 let (k
, p
, s) as lruitem
= Queue.pop state
.tilelru
in
1519 let n, gen
, colorspace
, angle
, pagew
, pageh
, col, row = k
in
1520 let (_
, pw, ph
, _
) = getpagedim
n in
1523 && colorspace
= conf
.colorspace
1524 && angle
= conf
.angle
1528 let x = col*conf
.tilew
1529 and y = row*conf
.tileh
in
1530 tilevisible (Lazy.force_val
layout) n x y
1532 then Queue.push lruitem state
.tilelru
1535 wcmd "freetile %s" (~
> p
);
1536 state
.memused
<- state
.memused
- s;
1537 state
.uioh#infochanged Memused
;
1538 Hashtbl.remove state
.tilemap k
;
1546 let onpagerect pageno
f =
1548 match conf
.columns
with
1549 | Cmulti
(_
, b) -> b
1551 | Csplit
(_
, b) -> b
1553 if pageno
>= 0 && pageno
< Array.length
b
1555 let (_
, _
, _
, (_
, w, h, _
)) = b.(pageno
) in
1559 let gotopagexy1 pageno
x y =
1560 let _,w1,h1
,leftx
= getpagedim pageno
in
1561 let top = y /. (float h1
) in
1562 let left = x /. (float w1) in
1563 let py, w, h = getpageywh pageno
in
1564 let wh = state
.winh
- hscrollh () in
1565 let x = left *. (float w) in
1566 let x = leftx
+ state
.x + truncate
x in
1567 let wadj = wadjsb () in
1569 if x < 0 || x >= wadj + state
.winw
1573 let pdy = truncate
(top *. float h) in
1574 let y'
= py + pdy in
1575 let dy = y'
- state
.y in
1577 if x != state
.x || not
(dy > 0 && dy < wh)
1579 if conf
.presentation
1581 if abs
(py - y'
) > wh
1588 if state
.x != sx || state
.y != sy
1593 let ww = wadj + state
.winw
in
1595 and qy
= pdy / wh in
1597 and y = py + qy
* wh in
1598 let x = if -x + ww > w1 then -(w1-ww) else x
1599 and y'
= if y + wh > state
.maxy
then state
.maxy
- wh else y in
1601 if conf
.presentation
1603 if abs
(py - y'
) > wh
1613 gotoy_and_clear_text y;
1615 else gotoy_and_clear_text state
.y;
1618 let gotopagexy pageno
x y =
1619 match state
.mode
with
1620 | Birdseye
_ -> gotopage pageno
0.0
1623 | LinkNav
_ -> gotopagexy1 pageno
x y
1626 let getpassword () =
1627 let passcmd = getenvwithdef
"LLPP_ASKPASS" conf
.passcmd in
1632 showtext '
!'
@@ "error getting password: " ^
s;
1633 dolog
"%s" s) passcmd;
1637 (* dolog "%S" cmds; *)
1638 let cl = splitatspace cmds
in
1640 try Scanf.sscanf
s fmt
f
1642 dolog
"error processing '%S': %s" cmds
(exntos exn
);
1645 let addoutline outline
=
1646 match state
.currently
with
1647 | Outlining outlines
->
1648 state
.currently
<- Outlining
(outline
:: outlines
)
1649 | Idle
-> state
.currently
<- Outlining
[outline
]
1652 dolog
"invalid outlining state";
1653 logcurrently state
.currently
1657 state
.uioh#infochanged Pdim
;
1660 | "clearrects" :: [] ->
1661 state
.rects
<- state
.rects1
;
1662 G.postRedisplay "clearrects";
1664 | "continue" :: args
:: [] ->
1665 let n = scan args
"%u" (fun n -> n) in
1666 state
.pagecount
<- n;
1667 begin match state
.currently
with
1669 state
.currently
<- Idle
;
1670 state
.outlines
<- Array.of_list
(List.rev
l)
1676 let cur, cmds
= state
.geomcmds
in
1678 then failwith
"umpossible";
1680 begin match List.rev cmds
with
1682 state
.geomcmds
<- E.s, [];
1683 state
.throttle
<- None
;
1687 state
.geomcmds
<- s, List.rev rest
;
1689 if conf
.maxwait
= None
&& not
!wtmode
1690 then G.postRedisplay "continue";
1692 | "msg" :: args
:: [] ->
1695 | "vmsg" :: args
:: [] ->
1697 then showtext ' ' args
1699 | "emsg" :: args
:: [] ->
1700 Buffer.add_string state
.errmsgs args
;
1701 state
.newerrmsgs
<- true;
1702 G.postRedisplay "error message"
1704 | "progress" :: args
:: [] ->
1705 let progress, text =
1708 f, String.sub args pos
(String.length args
- pos
))
1711 state
.progress <- progress;
1712 G.postRedisplay "progress"
1714 | "firstmatch" :: args
:: [] ->
1715 let pageno, c, x0, y0, x1, y1, x2
, y2
, x3
, y3
=
1716 scan args
"%u %d %f %f %f %f %f %f %f %f"
1717 (fun p
c x0 y0 x1 y1 x2 y2 x3 y3
->
1718 (p
, c, x0, y0, x1, y1, x2
, y2
, x3
, y3
))
1720 let xoff = float (xadjsb ()) in
1724 and x3
= x3
+. xoff in
1725 let y = (getpagey
pageno) + truncate
y0 in
1728 state
.rects1
<- [pageno, c, (x0, y0, x1, y1, x2
, y2
, x3
, y3
)]
1730 | "match" :: args
:: [] ->
1731 let pageno, c, x0, y0, x1, y1, x2
, y2
, x3
, y3
=
1732 scan args
"%u %d %f %f %f %f %f %f %f %f"
1733 (fun p
c x0 y0 x1 y1 x2 y2 x3 y3
->
1734 (p
, c, x0, y0, x1, y1, x2
, y2
, x3
, y3
))
1736 let xoff = float (xadjsb ()) in
1740 and x3
= x3
+. xoff in
1742 (pageno, c, (x0, y0, x1, y1, x2
, y2
, x3
, y3
)) :: state
.rects1
1744 | "page" :: args
:: [] ->
1745 let pageopaques, t
= scan args
"%s %f" (fun p t
-> p
, t
) in
1746 let pageopaque = ~
< pageopaques in
1747 begin match state
.currently
with
1748 | Loading
(l, gen
) ->
1749 vlog "page %d took %f sec" l.pageno t
;
1750 Hashtbl.replace state
.pagemap
(l.pageno, gen
) pageopaque;
1751 begin match state
.throttle
with
1753 let preloadedpages =
1755 then preloadlayout state
.y
1760 List.fold_left
(fun s l -> IntSet.add
l.pageno s)
1761 IntSet.empty
preloadedpages
1764 Hashtbl.fold (fun ((pageno, _) as key) opaque
accu ->
1765 if not
(IntSet.mem
pageno set)
1767 wcmd "freepage %s" (~
> opaque
);
1773 List.iter
(Hashtbl.remove state
.pagemap
) evictedpages;
1776 state
.currently
<- Idle
;
1779 tilepage l.pageno pageopaque state
.layout;
1781 load preloadedpages;
1782 let visible = pagevisible state
.layout l.pageno in
1785 match state
.mode
with
1786 | LinkNav
(Ltnotready
(pageno, dir
)) ->
1787 if pageno = l.pageno
1792 then LDfirstvisible
(l.pagex
, l.pagey, dir
)
1794 if dir
> 0 then LDfirst
else LDlast
1797 findlink
pageopaque ld
1802 showlinktype (getlink
pageopaque n);
1803 state
.mode
<- LinkNav
(Ltexact
(l.pageno, n))
1805 | LinkNav
(Ltgendir
_)
1806 | LinkNav
(Ltexact
_)
1812 if visible && layoutready state
.layout
1814 G.postRedisplay "page";
1818 | Some
(layout, _, _) ->
1819 state
.currently
<- Idle
;
1820 tilepage l.pageno pageopaque layout;
1827 dolog
"Inconsistent loading state";
1828 logcurrently state
.currently
;
1832 | "tile" :: args
:: [] ->
1833 let (x, y, opaques
, size
, t
) =
1834 scan args
"%u %u %s %u %f"
1835 (fun x y p size t
-> (x, y, p
, size
, t
))
1837 let opaque = ~
< opaques
in
1838 begin match state
.currently
with
1839 | Tiling
(l, pageopaque, cs
, angle
, gen
, col, row, tilew
, tileh
) ->
1840 vlog "tile %d [%d,%d] took %f sec" l.pageno col row t
;
1843 if tilew
!= conf
.tilew
|| tileh
!= conf
.tileh
1845 wcmd "freetile %s" (~
> opaque);
1846 state
.currently
<- Idle
;
1850 puttileopaque l col row gen cs angle
opaque size t
;
1851 state
.memused
<- state
.memused
+ size
;
1852 state
.uioh#infochanged Memused
;
1854 Queue.push
((l.pageno, gen
, cs
, angle
, l.pagew
, l.pageh
, col, row),
1855 opaque, size
) state
.tilelru
;
1858 match state
.throttle
with
1859 | None
-> state
.layout
1860 | Some
(layout, _, _) -> layout
1863 state
.currently
<- Idle
;
1865 && conf
.colorspace
= cs
1866 && conf
.angle
= angle
1867 && tilevisible layout l.pageno x y
1868 then conttiling l.pageno pageopaque;
1870 begin match state
.throttle
with
1872 preload state
.layout;
1874 && conf
.colorspace
= cs
1875 && conf
.angle
= angle
1876 && tilevisible state
.layout l.pageno x y
1877 && (not
!wtmode || layoutready state
.layout)
1878 then G.postRedisplay "tile nothrottle";
1880 | Some
(layout, y, _) ->
1881 let ready = layoutready layout in
1885 state
.layout <- layout;
1886 state
.throttle
<- None
;
1887 G.postRedisplay "throttle";
1896 dolog
"Inconsistent tiling state";
1897 logcurrently state
.currently
;
1901 | "pdim" :: args
:: [] ->
1902 let (n, w, h, _) as pdim
=
1903 scan args
"%u %u %u %u" (fun n w h x -> n, w, h, x)
1906 match conf
.fitmodel
with
1908 | FitPage
| FitProportional
->
1909 match conf
.columns
with
1910 | Csplit
_ -> (n, w, h, 0)
1911 | Csingle
_ | Cmulti
_ -> pdim
1913 state
.uioh#infochanged Pdim
;
1914 state
.pdims
<- pdim :: state
.pdims
1916 | "o" :: args
:: [] ->
1917 let (l, n, t
, h, pos
) =
1918 scan args
"%u %u %d %u %n"
1919 (fun l n t
h pos
-> l, n, t
, h, pos
)
1921 let s = String.sub args pos
(String.length args
- pos
) in
1922 addoutline (s, l, Oanchor
(n, float t
/. float h, 0.0))
1924 | "ou" :: args
:: [] ->
1925 let (l, len, pos
) = scan args
"%u %u %n" (fun l len pos
-> l, len, pos
) in
1926 let s = String.sub args pos
len in
1927 let pos2 = pos
+ len + 1 in
1928 let uri = String.sub args
pos2 (String.length args
- pos2) in
1929 addoutline (s, l, Ouri
uri)
1931 | "on" :: args
:: [] ->
1932 let (l, pos
) = scan args
"%u %n" (fun l pos
-> l, pos
) in
1933 let s = String.sub args pos
(String.length args
- pos
) in
1934 addoutline (s, l, Onone
)
1936 | "a" :: args
:: [] ->
1938 scan args
"%u %d %d" (fun n l t
-> n, l, t
)
1940 state
.reprf
<- (fun () -> gotopagexy n (float l) (float t
))
1942 | "info" :: args
:: [] ->
1943 let pos = nindex args '
\t'
in
1944 if pos >= 0 && String.sub args
0 pos = "Title"
1946 let s = String.sub args
(pos+1) @@ String.length args
- pos - 1 in
1950 state
.docinfo
<- (1, args
) :: state
.docinfo
1952 | "infoend" :: [] ->
1953 state
.uioh#infochanged Docinfo
;
1954 state
.docinfo
<- List.rev state
.docinfo
1958 then Wsi.settitle
"Wrong password";
1959 let password = getpassword () in
1961 then error
"document is password protected"
1962 else opendoc state
.path
password
1965 error
"unknown cmd `%S'" cmds
1970 let action = function
1971 | HCprev
-> cbget cb ~
-1
1972 | HCnext
-> cbget cb
1
1973 | HCfirst
-> cbget cb ~
-(cb
.rc)
1974 | HClast
-> cbget cb
(cb
.len - 1 - cb
.rc)
1975 and cancel
() = cb
.rc <- rc
1979 let search pattern forward
=
1980 match conf
.columns
with
1982 showtext '
!'
"searching does not work properly in split columns mode"
1985 if nonemptystr pattern
1988 match state
.layout with
1991 l.pageno, (l.pagey + if forward
then 0 else 0*l.pagevh)
1993 wcmd "search %d %d %d %d,%s\000"
1994 (btod conf
.icase
) pn py (btod forward
) pattern
;
1997 let intentry text key =
1999 if key >= 32 && key < 127
2005 let text = addchar
text c in
2009 state
.text <- Printf.sprintf
"invalid char (%d, `%c')" key c;
2017 let l = String.length
s in
2018 let rec loop pos n = if pos = l then n else
2019 let m = Char.code
s.[pos] - (if pos = 0 && l > 1 then 96 else 97) in
2020 loop (pos+1) (n*26 + m)
2023 let rec loop n = function
2026 match getopaque l.pageno with
2027 | None
-> loop n rest
2029 let m = getlinkcount
opaque in
2032 let under = getlink
opaque n in
2035 else loop (n-m) rest
2037 loop n state
.layout;
2041 let linknentry text key =
2043 if key >= 32 && key < 127
2049 let text = addchar
text c in
2050 linknact (fun under -> state
.text <- undertext ~nopath
:true under) text;
2054 state
.text <- Printf.sprintf
"invalid char (%d, `%c')" key c;
2058 let textentry text key =
2059 if key land 0xff00 = 0xff00
2061 else TEcont
(text ^ toutf8
key)
2064 let reqlayout angle fitmodel
=
2065 match state
.throttle
with
2067 if nogeomcmds state
.geomcmds
2068 then state
.anchor <- getanchor
();
2069 conf
.angle
<- angle
mod 360;
2072 match state
.mode
with
2073 | LinkNav
_ -> state
.mode
<- View
2078 conf
.fitmodel
<- fitmodel
;
2079 invalidate "reqlayout"
2081 wcmd "reqlayout %d %d %d"
2082 conf
.angle
(FMTE.to_int conf
.fitmodel
) (stateh state
.winh
)
2087 let settrim trimmargins trimfuzz
=
2088 if nogeomcmds state
.geomcmds
2089 then state
.anchor <- getanchor
();
2090 conf
.trimmargins
<- trimmargins
;
2091 conf
.trimfuzz
<- trimfuzz
;
2092 let x0, y0, x1, y1 = trimfuzz
in
2093 invalidate "settrim"
2095 wcmd "settrim %d %d %d %d %d" (btod conf
.trimmargins
) x0 y0 x1 y1);
2100 match state
.throttle
with
2102 let zoom = max
0.0001 zoom in
2103 if zoom <> conf
.zoom
2105 state
.prevzoom
<- (conf
.zoom, state
.x);
2107 reshape state
.winw state
.winh
;
2108 state
.text <- Printf.sprintf
"zoom is now %-5.2f" (zoom *. 100.0);
2111 | Some
(layout, y, started
) ->
2113 match conf
.maxwait
with
2117 let dt = now
() -. started
in
2125 let setcolumns mode columns coverA coverB
=
2126 state
.prevcolumns
<- Some
(conf
.columns
, conf
.zoom);
2130 then showtext '
!'
"split mode doesn't work in bird's eye"
2132 conf
.columns
<- Csplit
(-columns
, E.a);
2140 conf
.columns
<- Csingle
E.a;
2145 conf
.columns
<- Cmulti
((columns
, coverA
, coverB
), E.a);
2149 reshape state
.winw state
.winh
;
2152 let resetmstate () =
2153 state
.mstate
<- Mnone
;
2154 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
2157 let enterbirdseye () =
2158 let zoom = float conf
.thumbw
/. float state
.winw
in
2159 let birdseyepageno =
2160 let cy = state
.winh
/ 2 in
2164 let rec fold best
= function
2167 let d = cy - (l.pagedispy + l.pagevh/2)
2168 and dbest
= cy - (best
.pagedispy + best
.pagevh/2) in
2169 if abs
d < abs dbest
2176 state
.mode
<- Birdseye
(
2177 { conf
with zoom = conf
.zoom }, state
.x, birdseyepageno, -1, getanchor
()
2181 conf
.presentation
<- false;
2182 conf
.interpagespace
<- 10;
2183 conf
.hlinks
<- false;
2184 conf
.fitmodel
<- FitPage
;
2186 conf
.maxwait
<- None
;
2188 match conf
.beyecolumns
with
2191 Cmulti
((c, 0, 0), E.a)
2192 | None
-> Csingle
E.a
2196 state
.text <- Printf.sprintf
"birds eye mode on (zoom %3.1f%%)"
2201 reshape state
.winw state
.winh
;
2204 let leavebirdseye (c, leftx
, pageno, _, anchor) goback
=
2206 conf
.zoom <- c.zoom;
2207 conf
.presentation
<- c.presentation
;
2208 conf
.interpagespace
<- c.interpagespace
;
2209 conf
.maxwait
<- c.maxwait
;
2210 conf
.hlinks
<- c.hlinks
;
2211 conf
.fitmodel
<- c.fitmodel
;
2212 conf
.beyecolumns
<- (
2213 match conf
.columns
with
2214 | Cmulti
((c, _, _), _) -> Some
c
2216 | Csplit
_ -> failwith
"leaving bird's eye split mode"
2219 match c.columns
with
2220 | Cmulti
(c, _) -> Cmulti
(c, E.a)
2221 | Csingle
_ -> Csingle
E.a
2222 | Csplit
(c, _) -> Csplit
(c, E.a)
2226 state
.text <- Printf.sprintf
"birds eye mode off (zoom %3.1f%%)"
2229 reshape state
.winw state
.winh
;
2230 state
.anchor <- if goback
then anchor else (pageno, 0.0, 1.0);
2234 let togglebirdseye () =
2235 match state
.mode
with
2236 | Birdseye vals
-> leavebirdseye vals
true
2237 | View
-> enterbirdseye ()
2242 let upbirdseye incr
(conf
, leftx
, pageno, hooverpageno
, anchor) =
2243 let pageno = max
0 (pageno - incr
) in
2244 let rec loop = function
2245 | [] -> gotopage1 pageno 0
2246 | l :: _ when l.pageno = pageno ->
2247 if l.pagedispy >= 0 && l.pagey = 0
2248 then G.postRedisplay "upbirdseye"
2249 else gotopage1 pageno 0
2250 | _ :: rest
-> loop rest
2254 state
.mode
<- Birdseye
(conf
, leftx
, pageno, hooverpageno
, anchor)
2257 let downbirdseye incr
(conf
, leftx
, pageno, hooverpageno
, anchor) =
2258 let pageno = min
(state
.pagecount
- 1) (pageno + incr
) in
2259 state
.mode
<- Birdseye
(conf
, leftx
, pageno, hooverpageno
, anchor);
2260 let rec loop = function
2262 let y, h = getpageyh
pageno in
2263 let dy = (y - state
.y) - (state
.winh
- h - conf
.interpagespace
) in
2265 | l :: _ when l.pageno = pageno ->
2266 if l.pagevh != l.pageh
2267 then gotoy (clamp (l.pageh
- l.pagevh + conf
.interpagespace
))
2268 else G.postRedisplay "downbirdseye"
2269 | _ :: rest
-> loop rest
2275 let optentry mode
_ key =
2276 let btos b = if b then "on" else "off" in
2277 if key >= 32 && key < 127
2279 let c = Char.chr
key in
2283 try conf
.scrollstep
<- int_of_string
s with exc
->
2284 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2286 TEswitch
("scroll step: ", E.s, None
, intentry, ondone, true)
2291 conf
.autoscrollstep
<- boundastep state
.winh
(int_of_string
s);
2292 if state
.autoscroll
<> None
2293 then state
.autoscroll
<- Some conf
.autoscrollstep
2295 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2297 TEswitch
("auto scroll step: ", E.s, None
, intentry, ondone, true)
2302 let n, a, b = multicolumns_of_string
s in
2303 setcolumns mode
n a b;
2305 state
.text <- Printf.sprintf
"bad columns `%s': %s" s (exntos exc
)
2307 TEswitch
("columns: ", E.s, None
, textentry, ondone, true)
2312 let zoom = float (int_of_string
s) /. 100.0 in
2315 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2317 TEswitch
("zoom: ", E.s, None
, intentry, ondone, true)
2322 conf
.thumbw
<- bound
(int_of_string
s) 2 4096;
2324 Printf.sprintf
"thumbnail width is set to %d" conf
.thumbw
;
2325 begin match mode
with
2327 leavebirdseye beye
false;
2334 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2336 TEswitch
("thumbnail width: ", E.s, None
, intentry, ondone, true)
2341 Some
(int_of_string
s)
2343 state
.text <- Printf.sprintf
"bad integer `%s': %s"
2347 | Some angle
-> reqlayout angle conf
.fitmodel
2350 TEswitch
("rotation: ", E.s, None
, intentry, ondone, true)
2353 conf
.icase
<- not conf
.icase
;
2354 TEdone
("case insensitive search " ^
(btos conf
.icase
))
2357 conf
.preload <- not conf
.preload;
2359 TEdone
("preload " ^
(btos conf
.preload))
2362 conf
.verbose
<- not conf
.verbose
;
2363 TEdone
("verbose " ^
(btos conf
.verbose
))
2366 conf
.debug
<- not conf
.debug
;
2367 TEdone
("debug " ^
(btos conf
.debug
))
2370 conf
.maxhfit
<- not conf
.maxhfit
;
2371 state
.maxy
<- calcheight
();
2372 TEdone
("maxhfit " ^
(btos conf
.maxhfit
))
2375 conf
.crophack
<- not conf
.crophack
;
2376 TEdone
("crophack " ^
btos conf
.crophack
)
2380 match conf
.maxwait
with
2382 conf
.maxwait
<- Some infinity
;
2383 "always wait for page to complete"
2385 conf
.maxwait
<- None
;
2386 "show placeholder if page is not ready"
2391 conf
.underinfo
<- not conf
.underinfo
;
2392 TEdone
("underinfo " ^
btos conf
.underinfo
)
2395 conf
.savebmarks
<- not conf
.savebmarks
;
2396 TEdone
("persistent bookmarks " ^
btos conf
.savebmarks
)
2402 match state
.layout with
2407 conf
.interpagespace
<- int_of_string
s;
2408 docolumns conf
.columns
;
2409 state
.maxy
<- calcheight
();
2410 let y = getpagey
pageno in
2413 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2415 TEswitch
("vertical margin: ", E.s, None
, intentry, ondone, true)
2419 match conf
.fitmodel
with
2420 | FitProportional
-> FitWidth
2421 | FitWidth
| FitPage
-> FitProportional
2423 reqlayout conf
.angle
fm;
2424 TEdone
("proportional display " ^
btos (fm == FitProportional
))
2427 settrim (not conf
.trimmargins
) conf
.trimfuzz
;
2428 TEdone
("trim margins " ^
btos conf
.trimmargins
)
2431 conf
.invert
<- not conf
.invert
;
2432 TEdone
("invert colors " ^
btos conf
.invert
)
2436 cbput state
.hists
.sel
s;
2439 TEswitch
("selection command: ", E.s, Some
(onhist state
.hists
.sel
),
2440 textentry, ondone, true)
2444 then conf
.pax
<- Some
(ref (0.0, 0, 0))
2445 else conf
.pax
<- None
;
2446 TEdone
("PAX " ^
btos (conf
.pax
!= None
))
2449 state
.text <- Printf.sprintf
"bad option %d `%c'" key c;
2455 class type lvsource
= object
2456 method getitemcount
: int
2457 method getitem
: int -> (string * int)
2458 method hasaction
: int -> bool
2466 method getactive
: int
2467 method getfirst
: int
2469 method getminfo
: (int * int) array
2472 class virtual lvsourcebase
= object
2473 val mutable m_active
= 0
2474 val mutable m_first
= 0
2475 val mutable m_pan
= 0
2476 method getactive
= m_active
2477 method getfirst
= m_first
2478 method getpan
= m_pan
2479 method getminfo
: (int * int) array
= E.a
2482 let textentrykeyboard
2483 key _mask
((c, text, opthist
, onkey
, ondone, cancelonempty
), onleave
) =
2486 if key >= 0xffb0 && key <= 0xffb9
2487 then key - 0xffb0 + 48 else key
2490 state
.mode
<- Textentry
(te
, onleave
);
2492 G.postRedisplay "textentrykeyboard enttext";
2494 let histaction cmd
=
2497 | Some
(action, _) ->
2498 state
.mode
<- Textentry
(
2499 (c, action cmd
, opthist
, onkey
, ondone, cancelonempty
), onleave
2501 G.postRedisplay "textentry histaction"
2505 if emptystr
text && cancelonempty
2508 G.postRedisplay "textentrykeyboard after cancel";
2511 let s = withoutlastutf8
text in
2512 enttext (c, s, opthist
, onkey
, ondone, cancelonempty
)
2514 | @enter
| @kpenter
->
2517 G.postRedisplay "textentrykeyboard after confirm"
2519 | @up
| @kpup
-> histaction HCprev
2520 | @down
| @kpdown
-> histaction HCnext
2521 | @home
| @kphome
-> histaction HCfirst
2522 | @jend
| @kpend
-> histaction HClast
2527 begin match opthist
with
2529 | Some
(_, onhistcancel
) -> onhistcancel
()
2533 G.postRedisplay "textentrykeyboard after cancel2"
2536 enttext (c, E.s, opthist
, onkey
, ondone, cancelonempty
)
2539 | @delete
| @kpdelete
-> ()
2542 && key land 0xff00 != 0xff00 (* keyboard *)
2543 && key land 0xfe00 != 0xfe00 (* xkb *)
2544 && key land 0xfd00 != 0xfd00 (* 3270 *)
2546 begin match onkey
text key with
2550 G.postRedisplay "textentrykeyboard after confirm2";
2553 enttext (c, text, opthist
, onkey
, ondone, cancelonempty
);
2557 G.postRedisplay "textentrykeyboard after cancel3"
2560 state
.mode
<- Textentry
(te
, onleave
);
2561 G.postRedisplay "textentrykeyboard switch";
2565 vlog "unhandled key %s" (Wsi.keyname
key)
2568 let firstof first active
=
2569 if first
> active
|| abs
(first
- active
) > fstate
.maxrows
- 1
2570 then max
0 (active
- (fstate
.maxrows
/2))
2574 let calcfirst first active
=
2577 let rows = active
- first
in
2578 if rows > fstate
.maxrows
then active
- fstate
.maxrows
else first
2582 let scrollph y maxy
=
2583 let sh = float (maxy
+ state
.winh
) /. float state
.winh
in
2584 let sh = float state
.winh
/. sh in
2585 let sh = max
sh (float conf
.scrollh
) in
2587 let percent = float y /. float maxy
in
2588 let position = (float state
.winh
-. sh) *. percent in
2591 if position +. sh > float state
.winh
2592 then float state
.winh
-. sh
2598 let coe s = (s :> uioh
);;
2600 class listview ~zebra ~helpmode ~
(source
:lvsource
) ~trusted ~modehash
=
2602 val m_pan
= source#getpan
2603 val m_first
= source#getfirst
2604 val m_active
= source#getactive
2606 val m_prev_uioh
= state
.uioh
2608 method private elemunder
y =
2612 let n = y / (fstate
.fontsize
+1) in
2613 if m_first
+ n < source#getitemcount
2615 if source#hasaction
(m_first
+ n)
2616 then Some
(m_first
+ n)
2623 GlFunc.blend_func ~src
:`src_alpha ~dst
:`one_minus_src_alpha
;
2624 GlDraw.color
(0., 0., 0.) ~alpha
:0.85;
2625 filledrect 0. 0. (float state
.winw
) (float state
.winh
);
2626 GlDraw.color
(1., 1., 1.);
2627 Gl.enable `texture_2d
;
2628 let fs = fstate
.fontsize
in
2630 let hw = (wadjsb () + xadjsb () + state
.winw
)/3 in
2631 let ww = fstate
.wwidth
in
2632 let tabw = 17.0*.ww in
2633 let itemcount = source#getitemcount
in
2634 let minfo = source#getminfo
in
2637 then float (xadjsb ()), float (state
.winw
- 1)
2638 else 0.0, float (state
.winw
- conf
.scrollbw
- 1)
2640 let xadj = xadjsb () in
2642 if (row - m_first
) > fstate
.maxrows
2645 if row >= 0 && row < itemcount
2647 let (s, level
) = source#getitem
row in
2648 let y = (row - m_first
) * nfs in
2650 (if conf
.leftscroll
then float xadj else 5.0)
2651 +. (float (level
+ m_pan
)) *. ww in
2654 (let c = if row land 1 = 0 then 1.0 else 0.92 in (c,c,c));
2658 Gl.disable `texture_2d
;
2659 let alpha = if source#hasaction
row then 0.9 else 0.3 in
2660 GlDraw.color
(1., 1., 1.) ~
alpha;
2661 linerect (x0 +. 1.) (float (y + 1)) (x1) (float (y + fs + 3));
2662 Gl.enable `texture_2d
;
2665 if zebra
&& row land 1 = 1
2669 GlDraw.color
(c,c,c);
2670 let drawtabularstring s =
2672 let x'
= truncate
(x0 +. x) in
2673 let pos = nindex
s '
\000'
in
2675 then drawstring1 fs x'
(y+nfs) s
2677 let s1 = String.sub
s 0 pos
2678 and s2
= String.sub
s (pos+1) (String.length
s - pos - 1) in
2683 let s'
= withoutlastutf8
s in
2684 let s = s' ^
"@Uellipsis" in
2685 let w = measurestr
fs s in
2686 if float x'
+. w +. ww < float (hw + x'
)
2691 if float x'
+. ww +. measurestr
fs s1 > float (hw + x'
)
2695 ignore
(drawstring1 fs x'
(y+nfs) s1);
2696 drawstring1 fs (hw + x'
) (y+nfs) s2
2700 let x = if helpmode
&& row > 0 then x +. ww else x in
2701 let tabpos = nindex
s '
\t'
in
2704 let len = String.length
s - tabpos - 1 in
2705 let s1 = String.sub
s 0 tabpos
2706 and s2
= String.sub
s (tabpos + 1) len in
2707 let nx = drawstr x s1 in
2709 let x = x +. (max
tabw sw) in
2712 let len = String.length
s - 2 in
2713 if len > 0 && s.[0] = '
\xc2'
&& s.[1] = '
\xb7'
2715 let s = String.sub
s 2 len in
2716 let x = if not helpmode
then x +. ww else x in
2717 GlDraw.color
(1.2, 1.2, 1.2);
2718 let vinc = drawstring1 (fs+fs/4)
2719 (truncate
(x -. ww)) (y+nfs) s in
2720 GlDraw.color
(1., 1., 1.);
2721 vinc +. (float fs *. 0.8)
2727 ignore
(drawtabularstring s);
2733 GlDraw.color
(1.0, 1.0, 1.0) ~
alpha:0.5;
2734 let xadj = float (xadjsb () + 5) in
2736 if (row - m_first
) > fstate
.maxrows
2739 if row >= 0 && row < itemcount
2741 let (s, level
) = source#getitem
row in
2742 let pos0 = nindex
s '
\000'
in
2743 let y = (row - m_first
) * nfs in
2744 let x = float (level
+ m_pan
) *. ww in
2745 let (first
, last
) = minfo.(row) in
2747 if pos0 > 0 && first
> pos0
2748 then String.sub
s (pos0+1) (first
-pos0-1)
2749 else String.sub
s 0 first
2751 let suffix = String.sub
s first
(last
- first
) in
2752 let w1 = measurestr fstate
.fontsize
prefix in
2753 let w2 = measurestr fstate
.fontsize
suffix in
2754 let x = x +. if conf
.leftscroll
then xadj else 5.0 in
2755 let x = if pos0 > 0 && first
> pos0 then x +. float hw else x in
2757 and y0 = float (y+2) in
2759 and y1 = float (y+fs+3) in
2760 filledrect x0 y0 x1 y1;
2765 Gl.disable `texture_2d
;
2766 if Array.length
minfo > 0 then loop m_first
;
2769 method updownlevel incr
=
2770 let len = source#getitemcount
in
2772 if m_active
>= 0 && m_active
< len
2773 then snd
(source#getitem m_active
)
2777 if i
= len then i
-1 else if i
= -1 then 0 else
2778 let _, l = source#getitem i
in
2779 if l != curlevel then i
else flow (i
+incr
)
2781 let active = flow m_active
in
2782 let first = calcfirst m_first
active in
2783 G.postRedisplay "outline updownlevel";
2784 {< m_active
= active; m_first
= first >}
2786 method private key1
key mask
=
2787 let set1 active first qsearch
=
2788 coe {< m_active
= active; m_first
= first; m_qsearch
= qsearch
>}
2790 let search active pattern incr
=
2791 let active = if active = -1 then m_first
else active in
2794 if n >= 0 && n < source#getitemcount
2796 let s, _ = source#getitem
n in
2798 (try ignore
(Str.search_forward re
s 0); true
2799 with Not_found
-> false)
2801 else loop (n + incr
)
2808 let re = Str.regexp_case_fold pattern
in
2814 let itemcount = source#getitemcount
in
2815 let find start incr
=
2817 if i
= -1 || i
= itemcount
2820 if source#hasaction i
2822 else find (i
+ incr
)
2827 let set active first =
2828 let first = bound
first 0 (itemcount - fstate
.maxrows
) in
2830 coe {< m_active
= active; m_first
= first; m_qsearch
= E.s >}
2833 let isvisible first n = n >= first && n - first <= fstate
.maxrows
in
2835 let incr1 = if incr
> 0 then 1 else -1 in
2836 if isvisible m_first m_active
2839 let next = m_active
+ incr
in
2841 if next < 0 || next >= itemcount
2843 else find next incr1
2845 if abs
(m_active
- next) > fstate
.maxrows
2851 let first = m_first
+ incr
in
2852 let first = bound
first 0 (itemcount - fstate
.maxrows
) in
2854 let next = m_active
+ incr
in
2855 let next = bound
next 0 (itemcount - 1) in
2862 if isvisible first next
2869 let first = min
next m_first
in
2871 if abs
(next - first) > fstate
.maxrows
2877 let first = m_first
+ incr
in
2878 let first = bound
first 0 (itemcount - 1) in
2880 let next = m_active
+ incr
in
2881 let next = bound
next 0 (itemcount - 1) in
2882 let next = find next incr1 in
2884 if next = -1 || abs
(m_active
- first) > fstate
.maxrows
2886 let active = if m_active
= -1 then next else m_active
in
2891 if isvisible first active
2897 G.postRedisplay "listview navigate";
2901 | (@r
|@s) when Wsi.withctrl mask
->
2902 let incr = if key = @r
then -1 else 1 in
2904 match search (m_active
+ incr) m_qsearch
incr with
2906 state
.text <- m_qsearch ^
" [not found]";
2909 state
.text <- m_qsearch
;
2910 active, firstof m_first
active
2912 G.postRedisplay "listview ctrl-r/s";
2913 set1 active first m_qsearch
;
2915 | @insert
when Wsi.withctrl mask
->
2916 if m_active
>= 0 && m_active
< source#getitemcount
2918 let s, _ = source#getitem m_active
in
2924 if emptystr m_qsearch
2927 let qsearch = withoutlastutf8 m_qsearch
in
2931 G.postRedisplay "listview empty qsearch";
2932 set1 m_active m_first
E.s;
2936 match search m_active
qsearch ~
-1 with
2938 state
.text <- qsearch ^
" [not found]";
2941 state
.text <- qsearch;
2942 active, firstof m_first
active
2944 G.postRedisplay "listview backspace qsearch";
2945 set1 active first qsearch
2948 | key when (key != 0 && key land 0xff00 != 0xff00) ->
2949 let pattern = m_qsearch ^ toutf8
key in
2951 match search m_active
pattern 1 with
2953 state
.text <- pattern ^
" [not found]";
2956 state
.text <- pattern;
2957 active, firstof m_first
active
2959 G.postRedisplay "listview qsearch add";
2960 set1 active first pattern;
2964 if emptystr m_qsearch
2966 G.postRedisplay "list view escape";
2967 let mx, my
= state
.mpos
in
2971 source#exit ~uioh
:(coe self
)
2972 ~cancel
:true ~
active:m_active ~
first:m_first ~pan
:m_pan
2974 | None
-> m_prev_uioh
2979 G.postRedisplay "list view kill qsearch";
2980 coe {< m_qsearch
= E.s >}
2983 | @enter
| @kpenter
->
2985 let self = {< m_qsearch
= E.s >} in
2987 G.postRedisplay "listview enter";
2988 if m_active
>= 0 && m_active
< source#getitemcount
2990 source#exit ~uioh
:(coe self) ~cancel
:false
2991 ~
active:m_active ~
first:m_first ~pan
:m_pan
;
2994 source#exit ~uioh
:(coe self) ~cancel
:true
2995 ~
active:m_active ~
first:m_first ~pan
:m_pan
;
2998 begin match opt with
2999 | None
-> m_prev_uioh
3003 | @delete
| @kpdelete
->
3006 | @up
| @kpup
-> navigate ~
-1
3007 | @down
| @kpdown
-> navigate 1
3008 | @prior
| @kpprior
-> navigate ~
-(fstate
.maxrows
)
3009 | @next | @kpnext
-> navigate fstate
.maxrows
3011 | @right
| @kpright
->
3013 G.postRedisplay "listview right";
3014 coe {< m_pan
= m_pan
- 1 >}
3016 | @left | @kpleft
->
3018 G.postRedisplay "listview left";
3019 coe {< m_pan
= m_pan
+ 1 >}
3021 | @home
| @kphome
->
3022 let active = find 0 1 in
3023 G.postRedisplay "listview home";
3027 let first = max
0 (itemcount - fstate
.maxrows
) in
3028 let active = find (itemcount - 1) ~
-1 in
3029 G.postRedisplay "listview end";
3032 | key when (key = 0 || key land 0xff00 = 0xff00) ->
3036 dolog
"listview unknown key %#x" key; coe self
3038 method key key mask
=
3039 match state
.mode
with
3040 | Textentry te
-> textentrykeyboard key mask te
; coe self
3043 | LinkNav
_ -> self#key1
key mask
3045 method button button down
x y _ =
3048 | 1 when x > state
.winw
- conf
.scrollbw
->
3049 G.postRedisplay "listview scroll";
3052 let _, position, sh = self#
scrollph in
3053 if y > truncate
position && y < truncate
(position +. sh)
3055 state
.mstate
<- Mscrolly
;
3059 let s = float (max
0 (y - conf
.scrollh
)) /. float state
.winh
in
3060 let first = truncate
(s *. float source#getitemcount
) in
3061 let first = min source#getitemcount
first in
3062 Some
(coe {< m_first
= first; m_active
= first >})
3064 state
.mstate
<- Mnone
;
3068 begin match self#elemunder
y with
3070 G.postRedisplay "listview click";
3071 source#exit ~uioh
:(coe {< m_active
= n >})
3072 ~cancel
:false ~
active:n ~
first:m_first ~pan
:m_pan
3076 | n when (n == 4 || n == 5) && not down
->
3077 let len = source#getitemcount
in
3079 if n = 5 && m_first
+ fstate
.maxrows
>= len
3083 let first = m_first
+ (if n == 4 then -1 else 1) in
3084 bound
first 0 (len - 1)
3086 G.postRedisplay "listview wheel";
3087 Some
(coe {< m_first
= first >})
3088 | n when (n = 6 || n = 7) && not down
->
3089 let inc = if n = 7 then -1 else 1 in
3090 G.postRedisplay "listview hwheel";
3091 Some
(coe {< m_pan
= m_pan
+ inc >})
3096 | None
-> m_prev_uioh
3099 method multiclick
_ x y = self#button
1 true x y
3102 match state
.mstate
with
3104 let s = float (max
0 (y - conf
.scrollh
)) /. float state
.winh
in
3105 let first = truncate
(s *. float source#getitemcount
) in
3106 let first = min source#getitemcount
first in
3107 G.postRedisplay "listview motion";
3108 coe {< m_first
= first; m_active
= first >}
3116 method pmotion
x y =
3117 if x < state
.winw
- conf
.scrollbw
3120 match self#elemunder
y with
3121 | None
-> Wsi.setcursor
Wsi.CURSOR_INHERIT
; m_active
3122 | Some
n -> Wsi.setcursor
Wsi.CURSOR_INFO
; n
3126 then (G.postRedisplay "listview pmotion"; {< m_active
= n >})
3131 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
3135 method infochanged
_ = ()
3137 method scrollpw
= (0, 0.0, 0.0)
3139 let nfs = fstate
.fontsize
+ 1 in
3140 let y = m_first
* nfs in
3141 let itemcount = source#getitemcount
in
3142 let maxi = max
0 (itemcount - fstate
.maxrows
) in
3143 let maxy = maxi * nfs in
3144 let p, h = scrollph y maxy in
3147 method modehash
= modehash
3148 method eformsgs
= false
3149 method alwaysscrolly
= true
3152 class outlinelistview ~zebra ~source
=
3153 let settext autonarrow
s =
3156 let ss = source#statestr
in
3160 else "{" ^
ss ^
"} [" ^
s ^
"]"
3161 else state
.text <- s
3167 ~source
:(source
:> lvsource
)
3169 ~modehash
:(findkeyhash conf
"outline")
3172 val m_autonarrow
= false
3174 method! key key mask
=
3176 if emptystr state
.text
3178 else fstate
.maxrows - 2
3180 let calcfirst first active =
3183 let rows = active - first in
3184 if rows > maxrows then active - maxrows else first
3188 let active = m_active
+ incr in
3189 let active = bound
active 0 (source#getitemcount
- 1) in
3190 let first = calcfirst m_first
active in
3191 G.postRedisplay "outline navigate";
3192 coe {< m_active
= active; m_first
= first >}
3194 let navscroll first =
3196 let dist = m_active
- first in
3202 else first + maxrows
3205 G.postRedisplay "outline navscroll";
3206 coe {< m_first
= first; m_active
= active >}
3208 let ctrl = Wsi.withctrl mask
in
3213 then (source#denarrow
; E.s)
3215 let pattern = source#renarrow
in
3216 if nonemptystr m_qsearch
3217 then (source#narrow m_qsearch
; m_qsearch
)
3221 settext (not m_autonarrow
) text;
3222 G.postRedisplay "toggle auto narrowing";
3223 coe {< m_first
= 0; m_active
= 0; m_autonarrow
= not m_autonarrow
>}
3225 | @slash
when emptystr m_qsearch
&& not m_autonarrow
->
3227 G.postRedisplay "toggle auto narrowing";
3228 coe {< m_first
= 0; m_active
= 0; m_autonarrow
= true >}
3231 source#narrow m_qsearch
;
3233 then source#add_narrow_pattern m_qsearch
;
3234 G.postRedisplay "outline ctrl-n";
3235 coe {< m_first
= 0; m_active
= 0 >}
3238 let active = source#calcactive
(getanchor
()) in
3239 let first = firstof m_first
active in
3240 G.postRedisplay "outline ctrl-s";
3241 coe {< m_first
= first; m_active
= active >}
3244 G.postRedisplay "outline ctrl-u";
3245 if m_autonarrow
&& nonemptystr m_qsearch
3247 ignore
(source#renarrow
);
3248 settext m_autonarrow
E.s;
3249 coe {< m_first
= 0; m_active
= 0; m_qsearch
= E.s >}
3252 source#del_narrow_pattern
;
3253 let pattern = source#renarrow
in
3255 if emptystr
pattern then E.s else "Narrowed to " ^
pattern
3257 settext m_autonarrow
text;
3258 coe {< m_first
= 0; m_active
= 0; m_qsearch
= E.s >}
3262 let first = max
0 (m_active
- (fstate
.maxrows / 2)) in
3263 G.postRedisplay "outline ctrl-l";
3264 coe {< m_first
= first >}
3266 | @tab
when m_autonarrow
->
3267 if nonemptystr m_qsearch
3269 G.postRedisplay "outline list view tab";
3270 source#add_narrow_pattern m_qsearch
;
3272 coe {< m_qsearch
= E.s >}
3276 | @escape
when m_autonarrow
->
3277 if nonemptystr m_qsearch
3278 then source#add_narrow_pattern m_qsearch
;
3281 | @enter
| @kpenter
when m_autonarrow
->
3282 if nonemptystr m_qsearch
3283 then source#add_narrow_pattern m_qsearch
;
3286 | key when m_autonarrow
&& (key != 0 && key land 0xff00 != 0xff00) ->
3287 let pattern = m_qsearch ^ toutf8
key in
3288 G.postRedisplay "outlinelistview autonarrow add";
3289 source#narrow
pattern;
3290 settext true pattern;
3291 coe {< m_first
= 0; m_active
= 0; m_qsearch
= pattern >}
3293 | key when m_autonarrow
&& key = @backspace
->
3294 if emptystr m_qsearch
3297 let pattern = withoutlastutf8 m_qsearch
in
3298 G.postRedisplay "outlinelistview autonarrow backspace";
3299 ignore
(source#renarrow
);
3300 source#narrow
pattern;
3301 settext true pattern;
3302 coe {< m_first
= 0; m_active
= 0; m_qsearch
= pattern >}
3304 | @delete
| @kpdelete
->
3305 source#remove m_active
;
3306 G.postRedisplay "outline delete";
3307 let active = max
0 (m_active
-1) in
3308 coe {< m_first
= firstof m_first
active;
3309 m_active
= active >}
3311 | @up
| @kpup
when ctrl ->
3312 navscroll (max
0 (m_first
- 1))
3314 | @down
| @kpdown
when ctrl ->
3315 navscroll (min
(source#getitemcount
- 1) (m_first
+ 1))
3317 | @up
| @kpup
-> navigate ~
-1
3318 | @down
| @kpdown
-> navigate 1
3319 | @prior
| @kpprior
-> navigate ~
-(fstate
.maxrows)
3320 | @next | @kpnext
-> navigate fstate
.maxrows
3322 | @right
| @kpright
->
3326 G.postRedisplay "outline ctrl right";
3327 {< m_pan
= m_pan
+ 1 >}
3329 else self#updownlevel
1
3333 | @left | @kpleft
->
3337 G.postRedisplay "outline ctrl left";
3338 {< m_pan
= m_pan
- 1 >}
3340 else self#updownlevel ~
-1
3344 | @home
| @kphome
->
3345 G.postRedisplay "outline home";
3346 coe {< m_first
= 0; m_active
= 0 >}
3349 let active = source#getitemcount
- 1 in
3350 let first = max
0 (active - fstate
.maxrows) in
3351 G.postRedisplay "outline end";
3352 coe {< m_active
= active; m_first
= first >}
3354 | _ -> super#
key key mask
3357 let genhistoutlines =
3358 let order ty
(p1
, c1
, _, _, _, _) (p2
, c2
, _, _, _, _) =
3360 | `lastvisit
-> compare c1
.lastvisit c2
.lastvisit
3361 | `path
-> compare p2 p1
3362 | `file
-> compare
(Filename.basename p2
) (Filename.basename p1
)
3364 let e1 = emptystr c1
.title
3365 and e2
= emptystr c2
.title
in
3367 then compare
(Filename.basename p2
) (Filename.basename p1
)
3370 else compare c1
.title c2
.title
3372 let showfullpath = ref false in
3373 let showorigin = ref true in
3374 let orderty : historder
ref = ref `lastvisit
in
3377 let s = if !orderty = t
then "[@Uradical] " ^
s else "[ ] " ^
s in
3378 s, 0, Oaction
(fun () -> orderty := t
; reenterhist := true)
3380 match Config.gethist
() with
3385 (fun accu (path
, c, b, x, a, o) ->
3386 let hist = (path
, (c, b, x, a, o)) in
3388 let s = if nonemptystr
o && !showorigin then o else path
in
3389 if !showfullpath then s else Filename.basename
s
3391 let base = mbtoutf8
s in
3392 (base ^
"\000" ^
c.title
, 1, Ohistory
hist) :: accu
3394 [ setorty "Sort by time of last visit" `lastvisit
;
3395 setorty "Sort by file name" `file
;
3396 setorty "Sort by path" `path
;
3397 setorty "Sort by title" `title
;
3398 (if !showfullpath then "@Uradical "
3399 else " ") ^
"Show full path", 0, Oaction
(fun () ->
3400 showfullpath := not
!showfullpath; reenterhist := true);
3401 (if !showorigin then "@Uradical "
3402 else " ") ^
"Show origin", 0, Oaction
(fun () ->
3403 showorigin := not
!showorigin; reenterhist := true)
3404 ] (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
4246 | (exception exn
) ->
4248 Printf.sprintf
"waitpid(%d) failed: %s" pid (exntos exn
);
4252 | Unix.WEXITED
0 -> filelines
tmppath
4255 Printf.sprintf
"editor process(%s) exited abnormally: %d"
4258 | Unix.WSIGNALED
n ->
4260 Printf.sprintf
"editor process(%s) was killed by signal %d"
4263 | Unix.WSTOPPED
n ->
4265 Printf.sprintf
"editor(%s) process was stopped by signal %d"
4269 match Unix.unlink
tmppath with
4270 | (exception exn
) ->
4271 showtext '
!'
@@ Printf.sprintf
"failed to ulink %S: %s"
4272 tmppath (exntos exn
);
4277 let enterannotmode opaque slinkindex
=
4280 inherit lvsourcebase
4281 val mutable m_text
= E.s
4282 val mutable m_items
= E.a
4284 method getitemcount
= Array.length m_items
4287 let label, _func
= m_items
.(n) in
4290 method exit ~
uioh ~cancel ~
active ~
first ~pan
=
4291 ignore
(uioh, first, pan
);
4294 let _label, func
= m_items
.(active) in
4299 method hasaction
n = nonemptystr
@@ fst m_items
.(n)
4302 let rec split accu b i
=
4304 if p = String.length
s
4305 then (String.sub
s b (p-b), unit) :: accu
4307 if (i
> 70 && s.[p] = ' '
) || s.[p] = '
\r'
|| s.[p] = '
\n'
4309 let ss = if i
= 0 then E.s else String.sub
s b i
in
4310 split ((ss, unit)::accu) (p+1) 0
4315 wcmd "freepage %s" (~
> opaque);
4317 Hashtbl.fold (fun key opaque'
accu ->
4318 if opaque'
= opaque'
4319 then key :: accu else accu) state
.pagemap
[]
4321 List.iter
(Hashtbl.remove state
.pagemap
) keys;
4326 delannot
opaque slinkindex
;
4329 let edit inline
() =
4334 modannot
opaque slinkindex
s;
4340 let mode = state
.mode in
4343 ("annotation: ", m_text
, None
, textentry, update, true),
4344 fun _ -> state
.mode <- mode);
4348 let s = getusertext m_text
in
4353 ( "[Copy]", fun () -> selstring m_text
)
4354 :: ("[Delete]", dele)
4355 :: ("[Edit]", edit conf
.annotinline
)
4357 :: split [] 0 0 |> List.rev
|> Array.of_list
4364 let s = getannotcontents
opaque slinkindex
in
4367 let source = (msgsource :> lvsource
) in
4368 let modehash = findkeyhash conf
"listview" in
4369 state
.uioh <- coe (object
4370 inherit listview ~zebra
:false ~helpmode
:false
4371 ~
source ~trusted
:false ~
modehash
4373 G.postRedisplay "enterannotmode";
4376 let gotounder under =
4377 let getpath filename
=
4379 if nonemptystr filename
4381 if Filename.is_relative filename
4383 let dir = Filename.dirname state
.path in
4385 if Filename.is_implicit
dir
4386 then Filename.concat
(Sys.getcwd
()) dir
4389 Filename.concat
dir filename
4393 if Sys.file_exists
path
4398 | Ulinkgoto
(pageno, top) ->
4402 gotopage1 pageno top;
4408 | Uremote
(filename
, pageno) ->
4409 let path = getpath filename
in
4414 let command = Printf.sprintf
"%s -page %d %S" !selfexec pageno path in
4415 try addpid
@@ popen
command []
4417 Printf.eprintf
"failed to execute `%s': %s\n" command (exntos exn
);
4420 let anchor = getanchor
() in
4421 let ranchor = state
.path, state
.password, anchor, state
.origin
in
4422 state
.origin
<- E.s;
4423 state
.anchor <- (pageno, 0.0, 0.0);
4424 state
.ranchors
<- ranchor :: state
.ranchors
;
4427 else showtext '
!'
("Could not find " ^ filename
)
4429 | Uremotedest
(filename
, destname
) ->
4430 let path = getpath filename
in
4435 let command = !selfexec ^
" " ^
path ^
" -dest " ^ destname
in
4436 try addpid
@@ popen
command []
4439 "failed to execute `%s': %s\n" command (exntos exn
);
4442 let anchor = getanchor
() in
4443 let ranchor = state
.path, state
.password, anchor, state
.origin
in
4444 state
.origin
<- E.s;
4445 state
.nameddest
<- destname
;
4446 state
.ranchors
<- ranchor :: state
.ranchors
;
4449 else showtext '
!'
("Could not find " ^ filename
)
4451 | Uunexpected
_ | Ulaunch
_ | Unamed
_ | Utext
_ | Unone
-> ()
4452 | Uannotation
(opaque, slinkindex
) -> enterannotmode opaque slinkindex
4455 let gotooutline (_, _, kind
) =
4459 let (pageno, y, _) = anchor in
4461 (if conf
.presentation
then (pageno, y, 1.0) else anchor)
4465 | Ouri
uri -> gotounder (Ulinkuri
uri)
4466 | Olaunch cmd
-> gotounder (Ulaunch cmd
)
4467 | Oremote remote
-> gotounder (Uremote remote
)
4468 | Ohistory
hist -> gotohist hist
4469 | Oremotedest remotedest
-> gotounder (Uremotedest remotedest
)
4473 let outlinesource sourcetype
=
4475 inherit lvsourcebase
4476 val mutable m_items
= E.a
4477 val mutable m_minfo
= E.a
4478 val mutable m_orig_items
= E.a
4479 val mutable m_orig_minfo
= E.a
4480 val mutable m_narrow_patterns
= []
4481 val mutable m_hadremovals
= false
4482 val mutable m_gen
= -1
4484 method getitemcount
=
4485 Array.length m_items
+ (if m_hadremovals
then 1 else 0)
4488 if n == Array.length m_items
&& m_hadremovals
4490 ("[Confirm removal]", 0)
4492 let s, n, _ = m_items
.(n) in
4495 method exit ~
uioh ~cancel ~
active ~
first ~pan
=
4496 ignore
(uioh, first);
4497 let confrimremoval = m_hadremovals
&& active = Array.length m_items
in
4499 if m_narrow_patterns
= []
4500 then m_orig_items
, m_orig_minfo
4501 else m_items
, m_minfo
4505 if not
confrimremoval
4507 gotooutline m_items
.(active);
4512 state
.bookmarks
<- Array.to_list m_items
;
4513 m_orig_items
<- m_items
;
4514 m_orig_minfo
<- m_minfo
;
4524 method hasaction
_ = true
4527 if Array.length m_items
!= Array.length m_orig_items
4530 match m_narrow_patterns
with
4532 | many
-> String.concat
"@Uellipsis" (List.rev many
)
4534 "Narrowed to " ^
s ^
" (ctrl-u to restore)"
4538 match m_narrow_patterns
with
4541 | head
:: _ -> "@Uellipsis" ^ head
4543 method narrow
pattern =
4544 let reopt = try Some
(Str.regexp_case_fold
pattern) with _ -> None
in
4548 let rec loop accu minfo n =
4551 m_items
<- Array.of_list
accu;
4552 m_minfo
<- Array.of_list
minfo;
4555 let (s, _, t
) as o = m_items
.(n) in
4558 | Oaction
_ -> o :: accu, (0, 0) :: minfo
4559 | Onone
| Oanchor
_ | Ouri
_ | Olaunch
_
4560 | Oremote
_ | Oremotedest
_ | Ohistory
_ ->
4562 try Str.search_forward
re s 0
4563 with Not_found
-> -1
4566 then o :: accu, (first, Str.match_end
()) :: minfo
4569 loop accu minfo (n-1)
4571 loop [] [] (Array.length m_items
- 1)
4573 method! getminfo
= m_minfo
4577 match sourcetype
with
4578 | `bookmarks
-> Array.of_list state
.bookmarks
4579 | `outlines
-> state
.outlines
4580 | `history
-> genhistoutlines ()
4582 m_minfo
<- m_orig_minfo
;
4583 m_items
<- m_orig_items
4586 if sourcetype
= `bookmarks
4588 if m >= 0 && m < Array.length m_items
4590 m_hadremovals
<- true;
4591 m_items
<- Array.init
(Array.length m_items
- 1) (fun n ->
4592 let n = if n >= m then n+1 else n in
4597 method add_narrow_pattern
pattern =
4598 m_narrow_patterns
<- pattern :: m_narrow_patterns
4600 method del_narrow_pattern
=
4601 match m_narrow_patterns
with
4602 | _ :: rest
-> m_narrow_patterns
<- rest
4607 match m_narrow_patterns
with
4608 | pattern :: [] -> self#narrow
pattern; pattern
4610 List.fold_left
(fun accu pattern ->
4611 self#narrow
pattern;
4612 pattern ^
"@Uellipsis" ^
accu) E.s list
4614 method calcactive
anchor =
4615 let rely = getanchory anchor in
4616 let rec loop n best bestd
=
4617 if n = Array.length m_items
4620 let _, _, kind
= m_items
.(n) in
4623 let orely = getanchory anchor in
4624 let d = abs
(orely - rely) in
4627 else loop (n+1) best bestd
4628 | Onone
| Oremote
_ | Olaunch
_
4629 | Oremotedest
_ | Ouri
_ | Ohistory
_ | Oaction
_ ->
4630 loop (n+1) best bestd
4634 method reset
anchor items =
4635 m_hadremovals
<- false;
4636 if state
.gen
!= m_gen
4638 m_orig_items
<- items;
4640 m_narrow_patterns
<- [];
4642 m_orig_minfo
<- E.a;
4646 if items != m_orig_items
4648 m_orig_items
<- items;
4649 if m_narrow_patterns
== []
4650 then m_items
<- items;
4653 let active = self#calcactive
anchor in
4655 m_first
<- firstof m_first
active
4659 let enterselector sourcetype
=
4661 let source = outlinesource sourcetype
in
4664 match sourcetype
with
4665 | `bookmarks
-> Array.of_list state
.bookmarks
4666 | `
outlines -> state
.outlines
4667 | `history
-> genhistoutlines ()
4669 if Array.length
outlines = 0
4671 showtext ' ' errmsg
;
4674 state
.text <- source#greetmsg
;
4675 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
4676 let anchor = getanchor
() in
4677 source#reset
anchor outlines;
4679 coe (new outlinelistview ~zebra
:(sourcetype
=`history
) ~
source);
4680 G.postRedisplay "enter selector";
4684 let enteroutlinemode () = enterselector `
outlines "Document has no outline";;
4685 let enterbookmarkmode () =
4686 enterselector `bookmarks
"Document has no bookmarks (yet)"
4688 let enterhistmode () = enterselector `history
"No history (yet)";;
4690 let quickbookmark ?title
() =
4691 match state
.layout with
4697 let tm = Unix.localtime
(now
()) in
4699 "Quick (page %d) (bookmarked at %02d/%02d/%d %02d:%02d)"
4703 (tm.Unix.tm_year
+ 1900)
4706 | Some
title -> title
4708 state
.bookmarks
<- (title, 0, Oanchor
(getanchor1
l)) :: state
.bookmarks
4711 let setautoscrollspeed step goingdown
=
4712 let incr = max
1 ((abs step
) / 2) in
4713 let incr = if goingdown
then incr else -incr in
4714 let astep = boundastep state
.winh
(step
+ incr) in
4715 state
.autoscroll
<- Some
astep;
4719 match conf
.columns
with
4721 | Csingle
_ | Cmulti
_ -> state
.x != 0 || conf
.zoom > 1.0
4724 let panbound x = bound
x (-state
.w) (wadjsb () + state
.winw
);;
4726 let existsinrow pageno (columns
, coverA
, coverB
) p =
4727 let last = ((pageno - coverA
) mod columns
) + columns
in
4728 let rec any = function
4731 if l.pageno = coverA
- 1 || l.pageno = state
.pagecount
- coverB
4735 then (if l.pageno = last then false else any rest
)
4743 match state
.layout with
4745 let pageno = page_of_y state
.y in
4746 gotoghyll (getpagey
(pageno+1))
4748 match conf
.columns
with
4750 if conf
.presentation
&& rest
== [] && l.pageh
> l.pagey + l.pagevh
4752 let y = clamp (pgscale state
.winh
) in
4755 let pageno = min
(l.pageno+1) (state
.pagecount
-1) in
4756 gotoghyll (getpagey
pageno)
4757 | Cmulti
((c, _, _) as cl, _) ->
4758 if conf
.presentation
4759 && (existsinrow l.pageno cl
4760 (fun l -> l.pageh
> l.pagey + l.pagevh))
4762 let y = clamp (pgscale state
.winh
) in
4765 let pageno = min
(l.pageno+c) (state
.pagecount
-1) in
4766 gotoghyll (getpagey
pageno)
4768 if l.pageno < state
.pagecount
- 1 || l.pagecol
< n - 1
4770 let pagey, pageh
= getpageyh
l.pageno in
4771 let pagey = pagey + pageh
* l.pagecol
in
4772 let ips = if l.pagecol
= 0 then 0 else conf
.interpagespace
in
4773 gotoghyll (pagey + pageh
+ ips)
4777 match state
.layout with
4779 let pageno = page_of_y state
.y in
4780 gotoghyll (getpagey
(pageno-1))
4782 match conf
.columns
with
4784 if conf
.presentation
&& l.pagey != 0
4786 gotoghyll (clamp (pgscale ~
-(state
.winh
)))
4788 let pageno = max
0 (l.pageno-1) in
4789 gotoghyll (getpagey
pageno)
4790 | Cmulti
((c, _, coverB
) as cl, _) ->
4791 if conf
.presentation
&&
4792 (existsinrow l.pageno cl (fun l -> l.pagey != 0))
4794 gotoghyll (clamp (pgscale ~
-(state
.winh
)))
4797 if l.pageno = state
.pagecount
- coverB
4801 let pageno = max
0 (l.pageno-decr) in
4802 gotoghyll (getpagey
pageno)
4810 let pageno = max
0 (l.pageno-1) in
4811 let pagey, pageh
= getpageyh
pageno in
4814 let pagey, pageh
= getpageyh
l.pageno in
4815 pagey + pageh
* (l.pagecol
-1) - conf
.interpagespace
4821 if emptystr conf
.savecmd
4822 then error
"don't know where to save modified document"
4824 let savecmd = Str.global_replace percentsre state
.path conf
.savecmd in
4827 (fun s -> error
"failed to obtain path to the saved copy: %s" s)
4832 let tmp = path ^
".tmp" in
4834 Unix.rename
tmp path;
4837 let viewkeyboard key mask
=
4839 let mode = state
.mode in
4840 state
.mode <- Textentry
(te, fun _ -> state
.mode <- mode);
4843 G.postRedisplay "view:enttext"
4845 let ctrl = Wsi.withctrl mask
in
4847 if key >= 0xffb0 && key < 0xffb9 then key - 0xffb0 + 48 else key
4853 if hasunsavedchanges
()
4857 if conf
.angle
mod 360 = 0 && not
(isbirdseye state
.mode)
4859 state
.mode <- LinkNav
(Ltgendir
0);
4862 else showtext '
!'
"Keyboard link navigation does not work under rotation"
4865 begin match state
.mstate
with
4868 G.postRedisplay "kill rect";
4871 | Mscrolly
| Mscrollx
4874 begin match state
.mode with
4877 G.postRedisplay "esc leave linknav"
4881 match state
.ranchors
with
4883 | (path, password, anchor, origin
) :: rest
->
4884 state
.ranchors
<- rest
;
4885 state
.anchor <- anchor;
4886 state
.origin
<- origin
;
4887 state
.nameddest
<- E.s;
4888 opendoc path password
4893 gotoghyll (getnav ~
-1)
4904 Hashtbl.iter
(fun _ opaque -> clearmark
opaque) state
.pagemap
;
4905 G.postRedisplay "dehighlight";
4907 | @slash
| @question
->
4908 let ondone isforw
s =
4909 cbput state
.hists
.pat
s;
4910 state
.searchpattern
<- s;
4913 let s = String.make
1 (Char.chr
key) in
4914 enttext (s, E.s, Some
(onhist state
.hists
.pat
),
4915 textentry, ondone (key = @slash
), true)
4917 | @plus
| @kpplus
| @equals
when ctrl ->
4918 let incr = if conf
.zoom +. 0.01 > 0.1 then 0.1 else 0.01 in
4919 setzoom (conf
.zoom +. incr)
4921 | @plus
| @kpplus
->
4924 try int_of_string
s with exc
->
4925 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
);
4931 state
.text <- "page bias is now " ^ string_of_int
n;
4934 enttext ("page bias: ", E.s, None
, intentry, ondone, true)
4936 | @minus
| @kpminus
when ctrl ->
4937 let decr = if conf
.zoom -. 0.1 < 0.1 then 0.01 else 0.1 in
4938 setzoom (max
0.01 (conf
.zoom -. decr))
4940 | @minus
| @kpminus
->
4941 let ondone msg
= state
.text <- msg
in
4943 "option [acfhilpstvxACFPRSZTISM]: ", E.s, None
,
4944 optentry state
.mode, ondone, true
4955 | (@1 | @2) when ctrl && conf
.fitmodel
!= FitPage
-> (* ctrl-1/2 *)
4957 match conf
.columns
with
4958 | Csingle
_ | Cmulti
_ -> 1
4959 | Csplit
(n, _) -> n
4961 let h = state
.winh
-
4962 conf
.interpagespace
lsl (if conf
.presentation
then 1 else 0)
4964 let zoom = zoomforh state
.winw
h (vscrollw ()) cols in
4965 if zoom > 0.0 && (key = 50 || zoom < 1.0)
4970 match conf
.fitmodel
with
4971 | FitWidth
-> FitProportional
4972 | FitProportional
-> FitPage
4973 | FitPage
-> FitWidth
4975 state
.text <- "fit model: " ^
FMTE.to_string
fm;
4976 reqlayout conf
.angle
fm
4984 | (48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57)
4985 when not
ctrl -> (* 0..9 *)
4988 try int_of_string
s with exc
->
4989 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
);
4995 cbput state
.hists
.pag
(string_of_int
n);
4996 gotopage1 (n + conf
.pagebias
- 1) 0;
4999 let pageentry text key =
5000 match Char.unsafe_chr
key with
5001 | '
g'
-> TEdone
text
5002 | _ -> intentry text key
5004 let text = String.make
1 (Char.chr
key) in
5005 enttext (":", text, Some
(onhist state
.hists
.pag
),
5006 pageentry, ondone, true)
5009 conf
.scrollb
<- if conf
.scrollb
= 0 then (scrollbvv
lor scrollbhv
) else 0;
5010 reshape state
.winw state
.winh
;
5013 state
.bzoom
<- not state
.bzoom
;
5015 showtext ' '
("block zoom " ^
if state
.bzoom
then "on" else "off")
5018 conf
.hlinks
<- not conf
.hlinks
;
5019 state
.text <- "highlightlinks " ^
if conf
.hlinks
then "on" else "off";
5020 G.postRedisplay "toggle highlightlinks";
5023 state
.glinks
<- true;
5024 let mode = state
.mode in
5025 state
.mode <- Textentry
(
5026 (":", E.s, None
, linknentry, linknact gotounder, false),
5028 state
.glinks
<- false;
5032 G.postRedisplay "view:linkent(F)"
5035 state
.glinks
<- true;
5036 let mode = state
.mode in
5037 state
.mode <- Textentry
(
5039 ":", E.s, None
, linknentry, linknact (fun under ->
5040 selstring (undertext under);
5044 state
.glinks
<- false;
5048 G.postRedisplay "view:linkent"
5051 begin match state
.autoscroll
with
5053 conf
.autoscrollstep
<- step
;
5054 state
.autoscroll
<- None
5056 if conf
.autoscrollstep
= 0
5057 then state
.autoscroll
<- Some
1
5058 else state
.autoscroll
<- Some conf
.autoscrollstep
5065 setpresentationmode (not conf
.presentation
);
5066 showtext ' '
("presentation mode " ^
5067 if conf
.presentation
then "on" else "off");
5070 if List.mem
Wsi.Fullscreen state
.winstate
5071 then Wsi.reshape conf
.cwinw conf
.cwinh
5072 else Wsi.fullscreen
()
5075 search state
.searchpattern
false
5078 search state
.searchpattern
true
5081 begin match state
.layout with
5084 gotoghyll (getpagey
l.pageno)
5090 | @delete
| @kpdelete
-> (* delete *)
5094 showtext ' '
(describe_location ());
5097 begin match state
.layout with
5100 Wsi.reshape (l.pagew
+ vscrollw ()) l.pageh
;
5105 enterbookmarkmode ()
5113 | @e when Buffer.length state
.errmsgs
> 0 ->
5118 match state
.layout with
5123 (s, 0, Oanchor
(getanchor1
l)) :: state
.bookmarks
5126 enttext ("bookmark: ", E.s, None
, textentry, ondone, true)
5130 showtext ' '
"Quick bookmark added";
5133 begin match state
.layout with
5135 let rect = getpdimrect
l.pagedimno
in
5139 (truncate
(1.8 *. (rect.(1) -. rect.(0))),
5140 truncate
(1.2 *. (rect.(3) -. rect.(0))))
5142 (truncate
(rect.(1) -. rect.(0)),
5143 truncate
(rect.(3) -. rect.(0)))
5145 let w = truncate
((float w)*.conf
.zoom)
5146 and h = truncate
((float h)*.conf
.zoom) in
5149 state
.anchor <- getanchor
();
5150 Wsi.reshape (w + vscrollw ()) (h + conf
.interpagespace
)
5152 G.postRedisplay "z";
5157 | @x -> state
.roam
()
5160 reqlayout (conf
.angle
+
5161 (if key = @Gt
then 30 else -30)) conf
.fitmodel
5165 bound
(conf
.colorscale
+. (if key = 93 then 0.1 else -0.1)) 0.0 1.0
5167 G.postRedisplay "brightness";
5169 | @c when state
.mode = View
->
5174 let m = (wadjsb () + state
.winw
- state
.w) / 2 in
5176 gotoy_and_clear_text state
.y
5180 match state
.prevcolumns
with
5181 | None
-> (1, 0, 0), 1.0
5182 | Some
(columns
, z
) ->
5185 | Csplit
(c, _) -> -c, 0, 0
5186 | Cmulti
((c, a, b), _) -> c, a, b
5187 | Csingle
_ -> 1, 0, 0
5191 setcolumns View
c a b;
5194 | @down
| @up
when ctrl && Wsi.withshift mask
->
5195 let zoom, x = state
.prevzoom
in
5199 | @k
| @up
| @kpup
->
5200 begin match state
.autoscroll
with
5202 begin match state
.mode with
5203 | Birdseye beye
-> upbirdseye 1 beye
5208 then gotoy_and_clear_text (clamp ~
-(state
.winh
/2))
5210 if not
(Wsi.withshift mask
) && conf
.presentation
5212 else gotoghyll1 true (clamp (-conf
.scrollstep
))
5216 setautoscrollspeed n false
5219 | @j
| @down
| @kpdown
->
5220 begin match state
.autoscroll
with
5222 begin match state
.mode with
5223 | Birdseye beye
-> downbirdseye 1 beye
5228 then gotoy_and_clear_text (clamp (state
.winh
/2))
5230 if not
(Wsi.withshift mask
) && conf
.presentation
5232 else gotoghyll1 true (clamp (conf
.scrollstep
))
5236 setautoscrollspeed n true
5239 | @left | @right
| @kpleft
| @kpright
when not
(Wsi.withalt mask
) ->
5245 else conf
.hscrollstep
5247 let dx = if key = @left || key = @kpleft
then dx else -dx in
5248 state
.x <- panbound (state
.x + dx);
5249 gotoy_and_clear_text state
.y
5252 G.postRedisplay "left/right"
5255 | @prior
| @kpprior
->
5259 match state
.layout with
5261 | l :: _ -> state
.y - l.pagey
5263 clamp (pgscale (-state
.winh
))
5267 | @next | @kpnext
->
5271 match List.rev state
.layout with
5273 | l :: _ -> getpagey
l.pageno
5275 clamp (pgscale state
.winh
)
5279 | @g | @home
| @kphome
->
5282 | @G
| @jend
| @kpend
->
5284 gotoghyll (clamp state
.maxy)
5286 | @right
| @kpright
when Wsi.withalt mask
->
5287 gotoghyll (getnav 1)
5288 | @left | @kpleft
when Wsi.withalt mask
->
5289 gotoghyll (getnav ~
-1)
5294 | @v when conf
.debug
->
5297 match getopaque l.pageno with
5300 let x0, y0, x1, y1 = pagebbox
opaque in
5301 let a,b = float x0, float y0 in
5302 let c,d = float x1, float y0 in
5303 let e,f = float x1, float y1 in
5304 let h,j
= float x0, float y1 in
5305 let rect = (a,b,c,d,e,f,h,j
) in
5307 state
.rects
<- (l.pageno, l.pageno mod 3, rect) :: state
.rects
;
5309 G.postRedisplay "v";
5312 let mode = state
.mode in
5313 let cmd = ref E.s in
5314 let onleave = function
5315 | Cancel
-> state
.mode <- mode
5318 match getopaque l.pageno with
5319 | Some
opaque -> pipesel opaque !cmd
5320 | None
-> ()) state
.layout;
5324 cbput state
.hists
.sel
s;
5328 "| ", !cmd, Some
(onhist state
.hists
.sel
), textentry, ondone, true
5330 G.postRedisplay "|";
5331 state
.mode <- Textentry
(te, onleave);
5334 vlog "huh? %s" (Wsi.keyname
key)
5337 let linknavkeyboard key mask
linknav =
5338 let getpage pageno =
5339 let rec loop = function
5341 | l :: _ when l.pageno = pageno -> Some
l
5342 | _ :: rest
-> loop rest
5343 in loop state
.layout
5345 let doexact (pageno, n) =
5346 match getopaque pageno, getpage pageno with
5347 | Some
opaque, Some
l ->
5348 if key = @enter
|| key = @kpenter
5350 let under = getlink
opaque n in
5351 G.postRedisplay "link gotounder";
5358 Some
(findlink
opaque LDfirst
), -1
5361 Some
(findlink
opaque LDlast
), 1
5364 Some
(findlink
opaque (LDleft
n)), -1
5367 Some
(findlink
opaque (LDright
n)), 1
5370 Some
(findlink
opaque (LDup
n)), -1
5373 Some
(findlink
opaque (LDdown
n)), 1
5378 begin match findpwl
l.pageno dir with
5382 state
.mode <- LinkNav
(Ltgendir
dir);
5383 let y, h = getpageyh
pageno in
5386 then y + h - state
.winh
5391 begin match getopaque pageno, getpage pageno with
5392 | Some
opaque, Some
_ ->
5394 let ld = if dir > 0 then LDfirst
else LDlast
in
5397 begin match link with
5399 showlinktype (getlink
opaque m);
5400 state
.mode <- LinkNav
(Ltexact
(pageno, m));
5401 G.postRedisplay "linknav jpage";
5402 | Lnotfound
-> notfound dir
5408 begin match opt with
5409 | Some Lnotfound
-> pwl l dir;
5410 | Some
(Lfound
m) ->
5414 let _, y0, _, y1 = getlinkrect
opaque m in
5416 then gotopage1 l.pageno y0
5418 let d = fstate
.fontsize
+ 1 in
5419 if y1 - l.pagey > l.pagevh - d
5420 then gotopage1 l.pageno (y1 - state
.winh
- hscrollh () + d)
5421 else G.postRedisplay "linknav";
5423 showlinktype (getlink
opaque m);
5424 state
.mode <- LinkNav
(Ltexact
(l.pageno, m));
5427 | None
-> viewkeyboard key mask
5429 | _ -> viewkeyboard key mask
5434 G.postRedisplay "leave linknav"
5438 | Ltgendir
_ | Ltnotready
_ -> viewkeyboard key mask
5439 | Ltexact exact
-> doexact exact
5442 let keyboard key mask
=
5443 if (key = 103 && Wsi.withctrl mask
) && not
(istextentry state
.mode)
5444 then wcmd "interrupt"
5445 else state
.uioh <- state
.uioh#
key key mask
5448 let birdseyekeyboard key mask
5449 ((oconf
, leftx
, pageno, hooverpageno
, anchor) as beye
) =
5451 match conf
.columns
with
5453 | Cmulti
((c, _, _), _) -> c
5454 | Csplit
_ -> failwith
"bird's eye split mode"
5456 let pgh layout = List.fold_left
5457 (fun m l -> max
l.pageh
m) state
.winh
layout in
5459 | @l when Wsi.withctrl mask
->
5460 let y, h = getpageyh
pageno in
5461 let top = (state
.winh
- h) / 2 in
5462 gotoy (max
0 (y - top))
5463 | @enter
| @kpenter
-> leavebirdseye beye
false
5464 | @escape
-> leavebirdseye beye
true
5465 | @up
-> upbirdseye incr beye
5466 | @down
-> downbirdseye incr beye
5467 | @left -> upbirdseye 1 beye
5468 | @right
-> downbirdseye 1 beye
5471 begin match state
.layout with
5475 state
.mode <- Birdseye
(
5476 oconf
, leftx
, l.pageno, hooverpageno
, anchor
5478 gotopage1 l.pageno 0;
5481 let layout = layout (state
.y-state
.winh
) (pgh state
.layout) in
5483 | [] -> gotoy (clamp (-state
.winh
))
5485 state
.mode <- Birdseye
(
5486 oconf
, leftx
, l.pageno, hooverpageno
, anchor
5488 gotopage1 l.pageno 0
5491 | [] -> gotoy (clamp (-state
.winh
))
5495 begin match List.rev state
.layout with
5497 let layout = layout (state
.y + (pgh state
.layout)) state
.winh
in
5498 begin match layout with
5500 let incr = l.pageh
- l.pagevh in
5505 oconf
, leftx
, state
.pagecount
- 1, hooverpageno
, anchor
5507 G.postRedisplay "birdseye pagedown";
5509 else gotoy (clamp (incr + conf
.interpagespace
*2));
5513 Birdseye
(oconf
, leftx
, l.pageno, hooverpageno
, anchor);
5514 gotopage1 l.pageno 0;
5517 | [] -> gotoy (clamp state
.winh
)
5521 state
.mode <- Birdseye
(oconf
, leftx
, 0, hooverpageno
, anchor);
5525 let pageno = state
.pagecount
- 1 in
5526 state
.mode <- Birdseye
(oconf
, leftx
, pageno, hooverpageno
, anchor);
5527 if not
(pagevisible state
.layout pageno)
5530 match List.rev state
.pdims
with
5532 | (_, _, h, _) :: _ -> h
5534 gotoy (max
0 (getpagey
pageno - (state
.winh
- h - conf
.interpagespace
)))
5535 else G.postRedisplay "birdseye end";
5537 | _ -> viewkeyboard key mask
5542 match state
.mode with
5543 | Textentry
_ -> scalecolor 0.4
5545 | View
-> scalecolor 1.0
5546 | Birdseye
(_, _, pageno, hooverpageno
, _) ->
5547 if l.pageno = hooverpageno
5550 if l.pageno = pageno
5552 let c = scalecolor 1.0 in
5554 GlDraw.line_width
3.0;
5555 let dispx = xadjsb () + l.pagedispx in
5557 (float (dispx-1)) (float (l.pagedispy-1))
5558 (float (dispx+l.pagevw+1))
5559 (float (l.pagedispy+l.pagevh+1))
5561 GlDraw.line_width
1.0;
5570 let postdrawpage l linkindexbase
=
5571 match getopaque l.pageno with
5573 if tileready l l.pagex
l.pagey
5575 let x = l.pagedispx - l.pagex
+ xadjsb ()
5576 and y = l.pagedispy - l.pagey in
5578 match conf
.columns
with
5579 | Csingle
_ | Cmulti
_ ->
5580 (if conf
.hlinks
then 1 else 0)
5582 && not
(isbirdseye state
.mode) then 2 else 0)
5586 match state
.mode with
5587 | Textentry
((_, s, _, _, _, _), _) when state
.glinks
-> s
5593 postprocess
opaque hlmask x y (linkindexbase
, s, conf
.hfsize
);
5598 let scrollindicator () =
5599 let sbw, ph
, sh = state
.uioh#
scrollph in
5600 let sbh, pw, sw = state
.uioh#scrollpw
in
5605 else ((state
.winw
- sbw), state
.winw
, 0)
5608 GlDraw.color (0.64, 0.64, 0.64);
5609 filledrect (float x0) 0. (float x1) (float state
.winh
);
5611 (float hx0
) (float (state
.winh
- sbh))
5612 (float (hx0
+ wadjsb () + state
.winw
)) (float state
.winh
)
5614 GlDraw.color (0.0, 0.0, 0.0);
5616 filledrect (float x0) ph
(float x1) (ph
+. sh);
5617 let pw = pw +. float hx0
in
5618 filledrect pw (float (state
.winh
- sbh)) (pw +. sw) (float state
.winh
);
5622 match state
.mstate
with
5623 | Mnone
| Mscrolly
| Mscrollx
| Mpan
_ | Mzoom
_ | Mzoomrect
_ ->
5626 | Msel
((x0, y0), (x1, y1)) ->
5627 let identify opaque l px py = Some
(opaque, l.pageno, px, py) in
5628 let o0,n0
,px0
,py0
= onppundermouse identify x0 y0 (~
< E.s, -1, 0, 0) in
5629 let _o1,n1
,px1
,py1
= onppundermouse identify x1 y1 (~
< E.s, -1, 0, 0) in
5630 if n0
!= -1 && n0
= n1
then seltext
o0 (px0
, py0
, px1
, py1
);
5633 let showrects = function [] -> () | rects
->
5635 GlDraw.color (0.0, 0.0, 1.0) ~
alpha:0.5;
5636 GlFunc.blend_func ~
src:`src_alpha ~dst
:`one_minus_src_alpha
;
5638 (fun (pageno, c, (x0, y0, x1, y1, x2
, y2
, x3
, y3
)) ->
5640 if l.pageno = pageno
5642 let dx = float (l.pagedispx - l.pagex
) in
5643 let dy = float (l.pagedispy - l.pagey) in
5644 GlDraw.color (0.0, 0.0, 1.0 /. float c) ~
alpha:0.5;
5645 Raw.sets_float state
.vraw ~
pos:0
5650 GlArray.vertex `two state
.vraw
;
5651 GlArray.draw_arrays `triangle_strip ~
first:0 ~count
:4;
5660 GlClear.color (scalecolor2 conf
.bgcolor
);
5661 GlClear.clear
[`
color];
5662 List.iter
drawpage state
.layout;
5664 match state
.mode with
5665 | LinkNav
(Ltexact
(pageno, linkno
)) ->
5666 begin match getopaque pageno with
5668 let dx = xadjsb () in
5669 let x0, y0, x1, y1 = getlinkrect
opaque linkno
in
5670 let x0 = x0 + dx and x1 = x1 + dx in
5677 | None
-> state
.rects
5679 | LinkNav
(Ltgendir
_) | LinkNav
(Ltnotready
_)
5682 | View
-> state
.rects
5685 let rec postloop linkindexbase
= function
5687 let linkindexbase = linkindexbase + postdrawpage l linkindexbase in
5688 postloop linkindexbase rest
5692 postloop 0 state
.layout;
5694 begin match state
.mstate
with
5695 | Mzoomrect
((x0, y0), (x1, y1)) ->
5697 GlDraw.color (0.3, 0.3, 0.3) ~
alpha:0.5;
5698 GlFunc.blend_func ~
src:`src_alpha ~dst
:`one_minus_src_alpha
;
5699 filledrect (float x0) (float y0) (float x1) (float y1);
5703 | Mscrolly
| Mscrollx
5712 let zoomrect x y x1 y1 =
5715 and y0 = min
y y1 in
5716 gotoy (state
.y + y0);
5717 state
.anchor <- getanchor
();
5718 let zoom = (float state
.w) /. float (x1 - x0) in
5721 let adjw = wadjsb () + state
.winw
in
5723 then (adjw - state
.w) / 2
5726 match conf
.fitmodel
with
5727 | FitWidth
| FitProportional
-> simple ()
5729 match conf
.columns
with
5731 onppundermouse (fun _ l _ _ -> Some
l.pagedispx) x0 y0 x0
5732 | Cmulti
_ | Csingle
_ -> simple ()
5734 state
.x <- (state
.x + margin) - x0;
5739 let annot inline
x y =
5740 match unproject x y with
5741 | Some
(opaque, n, ux
, uy
) ->
5743 addannot
opaque ux uy
text;
5744 wcmd "freepage %s" (~
> opaque);
5745 Hashtbl.remove state
.pagemap
(n, state
.gen
);
5751 let ondone s = add s in
5752 let mode = state
.mode in
5753 state
.mode <- Textentry
(
5754 ("annotation: ", E.s, None
, textentry, ondone, true),
5755 fun _ -> state
.mode <- mode);
5758 G.postRedisplay "annot"
5761 let s = getusertext E.s in
5762 let l = Str.split newlinere
s in
5770 let g opaque l px py =
5771 match rectofblock
opaque px py with
5773 let x0 = a.(0) -. 20. in
5774 let x1 = a.(1) +. 20. in
5775 let y0 = a.(2) -. 20. in
5776 let zoom = (float state
.w) /. (x1 -. x0) in
5777 let pagey = getpagey
l.pageno in
5778 gotoy_and_clear_text (pagey + truncate
y0);
5779 state
.anchor <- getanchor
();
5780 let margin = (state
.w - l.pagew
)/2 in
5781 state
.x <- -truncate
x0 - margin;
5786 match conf
.columns
with
5788 showtext '
!'
"block zooming does not work properly in split columns mode"
5789 | Cmulti
_ | Csingle
_ -> onppundermouse g x y ()
5793 let winw = wadjsb () + state
.winw - 1 in
5794 let s = float x /. float winw in
5795 let destx = truncate
(float (state
.w + winw) *. s) in
5796 state
.x <- winw - destx;
5797 gotoy_and_clear_text state
.y;
5798 state
.mstate
<- Mscrollx
;
5802 let s = float y /. float state
.winh
in
5803 let desty = truncate
(float (state
.maxy - state
.winh
) *. s) in
5804 gotoy_and_clear_text desty;
5805 state
.mstate
<- Mscrolly
;
5808 let viewmulticlick clicks
x y mask
=
5809 let g opaque l px py =
5817 if markunder
opaque px py mark
5821 match getopaque l.pageno with
5823 | Some
opaque -> pipesel opaque cmd
5825 state
.roam
<- (fun () -> dopipe conf
.paxcmd
);
5826 if not
(Wsi.withctrl mask
) then dopipe conf
.selcmd
;
5831 G.postRedisplay "viewmulticlick";
5832 onppundermouse g x y (fun () -> showtext '
!'
"Nothing to select") ();
5836 match conf
.columns
with
5838 | Csingle
_ | Cmulti
_ -> conf
.angle
mod 360 = 0
5841 let viewmouse button down
x y mask
=
5843 | n when (n == 4 || n == 5) && not down
->
5844 if Wsi.withctrl mask
5846 match state
.mstate
with
5847 | Mzoom
(oldn
, i
) ->
5855 if conf
.zoom +. 0.01 > 0.1 then 0.1 else 0.01
5857 if conf
.zoom -. 0.1 < 0.1 then -0.01 else -0.1
5859 let zoom = conf
.zoom -. incr in
5861 state
.mstate
<- Mzoom
(n, 0);
5863 state
.mstate
<- Mzoom
(n, i
+1);
5865 else state
.mstate
<- Mzoom
(n, 0)
5869 | Mscrolly
| Mscrollx
5871 | Mnone
-> state
.mstate
<- Mzoom
(n, 0)
5874 match state
.autoscroll
with
5875 | Some step
-> setautoscrollspeed step
(n=4)
5877 if conf
.wheelbypage
|| conf
.presentation
5886 then -conf
.scrollstep
5887 else conf
.scrollstep
5889 let incr = incr * 2 in
5890 let y = clamp incr in
5891 gotoy_and_clear_text y
5894 | n when (n = 6 || n = 7) && not down
&& canpan () ->
5896 panbound (state
.x + (if n = 7 then -2 else 2) * conf
.hscrollstep
);
5897 gotoy_and_clear_text state
.y
5899 | 1 when Wsi.withshift mask
->
5900 state
.mstate
<- Mnone
;
5903 match unproject x y with
5904 | Some
(_, pageno, ux
, uy
) ->
5905 let cmd = Printf.sprintf
5907 conf
.stcmd state
.path pageno ux uy
5909 addpid
@@ popen
cmd []
5913 | 1 when Wsi.withctrl mask
->
5916 Wsi.setcursor
Wsi.CURSOR_CROSSHAIR
;
5917 state
.mstate
<- Mpan
(x, y)
5920 state
.mstate
<- Mnone
5925 if Wsi.withshift mask
5927 annot conf
.annotinline
x y;
5928 G.postRedisplay "addannot"
5932 Wsi.setcursor
Wsi.CURSOR_CYCLE
;
5933 state
.mstate
<- Mzoomrect
(p, p)
5936 match state
.mstate
with
5937 | Mzoomrect
((x0, y0), _) ->
5938 if abs
(x-x0) > 10 && abs
(y - y0) > 10
5939 then zoomrect x0 y0 x y
5942 G.postRedisplay "kill accidental zoom rect";
5946 | Mscrolly
| Mscrollx
5952 | 1 when x > state
.winw - vscrollw () ->
5955 let _, position, sh = state
.uioh#
scrollph in
5956 if y > truncate
position && y < truncate
(position +. sh)
5957 then state
.mstate
<- Mscrolly
5960 state
.mstate
<- Mnone
5962 | 1 when y > state
.winh
- hscrollh () ->
5965 let _, position, sw = state
.uioh#scrollpw
in
5966 if x > truncate
position && x < truncate
(position +. sw)
5967 then state
.mstate
<- Mscrollx
5970 state
.mstate
<- Mnone
5972 | 1 when state
.bzoom
-> if not down
then zoomblock x y
5975 let dest = if down
then getunder x y else Unone
in
5976 begin match dest with
5979 | Uremote
_ | Uremotedest
_
5980 | Uunexpected
_ | Ulaunch
_ | Unamed
_ ->
5983 | Unone
when down
->
5984 Wsi.setcursor
Wsi.CURSOR_CROSSHAIR
;
5985 state
.mstate
<- Mpan
(x, y);
5987 | Uannotation
(opaque, slinkindex
) -> enterannotmode opaque slinkindex
5989 | Unone
| Utext
_ ->
5994 state
.mstate
<- Msel
((x, y), (x, y));
5995 G.postRedisplay "mouse select";
5999 match state
.mstate
with
6002 | Mzoom
_ | Mscrollx
| Mscrolly
->
6003 state
.mstate
<- Mnone
6005 | Mzoomrect
((x0, y0), _) ->
6009 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
6010 state
.mstate
<- Mnone
6012 | Msel
((x0, y0), (x1, y1)) ->
6013 let rec loop = function
6017 let a0 = l.pagedispy in
6018 let a1 = a0 + l.pagevh in
6019 let b0 = l.pagedispx in
6020 let b1 = b0 + l.pagevw in
6021 ((y0 >= a0 && y0 <= a1) || (y1 >= a0 && y1 <= a1))
6022 && ((x0 >= b0 && x0 <= b1) || (x1 >= b0 && x1 <= b1))
6026 match getopaque l.pageno with
6029 match Unix.pipe
() with
6033 "can not create sel pipe: %s"
6037 Ne.clo fd
(fun msg
->
6038 dolog
"%s close failed: %s" what msg
)
6041 try popen
cmd [r
, 0; w, -1]
6043 dolog
"can not execute %S: %s"
6050 G.postRedisplay "copysel";
6052 else clo "Msel pipe/w" w;
6053 clo "Msel pipe/r" r
;
6055 dosel conf
.selcmd
();
6056 state
.roam
<- dosel conf
.paxcmd
;
6068 let birdseyemouse button down
x y mask
6069 (conf
, leftx
, _, hooverpageno
, anchor) =
6072 let rec loop = function
6075 if y > l.pagedispy && y < l.pagedispy + l.pagevh
6076 && x > l.pagedispx && x < l.pagedispx + l.pagevw
6078 leavebirdseye (conf
, leftx
, l.pageno, hooverpageno
, anchor) false;
6084 | _ -> viewmouse button down
x y mask
6090 method key key mask
=
6091 begin match state
.mode with
6092 | Textentry
textentry -> textentrykeyboard key mask
textentry
6093 | Birdseye
birdseye -> birdseyekeyboard key mask
birdseye
6094 | View
-> viewkeyboard key mask
6095 | LinkNav
linknav -> linknavkeyboard key mask
linknav
6099 method button button bstate
x y mask
=
6100 begin match state
.mode with
6102 | View
-> viewmouse button bstate
x y mask
6103 | Birdseye beye
-> birdseyemouse button bstate
x y mask beye
6108 method multiclick clicks
x y mask
=
6109 begin match state
.mode with
6111 | View
-> viewmulticlick clicks
x y mask
6118 begin match state
.mode with
6120 | View
| Birdseye
_ | LinkNav
_ ->
6121 match state
.mstate
with
6122 | Mzoom
_ | Mnone
-> ()
6127 state
.mstate
<- Mpan
(x, y);
6129 then state
.x <- panbound (state
.x + dx);
6131 gotoy_and_clear_text y
6134 state
.mstate
<- Msel
(a, (x, y));
6135 G.postRedisplay "motion select";
6138 let y = min state
.winh
(max
0 y) in
6142 let x = min state
.winw (max
0 x) in
6145 | Mzoomrect
(p0
, _) ->
6146 state
.mstate
<- Mzoomrect
(p0
, (x, y));
6147 G.postRedisplay "motion zoomrect";
6151 method pmotion
x y =
6152 begin match state
.mode with
6153 | Birdseye
(conf
, leftx
, pageno, hooverpageno
, anchor) ->
6154 let rec loop = function
6156 if hooverpageno
!= -1
6158 state
.mode <- Birdseye
(conf
, leftx
, pageno, -1, anchor);
6159 G.postRedisplay "pmotion birdseye no hoover";
6162 if y > l.pagedispy && y < l.pagedispy + l.pagevh
6163 && x > l.pagedispx && x < l.pagedispx + l.pagevw
6165 state
.mode <- Birdseye
(conf
, leftx
, pageno, l.pageno, anchor);
6166 G.postRedisplay "pmotion birdseye hoover";
6176 match state
.mstate
with
6177 | Mpan
_ | Msel
_ | Mzoom
_ | Mscrolly
| Mscrollx
| Mzoomrect
_ -> ()
6185 let past, _, _ = !r
in
6187 let delta = now -. past in
6190 else r
:= (now, x, y)
6194 method infochanged
_ = ()
6197 let maxy = state
.maxy - (if conf
.maxhfit
then state
.winh
else 0) in
6200 then 0.0, float state
.winh
6201 else scrollph state
.y maxy
6206 let winw = wadjsb () + state
.winw in
6207 let fwinw = float winw in
6209 let sw = fwinw /. float state
.w in
6210 let sw = fwinw *. sw in
6211 max
sw (float conf
.scrollh
)
6214 let maxx = state
.w + winw in
6215 let x = winw - state
.x in
6216 let percent = float x /. float maxx in
6217 (fwinw -. sw) *. percent
6219 hscrollh (), position, sw
6223 match state
.mode with
6224 | LinkNav
_ -> "links"
6225 | Textentry
_ -> "textentry"
6226 | Birdseye
_ -> "birdseye"
6229 findkeyhash conf
modename
6231 method eformsgs
= true
6232 method alwaysscrolly
= false
6235 let adderrmsg src msg
=
6236 Buffer.add_string state
.errmsgs msg
;
6237 state
.newerrmsgs
<- true;
6241 let adderrfmt src fmt
=
6242 Format.ksprintf
(fun s -> adderrmsg src s) fmt
;
6246 let cl = splitatspace cmds
in
6248 try Scanf.sscanf
s fmt
f
6250 adderrfmt "remote exec"
6251 "error processing '%S': %s\n" cmds
(exntos exn
)
6254 | "reload" :: [] -> reload ()
6255 | "goto" :: args
:: [] ->
6256 scan args
"%u %f %f"
6258 let cmd, _ = state
.geomcmds
in
6260 then gotopagexy pageno x y
6263 gotopagexy pageno x y;
6266 state
.reprf
<- f state
.reprf
6268 | "goto1" :: args
:: [] -> scan args
"%u %f" gotopage
6269 | "gotor" :: args
:: [] ->
6271 (fun filename
pageno -> gotounder (Uremote
(filename
, pageno)))
6272 | "gotord" :: args
:: [] ->
6274 (fun filename
dest -> gotounder (Uremotedest
(filename
, dest)))
6275 | "rect" :: args
:: [] ->
6276 scan args
"%u %u %f %f %f %f"
6277 (fun pageno color x0 y0 x1 y1 ->
6278 onpagerect pageno (fun w h ->
6279 let _,w1,h1
,_ = getpagedim
pageno in
6280 let sw = float w1 /. float w
6281 and sh = float h1
/. float h in
6285 and y1s
= y1 *. sh in
6286 let rect = (x0s,y0s
,x1s
,y0s
,x1s
,y1s
,x0s,y1s
) in
6288 state
.rects <- (pageno, color, rect) :: state
.rects;
6289 G.postRedisplay "rect";
6292 | "activatewin" :: [] -> Wsi.activatewin
()
6293 | "quit" :: [] -> raise Quit
6295 adderrfmt "remote command"
6296 "error processing remote command: %S\n" cmds
;
6300 let scratch = Bytes.create
80 in
6301 let buf = Buffer.create
80 in
6304 try Some
(Unix.read fd
scratch 0 80)
6306 | Unix.Unix_error
(Unix.EAGAIN
, _, _) -> None
6307 | Unix.Unix_error
(Unix.EINTR
, _, _) -> tempfr ()
6310 match tempfr () with
6316 if Buffer.length
buf > 0
6318 let s = Buffer.contents
buf in
6328 let pos = Bytes.index_from
scratch ppos '
\n'
in
6329 if pos >= n then -1 else pos
6330 with Not_found
-> -1
6334 Buffer.add_subbytes
buf scratch ppos
(nlpos-ppos
);
6335 let s = Buffer.contents
buf in
6341 Buffer.add_subbytes
buf scratch ppos
(n-ppos
);
6347 let remoteopen path =
6348 try Some
(Unix.openfile
path [Unix.O_NONBLOCK
; Unix.O_RDONLY
] 0o0)
6350 adderrfmt "remoteopen" "error opening %S: %s" path (exntos exn
);
6355 let gcconfig = ref E.s in
6356 let trimcachepath = ref E.s in
6357 let rcmdpath = ref E.s in
6358 let pageno = ref None
in
6359 let rootwid = ref 0 in
6360 let openlast = ref false in
6361 let nofc = ref false in
6362 let doreap = ref false in
6363 selfexec := Sys.executable_name
;
6366 [("-p", Arg.String
(fun s -> state
.password <- s),
6367 "<password> Set password");
6371 Config.fontpath
:= s;
6372 selfexec := !selfexec ^
" -f " ^
Filename.quote
s;
6374 "<path> Set path to the user interface font");
6378 selfexec := !selfexec ^
" -c " ^
Filename.quote
s;
6379 Config.confpath
:= s),
6380 "<path> Set path to the configuration file");
6382 ("-last", Arg.Set
openlast, " Open last document");
6384 ("-page", Arg.Int
(fun pageno1
-> pageno := Some
(pageno1
-1)),
6385 "<page-number> Jump to page");
6387 ("-tcf", Arg.String
(fun s -> trimcachepath := s),
6388 "<path> Set path to the trim cache file");
6390 ("-dest", Arg.String
(fun s -> state
.nameddest
<- s),
6391 "<named-destination> Set named destination");
6393 ("-wtmode", Arg.Set
wtmode, " Operate in wt mode");
6394 ("-cxack", Arg.Set
cxack, " Cut corners");
6396 ("-remote", Arg.String
(fun s -> rcmdpath := s),
6397 "<path> Set path to the remote commands source");
6399 ("-origin", Arg.String
(fun s -> state
.origin
<- s),
6400 "<original-path> Set original path");
6402 ("-gc", Arg.Set_string
gcconfig,
6403 "<script-path> Collect garbage with the help of a script");
6405 ("-nofc", Arg.Set
nofc, " Do not use fontconfig");
6407 ("-v", Arg.Unit
(fun () ->
6409 "%s\nconfiguration path: %s\n"
6413 exit
0), " Print version and exit");
6415 ("-embed", Arg.Set_int
rootwid,
6416 "<window-id> Embed into window")
6419 (fun s -> state
.path <- s)
6420 ("Usage: " ^
Sys.argv
.(0) ^
" [options] some.pdf\nOptions:")
6423 then selfexec := !selfexec ^
" -wtmode";
6425 let histmode = emptystr state
.path && not
!openlast in
6427 if not
(Config.load !openlast)
6428 then prerr_endline
"failed to load configuration";
6429 begin match !pageno with
6430 | Some
pageno -> state
.anchor <- (pageno, 0.0, 0.0)
6434 if nonemptystr
!gcconfig
6437 match Unix.socketpair
Unix.PF_UNIX
Unix.SOCK_STREAM
0 with
6439 error
"gc socketpair failed: %s" (exntos exn
)
6442 match addpid
@@ popen
!gcconfig [(c, 0); (c, 1)] with
6444 error
"failed to popen gc script: %s" (exntos exn
);
6450 let wsfd, winw, winh
= Wsi.init
(object (self)
6451 val mutable m_clicks
= 0
6452 val mutable m_click_x
= 0
6453 val mutable m_click_y
= 0
6454 val mutable m_lastclicktime
= infinity
6456 method private cleanup =
6457 state
.roam
<- noroam
;
6458 Hashtbl.iter
(fun _ opaque -> clearmark
opaque) state
.pagemap
6459 method expose
= G.postRedisplay"expose"
6463 | Wsi.Unobscured
-> "unobscured"
6464 | Wsi.PartiallyObscured
-> "partiallyobscured"
6465 | Wsi.FullyObscured
-> "fullyobscured"
6467 vlog "visibility change %s" name
6468 method display = display ()
6469 method map mapped
= vlog "mappped %b" mapped
6470 method reshape w h =
6473 method mouse
b d x y m =
6474 if d && canselect ()
6476 (* http://blogs.msdn.com/b/oldnewthing/archive/2004/10/18/243925.aspx *)
6482 if abs
x - m_click_x
> 10
6483 || abs
y - m_click_y
> 10
6484 || abs_float
(t -. m_lastclicktime
) > 0.3
6486 m_clicks
<- m_clicks
+ 1;
6487 m_lastclicktime
<- t;
6491 G.postRedisplay "cleanup";
6492 state
.uioh <- state
.uioh#button
b d x y m;
6494 else state
.uioh <- state
.uioh#multiclick m_clicks
x y m
6499 m_lastclicktime
<- infinity
;
6500 state
.uioh <- state
.uioh#button
b d x y m
6504 state
.uioh <- state
.uioh#button
b d x y m
6507 state
.mpos
<- (x, y);
6508 state
.uioh <- state
.uioh#motion
x y
6509 method pmotion
x y =
6510 state
.mpos
<- (x, y);
6511 state
.uioh <- state
.uioh#pmotion
x y
6513 let mascm = m land (
6514 Wsi.altmask
+ Wsi.shiftmask
+ Wsi.ctrlmask
+ Wsi.metamask
6517 let x = state
.x and y = state
.y in
6519 if x != state
.x || y != state
.y then self#
cleanup
6521 match state
.keystate
with
6523 let km = k
, mascm in
6526 let modehash = state
.uioh#
modehash in
6527 try Hashtbl.find modehash km
6529 try Hashtbl.find (findkeyhash conf
"global") km
6530 with Not_found
-> KMinsrt
(k
, m)
6532 | KMinsrt
(k
, m) -> keyboard k
m
6533 | KMinsrl
l -> List.iter
(fun (k
, m) -> keyboard k
m) l
6534 | KMmulti
(l, r
) -> state
.keystate
<- KSinto
(l, r
)
6536 | KSinto
((k'
, m'
) :: [], insrt
) when k'
=k
&& m'
land mascm = m'
->
6537 List.iter
(fun (k
, m) -> keyboard k
m) insrt
;
6538 state
.keystate
<- KSnone
6539 | KSinto
((k'
, m'
) :: keys, insrt
) when k'
=k
&& m'
land mascm = m'
->
6540 state
.keystate
<- KSinto
(keys, insrt
)
6541 | KSinto
_ -> state
.keystate
<- KSnone
6544 state
.mpos
<- (x, y);
6545 state
.uioh <- state
.uioh#pmotion
x y
6546 method leave = state
.mpos
<- (-1, -1)
6547 method winstate wsl
= state
.winstate
<- wsl
6548 method quit
= raise Quit
6549 end) !rootwid conf
.cwinw conf
.cwinh platform
in
6554 List.exists
GlMisc.check_extension
6555 [ "GL_ARB_texture_rectangle"
6556 ; "GL_EXT_texture_recangle"
6557 ; "GL_NV_texture_rectangle" ]
6559 then (prerr_endline
"OpenGL does not suppport rectangular textures"; exit
1);
6562 let r = GlMisc.get_string `renderer
in
6563 let p = "Mesa DRI Intel(" in
6564 let l = String.length
p in
6565 String.length
r > l && String.sub
r 0 l = p
6568 defconf
.sliceheight
<- 1024;
6569 defconf
.texcount
<- 32;
6570 defconf
.usepbo
<- true;
6574 match Unix.socketpair
Unix.PF_UNIX
Unix.SOCK_STREAM
0 with
6576 Printf.eprintf
"socketpair failed: %s" (exntos exn
);
6584 setcheckers conf
.checkers
;
6586 if conf
.redirectstderr
6590 (Buffer.to_bytes state
.errmsgs
)
6591 (match state
.errfd
with
6593 let s = Bytes.create
(80*24) in
6596 let r, _, _ = Unix.select
[fd
] [] [] 0.0 in
6598 then Unix.read fd
s 0 (Bytes.length
s)
6604 else Bytes.sub
s 0 n
6608 try ignore
(Unix.write state
.stderr
s 0 (Bytes.length
s))
6609 with exn
-> print_endline
(exntos exn
)
6614 conf
.angle
, conf
.fitmodel
, (conf
.trimmargins
, conf
.trimfuzz
),
6615 conf
.texcount
, conf
.sliceheight
, conf
.mustoresize
, conf
.colorspace
,
6616 !Config.fontpath
, !trimcachepath,
6617 GlMisc.check_extension
"GL_ARB_pixel_buffer_object",
6620 List.iter
GlArray.enable
[`texture_coord
; `vertex
];
6622 reshape ~firsttime
:true winw winh
;
6626 Wsi.settitle
"llpp (history)";
6630 state
.text <- "Opening " ^
(mbtoutf8 state
.path);
6631 opendoc state
.path state
.password;
6635 Sys.set_signal
Sys.sighup
(Sys.Signal_handle
(fun _ -> reload ()));
6638 match Unix.waitpid
[Unix.WNOHANG
] ~
-1 with
6639 | (exception (Unix.Unix_error
(Unix.ECHILD
, _, _))) -> ()
6640 | (exception exn
) -> dolog
"Unix.waitpid: %s" @@ exntos exn
6642 | _pid
, _status
-> reap ()
6644 Sys.set_signal
Sys.sigchld
(Sys.Signal_handle
(fun _ -> doreap := true));
6648 if nonemptystr
!rcmdpath
6649 then remoteopen !rcmdpath
6654 let rec loop deadline
=
6661 match state
.errfd
with
6662 | None
-> [state
.ss; state
.wsfd]
6663 | Some fd
-> [state
.ss; state
.wsfd; fd
]
6668 | Some fd
-> fd
:: r
6672 state
.redisplay
<- false;
6679 if deadline
= infinity
6681 else max
0.0 (deadline
-. now)
6686 try Unix.select
r [] [] timeout
6687 with Unix.Unix_error
(Unix.EINTR
, _, _) -> [], [], []
6693 if state
.ghyll
== noghyll
6695 match state
.autoscroll
with
6696 | Some step
when step
!= 0 ->
6697 let y = state
.y + step
in
6701 else if y >= state
.maxy then 0 else y
6704 if state
.mode = View
6705 then state
.text <- E.s;
6708 else deadline
+. 0.01
6713 let rec checkfds = function
6715 | fd
:: rest
when fd
= state
.ss ->
6716 let cmd = readcmd state
.ss in
6720 | fd
:: rest
when fd
= state
.wsfd ->
6724 | fd
:: rest
when Some fd
= !optrfd ->
6725 begin match remote fd
with
6726 | None
-> optrfd := remoteopen !rcmdpath;
6727 | opt -> optrfd := opt
6732 let s = Bytes.create
80 in
6733 let n = tempfailureretry
(Unix.read fd
s 0) 80 in
6734 if conf
.redirectstderr
6736 Buffer.add_substring state
.errmsgs
(Bytes.to_string
s) 0 n;
6737 state
.newerrmsgs
<- true;
6738 state
.redisplay
<- true;
6741 prerr_string
(String.sub
(Bytes.to_string
s) 0 n);
6747 if !reenterhist then (
6749 reenterhist := false;
6753 if deadline
= infinity
6757 match state
.autoscroll
with
6758 | Some step
when step
!= 0 -> deadline1
6759 | _ -> if state
.ghyll
== noghyll
then infinity
else deadline1
6767 Config.save leavebirdseye;
6768 if hasunsavedchanges
()