6 external init
: Unix.file_descr
-> params
-> unit = "ml_init";;
7 external seltext
: opaque
-> (int * int * int * int) -> unit = "ml_seltext";;
8 external hassel
: opaque
-> bool = "ml_hassel";;
9 external copysel
: Unix.file_descr
-> opaque
-> unit = "ml_copysel";;
10 external getpdimrect
: int -> float array
= "ml_getpdimrect";;
11 external whatsunder
: opaque
-> int -> int -> under
= "ml_whatsunder";;
12 external markunder
: opaque
-> int -> int -> mark
-> bool = "ml_markunder";;
13 external clearmark
: opaque
-> unit = "ml_clearmark";;
14 external zoomforh
: int -> int -> int -> int -> float = "ml_zoom_for_height";;
15 external drawstr
: int -> int -> int -> string -> float = "ml_draw_string";;
16 external measurestr
: int -> string -> float = "ml_measure_string";;
17 external postprocess
:
18 opaque
-> int -> int -> int -> (int * string * int) -> int
20 external pagebbox
: opaque
-> (int * int * int * int) = "ml_getpagebox";;
21 external setaalevel
: int -> unit = "ml_setaalevel";;
22 external realloctexts
: int -> bool = "ml_realloctexts";;
23 external findlink
: opaque
-> linkdir
-> link
= "ml_findlink";;
24 external getlink
: opaque
-> int -> under
= "ml_getlink";;
25 external getlinkrect
: opaque
-> int -> irect
= "ml_getlinkrect";;
26 external getlinkcount
: opaque
-> int = "ml_getlinkcount";;
27 external findpwl
: int -> int -> pagewithlinks
= "ml_find_page_with_links";;
28 external getpbo
: width
-> height
-> colorspace
-> opaque
= "ml_getpbo";;
29 external freepbo
: opaque
-> unit = "ml_freepbo";;
30 external unmappbo
: opaque
-> unit = "ml_unmappbo";;
31 external pbousable
: unit -> bool = "ml_pbo_usable";;
32 external unproject
: opaque
-> int -> int -> (int * int) option
34 external drawtile
: tileparams
-> opaque
-> unit = "ml_drawtile";;
35 external rectofblock
: opaque
-> int -> int -> float array
option
37 external begintiles
: unit -> unit = "ml_begintiles";;
38 external endtiles
: unit -> unit = "ml_endtiles";;
39 external addannot
: opaque
-> int -> int -> string -> unit = "ml_addannot";;
40 external modannot
: opaque
-> slinkindex
-> string -> unit = "ml_modannot";;
41 external delannot
: opaque
-> slinkindex
-> unit = "ml_delannot";;
42 external hasunsavedchanges
: unit -> bool = "ml_hasunsavedchanges";;
43 external savedoc
: string -> unit = "ml_savedoc";;
44 external getannotcontents
: opaque
-> slinkindex
-> string
45 = "ml_getannotcontents";;
47 let reeenterhist = ref false;;
48 let selfexec = ref E.s
;;
50 let drawstring size x y s
=
52 Gl.enable `texture_2d
;
53 GlFunc.blend_func ~src
:`src_alpha ~dst
:`one_minus_src_alpha
;
54 ignore
(drawstr size x y s
);
56 Gl.disable `texture_2d
;
59 let drawstring1 size x y s
=
63 let drawstring2 size x y fmt
=
64 Printf.kprintf
(drawstring size
(x
+1) (y
+size
+1)) fmt
68 dolog
"l %d dim=%d {" l
.pageno l
.pagedimno
;
69 dolog
" WxH %dx%d" l
.pagew l
.pageh
;
70 dolog
" vWxH %dx%d" l
.pagevw l
.pagevh
;
71 dolog
" pagex,y %d,%d" l
.pagex l
.pagey
;
72 dolog
" dispx,y %d,%d" l
.pagedispx l
.pagedispy
;
73 dolog
" column %d" l
.pagecol
;
77 let debugrect (x0
, y0
, x1
, y1
, x2
, y2
, x3
, y3
) =
79 dolog
" x0,y0=(% f, % f)" x0 y0
;
80 dolog
" x1,y1=(% f, % f)" x1 y1
;
81 dolog
" x2,y2=(% f, % f)" x2 y2
;
82 dolog
" x3,y3=(% f, % f)" x3 y3
;
86 let isbirdseye = function
93 let istextentry = function
100 let wtmode = ref false;;
101 let cxack = ref false;;
103 let pgscale h
= truncate
(float h
*. conf
.pgscale);;
106 if not state
.uioh#alwaysscrolly
&& (conf
.scrollb
land scrollbhv
= 0)
107 || (state
.x
= 0 && state
.w
<= state
.winw
- conf
.scrollbw
)
113 if not state
.uioh#alwaysscrolly
&& (conf
.scrollb
land scrollbvv
= 0)
118 let wadjsb () = -vscrollw ();;
119 let xadjsb () = if conf
.leftscroll
then vscrollw () else 0;;
122 fstate
.fontsize
<- n
;
123 fstate
.wwidth
<- measurestr fstate
.fontsize
"w";
124 fstate
.maxrows
<- (state
.winh
- fstate
.fontsize
- 1) / (fstate
.fontsize
+ 1);
130 Printf.kprintf prerr_endline fmt
132 Printf.kprintf ignore fmt
135 let addpid pid
= if pid
> 0 then incr pidcount
;;
138 if emptystr conf
.pathlauncher
139 then print_endline state
.path
141 let command = Str.global_replace percentsre state
.path conf
.pathlauncher
in
142 try addpid @@ popen
command []
144 Printf.eprintf
"failed to execute `%s': %s\n" command (exntos exn
);
149 let redirectstderr () =
150 let clofail what errmsg
= dolog
"failed to close %s: %s" what errmsg
in
151 if conf
.redirectstderr
153 match Unix.pipe
() with
155 dolog
"failed to create stderr redirection pipes: %s" (exntos exn
)
158 begin match Unix.dup
Unix.stderr
with
160 dolog
"failed to dup stderr: %s" (exntos exn
);
161 Ne.clo r
(clofail "pipe/r");
162 Ne.clo w
(clofail "pipe/w");
165 begin match Unix.dup2 w
Unix.stderr
with
167 dolog
"failed to dup2 to stderr: %s" (exntos exn
);
168 Ne.clo dupstderr
(clofail "stderr duplicate");
169 Ne.clo r
(clofail "redir pipe/r");
170 Ne.clo w
(clofail "redir pipe/w");
173 state
.stderr
<- dupstderr
;
174 state
.errfd
<- Some r
;
178 state
.newerrmsgs
<- false;
179 begin match state
.errfd
with
181 begin match Unix.dup2 state
.stderr
Unix.stderr
with
183 dolog
"failed to dup2 original stderr: %s" (exntos exn
)
185 Ne.clo fd
(clofail "dup of stderr");
190 prerr_string
(Buffer.contents state
.errmsgs
);
192 Buffer.clear state
.errmsgs
;
198 let postRedisplay who
=
200 then prerr_endline
("redisplay for " ^ who
);
201 state
.redisplay
<- true;
205 let getopaque pageno
=
206 try Some
(Hashtbl.find state
.pagemap
(pageno
, state
.gen
))
207 with Not_found
-> None
210 let putopaque pageno opaque
=
211 Hashtbl.replace state
.pagemap
(pageno
, state
.gen
) opaque
214 let pagetranslatepoint l x y
=
215 let dy = y
- l
.pagedispy
in
216 let y = dy + l
.pagey
in
217 let dx = x
- l
.pagedispx
in
218 let x = dx + l
.pagex
in
222 let onppundermouse g
x y d
=
225 begin match getopaque l
.pageno
with
227 let x0 = l
.pagedispx
in
228 let x1 = x0 + l
.pagevw
in
229 let y0 = l
.pagedispy
in
230 let y1 = y0 + l
.pagevh
in
231 if y >= y0 && y <= y1 && x >= x0 && x <= x1
233 let px, py
= pagetranslatepoint l
x y in
234 match g opaque l
px py
with
247 let g opaque l
px py
=
250 match rectofblock opaque
px py
with
252 let rect = (a
.(0),a
.(2),a
.(1),a
.(2),a
.(1),a
.(3),a
.(0),a
.(3)) in
253 state
.rects
<- [l
.pageno
, l
.pageno
mod 3, rect];
254 G.postRedisplay "getunder";
257 let under = whatsunder opaque
px py
in
268 | Uannotation _
-> Some
under
270 onppundermouse g x y Unone
275 match unproject opaque
x y with
276 | Some
(x, y) -> Some
(Some
(opaque
, l
.pageno
, x, y))
279 onppundermouse g x y None
;
283 state
.text
<- Printf.sprintf
"%c%s" c s
;
284 G.postRedisplay "showtext";
287 let pipesel opaque cmd
=
290 match Unix.pipe
() with
293 (Printf.sprintf
"pipesel can not create pipe: %s" (exntos exn
));
295 let doclose what fd
=
296 Ne.clo fd
(fun msg
-> dolog
"%s close failed: %s" what msg
)
299 try popen cmd
[r
, 0; w
, -1]
301 dolog
"can not execute %S: %s" cmd
(exntos exn
);
308 G.postRedisplay "pipesel";
310 else doclose "pipesel pipe/w" w
;
311 doclose "pipesel pipe/r" r
;
315 let g opaque l
px py
=
316 if markunder opaque
px py conf
.paxmark
319 match getopaque l
.pageno
with
321 | Some opaque
-> pipesel opaque conf
.paxcmd
326 G.postRedisplay "paxunder";
327 if conf
.paxmark
= Mark_page
330 match getopaque l
.pageno
with
332 | Some opaque
-> clearmark opaque
) state
.layout
;
334 onppundermouse g x y (fun () -> showtext '
!'
"Whoopsie daisy");
338 match Unix.pipe
() with
340 showtext '
!'
(Printf.sprintf
"pipe failed: %s" (exntos exn
))
343 Ne.clo fd
(fun msg
->
344 showtext '
!'
(Printf.sprintf
"failed to close %s: %s" cap msg
)
348 try popen conf
.selcmd
[r
, 0; w
, -1]
351 (Printf.sprintf
"failed to execute %s: %s"
352 conf
.selcmd
(exntos exn
));
359 let l = String.length s
in
360 let bytes = Bytes.unsafe_of_string s
in
361 let n = tempfailureretry
(Unix.write w
bytes 0) l in
366 "failed to write %d characters to sel pipe, wrote %d"
371 (Printf.sprintf
"failed to write to sel pipe: %s"
376 clo "selstring pipe/r" r
;
377 clo "selstring pipe/w" w
;
380 let undertext = function
383 | Ulinkgoto
(pageno
, _
) -> Printf.sprintf
"%s: page %d" state
.path
(pageno
+1)
384 | Utext s
-> "font: " ^ s
385 | Uunexpected s
-> "unexpected: " ^ s
386 | Ulaunch s
-> "launch: " ^ s
387 | Unamed s
-> "named: " ^ s
388 | Uremote
(filename
, pageno
) ->
389 Printf.sprintf
"%s: page %d" filename
(pageno
+1)
390 | Uremotedest
(filename
, destname
) ->
391 Printf.sprintf
"%s: destination %S" filename destname
392 | Uannotation
(opaque
, slinkindex
) ->
393 "annotation: " ^ getannotcontents opaque slinkindex
396 let updateunder x y =
397 match getunder x y with
398 | Unone
-> Wsi.setcursor
Wsi.CURSOR_INHERIT
400 if conf
.underinfo
then showtext 'u'
("ri: " ^ uri
);
401 Wsi.setcursor
Wsi.CURSOR_INFO
402 | Ulinkgoto
(pageno
, _
) ->
404 then showtext 'p'
("age: " ^ string_of_int
(pageno
+1));
405 Wsi.setcursor
Wsi.CURSOR_INFO
407 if conf
.underinfo
then showtext '
f'
("ont: " ^ s
);
408 Wsi.setcursor
Wsi.CURSOR_TEXT
410 if conf
.underinfo
then showtext 'u'
("nexpected: " ^ s
);
411 Wsi.setcursor
Wsi.CURSOR_INHERIT
413 if conf
.underinfo
then showtext '
l'
("aunch: " ^ s
);
414 Wsi.setcursor
Wsi.CURSOR_INHERIT
416 if conf
.underinfo
then showtext '
n'
("amed: " ^ s
);
417 Wsi.setcursor
Wsi.CURSOR_INHERIT
418 | Uremote
(filename
, pageno
) ->
419 if conf
.underinfo
then showtext 'r'
420 (Printf.sprintf
"emote: %s (%d)" filename
(pageno
+1));
421 Wsi.setcursor
Wsi.CURSOR_INFO
422 | Uremotedest
(filename
, destname
) ->
423 if conf
.underinfo
then showtext 'r'
424 (Printf.sprintf
"emote destination: %s (%S)" filename destname
);
425 Wsi.setcursor
Wsi.CURSOR_INFO
427 if conf
.underinfo
then showtext 'a'
"nnotation";
428 Wsi.setcursor
Wsi.CURSOR_INFO
431 let showlinktype under =
445 let s = undertext under in
450 let b = Buffer.create
(String.length
s + 1) in
451 Buffer.add_string
b s;
456 let intentry_with_suffix text key
=
458 if key
>= 32 && key
< 127
462 match Char.lowercase
c with
464 let text = addchar text c in
468 let text = addchar text c in
472 state
.text <- Printf.sprintf
"invalid char (%d, `%c')" key
c;
477 let s = Bytes.create
4 in
478 let n = tempfailureretry
(Unix.read fd
s 0) 4 in
479 if n != 4 then error
"incomplete read(len) = %d" n;
480 let len = (Char.code
(Bytes.get
s 0) lsl 24)
481 lor (Char.code
(Bytes.get
s 1) lsl 16)
482 lor (Char.code
(Bytes.get
s 2) lsl 8)
483 lor (Char.code
(Bytes.get
s 3))
485 let s = Bytes.create
len in
486 let n = tempfailureretry
(Unix.read fd
s 0) len in
487 if n != len then error
"incomplete read(data) %d vs %d" n len;
491 let btod b = if b then 1 else 0;;
494 let b = Buffer.create
16 in
495 Buffer.add_string
b "llll";
498 let s = Buffer.to_bytes
b in
499 let n = Bytes.length
s in
501 (* dolog "wcmd %S" (String.sub s 4 len); *)
502 Bytes.set
s 0 (Char.chr
((len lsr 24) land 0xff));
503 Bytes.set
s 1 (Char.chr
((len lsr 16) land 0xff));
504 Bytes.set
s 2 (Char.chr
((len lsr 8) land 0xff));
505 Bytes.set
s 3 (Char.chr
(len land 0xff));
506 let n'
= tempfailureretry
(Unix.write state
.ss
s 0) n in
507 if n'
!= n then error
"write failed %d vs %d" n'
n;
511 let nogeomcmds cmds
=
513 | s, [] -> emptystr
s
517 let layoutN ((columns
, coverA
, coverB
), b) y sh
=
518 let sh = sh - (hscrollh ()) in
519 let wadj = wadjsb () in
520 let rec fold accu
n =
521 if n = Array.length
b
524 let pdimno, dx, vy
, (_
, w
, h
, xoff
) = b.(n) in
527 || n = state
.pagecount
- coverB
528 || (n - coverA
) mod columns
= columns
- 1)
534 let pagey = max
0 (y - vy
) in
535 let pagedispy = if pagey > 0 then 0 else vy
- y in
536 let pagedispx, pagex
=
538 if n = coverA
- 1 || n = state
.pagecount
- coverB
539 then state
.x + (wadj + state
.winw
- w
) / 2
540 else dx + xoff
+ state
.x
547 let vw = wadj + state
.winw
- pagedispx in
548 let pw = w
- pagex
in
551 let pagevh = min
(h
- pagey) (sh - pagedispy) in
552 if pagevw > 0 && pagevh > 0
563 ; pagedispx = pagedispx
564 ; pagedispy = pagedispy
576 if Array.length
b = 0
578 else List.rev
(fold [] (page_of_y
y))
581 let layoutS (columns
, b) y sh =
582 let sh = sh - hscrollh () in
583 let wadj = wadjsb () in
584 let rec fold accu n =
585 if n = Array.length
b
588 let pdimno, px, vy
, (_
, pagew
, pageh
, xoff
) = b.(n) in
595 let x = xoff
+ state
.x in
596 let pagey = max
0 (y - vy
) in
597 let pagedispy = if pagey > 0 then 0 else vy
- y in
598 let pagedispx, pagex
=
612 let pagecolw = pagew
/columns
in
614 if pagecolw < state
.winw
615 then pagedispx + ((wadj + state
.winw
- pagecolw) / 2)
619 let vw = wadj + state
.winw
- pagedispx in
620 let pw = pagew
- pagex
in
623 let pagevw = min
pagevw pagecolw in
624 let pagevh = min
(pageh
- pagey) (sh - pagedispy) in
625 if pagevw > 0 && pagevh > 0
636 ; pagedispx = pagedispx
637 ; pagedispy = pagedispy
638 ; pagecol
= n mod columns
653 if nogeomcmds state
.geomcmds
655 match conf
.columns
with
656 | Csingle
b -> layoutN ((1, 0, 0), b) y sh
657 | Cmulti
c -> layoutN c y sh
658 | Csplit
s -> layoutS s y sh
663 let y = state
.y + incr
in
665 let y = min
y (state
.maxy
- (if conf
.maxhfit
then state
.winh
else 0)) in
670 let tilex = l.pagex
mod conf
.tilew
in
671 let tiley = l.pagey mod conf
.tileh
in
673 let col = l.pagex
/ conf
.tilew
in
674 let row = l.pagey / conf
.tileh
in
676 let xadj = xadjsb () in
677 let rec rowloop row y0 dispy h
=
681 let dh = conf
.tileh
- y0 in
683 let rec colloop col x0 dispx w
=
687 let dw = conf
.tilew
- x0 in
689 let dispx'
= xadj + dispx in
690 f col row dispx' dispy
x0 y0 dw dh;
691 colloop (col+1) 0 (dispx+dw) (w
-dw)
694 colloop col tilex l.pagedispx l.pagevw;
695 rowloop (row+1) 0 (dispy
+dh) (h
-dh)
698 if l.pagevw > 0 && l.pagevh > 0
699 then rowloop row tiley l.pagedispy l.pagevh;
702 let gettileopaque l col row =
704 l.pageno
, state
.gen
, conf
.colorspace
, conf
.angle
, l.pagew
, l.pageh
, col, row
706 try Some
(Hashtbl.find state
.tilemap
key)
707 with Not_found
-> None
710 let puttileopaque l col row gen colorspace angle opaque size elapsed
=
711 let key = l.pageno
, gen
, colorspace
, angle
, l.pagew
, l.pageh
, col, row in
712 Hashtbl.add state
.tilemap
key (opaque
, size
, elapsed
)
715 let filledrect x0 y0 x1 y1 =
716 GlArray.disable `texture_coord
;
717 Raw.sets_float state
.vraw ~pos
:0 [| x0; y0; x0; y1; x1; y0; x1; y1 |];
718 GlArray.vertex `two state
.vraw
;
719 GlArray.draw_arrays `triangle_strip ~first
:0 ~count
:4;
720 GlArray.enable `texture_coord
;
723 let linerect x0 y0 x1 y1 =
724 GlArray.disable `texture_coord
;
725 Raw.sets_float state
.vraw ~pos
:0 [| x0; y0; x0; y1; x1; y1; x1; y0 |];
726 GlArray.vertex `two state
.vraw
;
727 GlArray.draw_arrays `line_loop ~first
:0 ~count
:4;
728 GlArray.enable `texture_coord
;
731 let drawtiles l color
=
733 let wadj = wadjsb () in
735 let f col row x y tilex tiley w h
=
736 match gettileopaque l col row with
737 | Some
(opaque
, _
, t
) ->
738 let params = x, y, w
, h
, tilex, tiley in
740 then GlTex.env
(`mode `blend
);
741 drawtile
params opaque
;
743 then GlTex.env
(`mode `modulate
);
747 let s = Printf.sprintf
751 let w = measurestr fstate
.fontsize
s in
752 GlDraw.color
(0.0, 0.0, 0.0);
753 filledrect (float (x-2))
756 (float (y + fstate
.fontsize
+ 2));
757 GlDraw.color
(1.0, 1.0, 1.0);
758 drawstring fstate
.fontsize
x (y + fstate
.fontsize
- 1) s;
768 let lw = wadj + state
.winw
- x in
771 let lh = state
.winh
- y in
775 then GlTex.env
(`mode `blend
);
776 begin match state
.checkerstexid
with
778 Gl.enable `texture_2d
;
779 GlTex.bind_texture ~target
:`texture_2d id
;
783 and y1 = float (y+h
) in
785 let tw = float w /. 16.0
786 and th
= float h
/. 16.0 in
787 let tx0 = float tilex /. 16.0
788 and ty0
= float tiley /. 16.0 in
790 and ty1
= ty0
+. th
in
791 Raw.sets_float state
.vraw ~pos
:0
792 [| x0; y0; x0; y1; x1; y0; x1; y1 |];
793 Raw.sets_float state
.traw ~pos
:0
794 [| tx0; ty0
; tx0; ty1
; tx1; ty0
; tx1; ty1
|];
795 GlArray.vertex `two state
.vraw
;
796 GlArray.tex_coord `two state
.traw
;
797 GlArray.draw_arrays `triangle_strip ~first
:0 ~count
:4;
798 Gl.disable `texture_2d
;
801 GlDraw.color
(1.0, 1.0, 1.0);
802 filledrect (float x) (float y) (float (x+w)) (float (y+h
));
805 then GlTex.env
(`mode `modulate
);
806 if w > 128 && h
> fstate
.fontsize
+ 10
808 let c = if conf
.invert
then 1.0 else 0.0 in
809 GlDraw.color
(c, c, c);
812 then (col*conf
.tilew
, row*conf
.tileh
)
815 drawstring2 fstate
.fontsize
x y "Loading %d [%d,%d]" l.pageno
c r
;
824 let pagevisible layout n = List.exists
(fun l -> l.pageno
= n) layout;;
826 let tilevisible1 l x y =
828 and ax1
= l.pagex
+ l.pagevw
830 and ay1
= l.pagey + l.pagevh in
834 let bx1 = min
(bx0 + conf
.tilew
) l.pagew
835 and by1
= min
(by0
+ conf
.tileh
) l.pageh
in
837 let rx0 = max
ax0 bx0
838 and ry0
= max ay0 by0
839 and rx1
= min ax1
bx1
840 and ry1
= min ay1 by1
in
842 let nonemptyintersection = rx1
> rx0 && ry1
> ry0
in
846 let tilevisible layout n x y =
847 let rec findpageinlayout m
= function
848 | l :: rest
when l.pageno
= n ->
849 tilevisible1 l x y || (
850 match conf
.columns
with
851 | Csplit
(c, _
) when c > m
-> findpageinlayout (m
+1) rest
856 | _
:: rest
-> findpageinlayout 0 rest
859 findpageinlayout 0 layout;
862 let tileready l x y =
863 tilevisible1 l x y &&
864 gettileopaque l (x/conf
.tilew
) (y/conf
.tileh
) != None
867 let tilepage n p
layout =
868 let rec loop = function
872 let f col row _ _ _ _ _ _
=
873 if state
.currently
= Idle
875 match gettileopaque l col row with
878 let x = col*conf
.tilew
879 and y = row*conf
.tileh
in
881 let w = l.pagew
- x in
885 let h = l.pageh
- y in
890 then getpbo
w h conf
.colorspace
893 wcmd "tile %s %d %d %d %d %s"
894 (~
> p
) x y w h (~
> pbo);
897 l, p
, conf
.colorspace
, conf
.angle
,
898 state
.gen
, col, row, conf
.tilew
, conf
.tileh
907 if nogeomcmds state
.geomcmds
911 let preloadlayout y =
912 let y = if y < state
.winh
then 0 else y - state
.winh
in
913 let h = state
.winh
*3 in
919 if state
.currently
!= Idle
924 begin match getopaque l.pageno
with
926 wcmd "page %d %d" l.pageno
l.pagedimno
;
927 state
.currently
<- Loading
(l, state
.gen
);
929 tilepage l.pageno opaque pages
;
934 if nogeomcmds state
.geomcmds
940 if conf
.preload && state
.currently
= Idle
941 then load (preloadlayout state
.y);
944 let layoutready layout =
945 let rec fold all ls
=
948 let seen = ref false in
949 let allvisible = ref true in
950 let foo col row _ _ _ _ _ _
=
952 allvisible := !allvisible &&
953 begin match gettileopaque l col row with
959 fold (!seen && !allvisible) rest
962 let alltilesvisible = fold true layout in
967 let y = bound
y 0 state
.maxy
in
968 let y, layout, proceed
=
969 match conf
.maxwait
with
970 | Some time
when state
.ghyll
== noghyll
->
971 begin match state
.throttle
with
973 let layout = layout y state
.winh
in
974 let ready = layoutready layout in
978 state
.throttle
<- Some
(layout, y, now
());
980 else G.postRedisplay "gotoy showall (None)";
982 | Some
(_
, _
, started
) ->
983 let dt = now
() -. started
in
986 state
.throttle
<- None
;
987 let layout = layout y state
.winh
in
989 G.postRedisplay "maxwait";
996 let layout = layout y state
.winh
in
997 if not
!wtmode || layoutready layout
998 then G.postRedisplay "gotoy ready";
1004 state
.layout <- layout;
1005 begin match state
.mode
with
1008 | Ltexact
(pageno
, linkno
) ->
1009 let rec loop = function
1011 state
.mode
<- LinkNav
(Ltgendir
0)
1012 | l :: _
when l.pageno
= pageno
->
1013 begin match getopaque pageno
with
1014 | None
-> state
.mode
<- LinkNav
(Ltnotready
(pageno
, 0))
1016 let x0, y0, x1, y1 = getlinkrect opaque linkno
in
1017 if not
(x0 >= l.pagex
&& x1 <= l.pagex
+ l.pagevw
1018 && y0 >= l.pagey && y1 <= l.pagey + l.pagevh)
1019 then state
.mode
<- LinkNav
(Ltgendir
0)
1021 | _
:: rest
-> loop rest
1024 | Ltnotready _
| Ltgendir _
-> ()
1030 begin match state
.mode
with
1031 | Birdseye
(conf
, leftx
, pageno
, hooverpageno
, anchor
) ->
1032 if not
(pagevisible layout pageno
)
1034 match state
.layout with
1037 state
.mode
<- Birdseye
(
1038 conf
, leftx
, l.pageno
, hooverpageno
, anchor
1043 | Ltnotready
(_
, dir
)
1046 let rec loop = function
1049 match getopaque l.pageno
with
1050 | None
-> Ltnotready
(l.pageno
, dir
)
1055 then LDfirstvisible
(l.pagex
, l.pagey, dir
)
1057 if dir
> 0 then LDfirst
else LDlast
1063 | Lnotfound
-> loop rest
1065 showlinktype (getlink opaque
n);
1066 Ltexact
(l.pageno
, n)
1070 state
.mode
<- LinkNav
linknav
1078 state
.ghyll
<- noghyll
;
1081 let mx, my
= state
.mpos
in
1086 let conttiling pageno opaque
=
1087 tilepage pageno opaque
1088 (if conf
.preload then preloadlayout state
.y else state
.layout)
1091 let gotoy_and_clear_text y =
1092 if not conf
.verbose
then state
.text <- E.s;
1096 let getanchory (n, top
, dtop
) =
1097 let y, h = getpageyh
n in
1098 if conf
.presentation
1100 let ips = calcips
h in
1101 y + truncate
(top
*.float h -. dtop
*.float ips) + ips;
1103 y + truncate
(top
*.float h -. dtop
*.float conf
.interpagespace
)
1106 let gotoanchor anchor
=
1107 gotoy (getanchory anchor
);
1111 cbput state
.hists
.nav
(getanchor
());
1115 let anchor = cbgetc state
.hists
.nav dir
in
1119 let gotoghyll1 single
y =
1120 let scroll f n a
b =
1121 (* http://devmaster.net/forums/topic/9796-ease-in-ease-out-algorithm/ *)
1123 let s x = 3.0*.x**2.0 -. 2.0*.x**3.0 in
1125 then s (float f /. float a
)
1128 then 1.0 -. s ((float (f-b) /. float (n-b)))
1134 let ins = float a
*. 0.5
1135 and outs
= float (n-b) *. 0.5 in
1137 ins +. outs
+. float ones
1139 let rec set nab
y sy
=
1140 let (_N
, _A
, _B
), y =
1143 let scl = if y > sy
then 2 else -2 in
1144 let _N, _
, _
= nab
in
1145 (_N,0,_N), y+conf
.scrollstep
*scl
1147 let sum = summa
_N _A _B
in
1148 let dy = float (y - sy
) in
1152 then state
.ghyll
<- noghyll
1155 let s = scroll n _N _A _B
in
1156 let y1 = y1 +. ((s *. dy) /. sum) in
1157 gotoy_and_clear_text (truncate
y1);
1158 state
.ghyll
<- gf (n+1) y1;
1162 | Some
y'
when single
-> set nab
y' state
.y
1163 | Some
y'
-> set (_N/2, 1, 1) y' state
.y
1165 gf 0 (float state
.y)
1168 match conf
.ghyllscroll
with
1169 | Some nab
when not conf
.presentation
->
1170 if state
.ghyll
== noghyll
1171 then set nab
y state
.y
1172 else state
.ghyll
(Some
y)
1174 gotoy_and_clear_text y
1177 let gotoghyll = gotoghyll1 false;;
1179 let gotopage n top
=
1180 let y, h = getpageyh
n in
1181 let y = y + (truncate
(top
*. float h)) in
1185 let gotopage1 n top
=
1186 let y = getpagey
n in
1191 let invalidate s f =
1196 match state
.geomcmds
with
1197 | ps
, [] when emptystr ps
->
1199 state
.geomcmds
<- s, [];
1202 state
.geomcmds
<- ps
, [s, f];
1204 | ps
, (s'
, _
) :: rest
when s'
= s ->
1205 state
.geomcmds
<- ps
, ((s, f) :: rest
);
1208 state
.geomcmds
<- ps
, ((s, f) :: cmds
);
1212 Hashtbl.iter
(fun _ opaque
->
1213 wcmd "freepage %s" (~
> opaque
);
1215 Hashtbl.clear state
.pagemap
;
1219 if not
(Queue.is_empty state
.tilelru
)
1221 Queue.iter
(fun (k
, p
, s) ->
1222 wcmd "freetile %s" (~
> p
);
1223 state
.memused
<- state
.memused
- s;
1224 Hashtbl.remove state
.tilemap k
;
1226 state
.uioh#infochanged Memused
;
1227 Queue.clear state
.tilelru
;
1233 let h = truncate
(float h*.conf
.zoom
) in
1234 let d = conf
.interpagespace
lsl (if conf
.presentation
then 1 else 0) in
1238 let opendoc path password
=
1240 state
.password
<- password
;
1241 state
.gen
<- state
.gen
+ 1;
1242 state
.docinfo
<- [];
1243 state
.outlines
<- [||];
1246 setaalevel conf
.aalevel
;
1248 if emptystr state
.origin
1252 Wsi.settitle
("llpp " ^
(mbtoutf8
(Filename.basename
titlepath)));
1253 wcmd "open %d %d %s\000%s\000" (btod !wtmode) (btod !cxack) path password
;
1254 invalidate "reqlayout"
1256 wcmd "reqlayout %d %d %d %s\000"
1257 conf
.angle
(FMTE.to_int conf
.fitmodel
)
1258 (stateh state
.winh
) state
.nameddest
1263 state
.anchor <- getanchor
();
1264 opendoc state
.path state
.password
;
1268 let c = c *. conf
.colorscale
in
1272 let scalecolor2 (r
, g, b) =
1273 (r
*. conf
.colorscale
, g *. conf
.colorscale
, b *. conf
.colorscale
);
1276 let docolumns columns
=
1277 let wadj = wadjsb () in
1280 let a = Array.make state
.pagecount
(-1, -1, -1, (-1, -1, -1, -1)) in
1281 let wadj = wadjsb () in
1282 let rec loop pageno
pdimno pdim
y ph pdims
=
1283 if pageno
= state
.pagecount
1286 let pdimno, ((_
, w, h, xoff
) as pdim
), pdims
=
1288 | ((pageno'
, _
, _
, _
) as pdim
) :: rest
when pageno'
= pageno
->
1289 pdimno+1, pdim
, rest
1293 let x = max
0 (((wadj + state
.winw
- w) / 2) - xoff
) in
1295 (if conf
.presentation
1296 then (if pageno
= 0 then calcips
h else calcips ph
+ calcips
h)
1297 else (if pageno
= 0 then 0 else conf
.interpagespace
)
1300 a.(pageno
) <- (pdimno, x, y, pdim
);
1301 loop (pageno
+1) pdimno pdim
(y + h) h pdims
1303 loop 0 ~
-1 (-1,-1,-1,-1) 0 0 state
.pdims
;
1304 conf
.columns
<- Csingle
a;
1306 | Cmulti
((columns
, coverA
, coverB
), _
) ->
1307 let a = Array.make state
.pagecount
(-1, -1, -1, (-1, -1, -1, -1)) in
1308 let rec loop pageno
pdimno pdim
x y rowh pdims
=
1309 let rec fixrow m
= if m
= pageno
then () else
1310 let (pdimno, x, y, ((_
, _
, h, _
) as pdim
)) = a.(m
) in
1313 let y = y + (rowh
- h) / 2 in
1314 a.(m
) <- (pdimno, x, y, pdim
);
1318 if pageno
= state
.pagecount
1319 then fixrow (((pageno
- 1) / columns
) * columns
)
1321 let pdimno, ((_
, w, h, xoff
) as pdim
), pdims
=
1323 | ((pageno'
, _
, _
, _
) as pdim
) :: rest
when pageno'
= pageno
->
1324 pdimno+1, pdim
, rest
1329 if pageno
= coverA
- 1 || pageno
= state
.pagecount
- coverB
1331 let x = (wadj + state
.winw
- w) / 2 in
1333 if conf
.presentation
then calcips
h else conf
.interpagespace
in
1334 x, y + ips + rowh
, h
1337 if (pageno
- coverA
) mod columns
= 0
1339 let x = max
0 (wadj + state
.winw
- state
.w) / 2 in
1341 if conf
.presentation
1343 let ips = calcips
h in
1344 y + (if pageno
= 0 then 0 else calcips rowh
+ ips)
1346 y + (if pageno
= 0 then 0 else conf
.interpagespace
)
1350 else x, y, max rowh
h
1354 if pageno
> 1 && (pageno
- coverA
) mod columns
= 0
1357 if pageno
= columns
&& conf
.presentation
1359 let ips = calcips rowh
in
1360 for i
= 0 to pred columns
1362 let (pdimno, x, y, pdim
) = a.(i
) in
1363 a.(i
) <- (pdimno, x, y+ips, pdim
)
1369 fixrow (pageno
- columns
);
1374 a.(pageno
) <- (pdimno, x, y, pdim
);
1375 let x = x + w + xoff
*2 + conf
.interpagespace
in
1376 loop (pageno
+1) pdimno pdim
x y rowh' pdims
1378 loop 0 ~
-1 (-1,-1,-1,-1) 0 0 0 state
.pdims
;
1379 conf
.columns
<- Cmulti
((columns
, coverA
, coverB
), a);
1382 let a = Array.make
(state
.pagecount
*c) (-1, -1, -1, (-1, -1, -1, -1)) in
1383 let rec loop pageno
pdimno pdim
y pdims
=
1384 if pageno
= state
.pagecount
1387 let pdimno, ((_
, w, h, _
) as pdim
), pdims
=
1389 | ((pageno'
, _
, _
, _
) as pdim
) :: rest
when pageno'
= pageno
->
1390 pdimno+1, pdim
, rest
1395 let rec loop1 n x y =
1396 if n = c then y else (
1397 a.(pageno
*c + n) <- (pdimno, x, y, pdim
);
1398 loop1 (n+1) (x+cw) (y + h + conf
.interpagespace
)
1401 let y = loop1 0 0 y in
1402 loop (pageno
+1) pdimno pdim
y pdims
1404 loop 0 ~
-1 (-1,-1,-1,-1) 0 state
.pdims
;
1405 conf
.columns
<- Csplit
(c, a);
1409 docolumns conf
.columns
;
1410 state
.maxy
<- calcheight
();
1411 if state
.reprf
== noreprf
1413 match state
.mode
with
1414 | Birdseye
(_
, _
, pageno
, _
, _
) ->
1415 let y, h = getpageyh pageno
in
1416 let top = (state
.winh
- h) / 2 in
1417 gotoy (max
0 (y - top))
1420 | LinkNav _
-> gotoanchor state
.anchor
1424 state
.reprf
<- noreprf
;
1429 GlDraw.viewport ~
x:0 ~
y:0 ~
w:w ~
h:h;
1430 let firsttime = state
.geomcmds
== firstgeomcmds
in
1431 if not
firsttime && nogeomcmds state
.geomcmds
1432 then state
.anchor <- getanchor
();
1435 let w = wadjsb () + (truncate
(float w *. conf
.zoom
)) in
1438 setfontsize fstate
.fontsize
;
1439 GlMat.mode `modelview
;
1440 GlMat.load_identity
();
1442 GlMat.mode `projection
;
1443 GlMat.load_identity
();
1444 GlMat.rotate ~
x:1.0 ~angle
:180.0 ();
1445 GlMat.translate ~
x:~
-.1.0 ~
y:~
-.1.0 ();
1446 GlMat.scale3
(2.0 /. float state
.winw
, 2.0 /. float state
.winh
, 1.0);
1451 else float state
.x /. float state
.w
1453 invalidate "geometry"
1457 then state
.x <- truncate
(relx *. float w);
1459 match conf
.columns
with
1461 | Cmulti
((c, _
, _
), _
) -> (w - (c-1)*conf
.interpagespace
) / c
1462 | Csplit
(c, _
) -> w * c
1464 wcmd "geometry %d %d %d"
1465 w (stateh h) (FMTE.to_int conf
.fitmodel
)
1470 let len = String.length state
.text in
1471 let x0 = xadjsb () in
1474 match state
.mode
with
1475 | Textentry _
| View
| LinkNav _
->
1476 let h, _
, _
= state
.uioh#scrollpw
in
1481 filledrect x (float (state
.winh
- (fstate
.fontsize
+ 4) - hscrollh))
1482 (x+.w) (float (state
.winh
- hscrollh))
1485 let w = float (wadjsb () + state
.winw
- 1) in
1486 if state
.progress
>= 0.0 && state
.progress
< 1.0
1488 GlDraw.color
(0.3, 0.3, 0.3);
1489 let w1 = w *. state
.progress
in
1491 GlDraw.color
(0.0, 0.0, 0.0);
1492 rect (float x0+.w1) (float x0+.w-.w1)
1495 GlDraw.color
(0.0, 0.0, 0.0);
1499 GlDraw.color
(1.0, 1.0, 1.0);
1500 drawstring fstate
.fontsize
1501 (if conf
.leftscroll
then x0 + 2 else x0 + if len > 0 then 8 else 2)
1502 (state
.winh
- hscrollh - 5) s;
1505 match state
.mode
with
1506 | Textentry
((prefix
, text, _
, _
, _
, _
), _
) ->
1510 Printf.sprintf
"%s%s_ [%s]" prefix
text state
.text
1512 Printf.sprintf
"%s%s_" prefix
text
1518 | LinkNav _
-> state
.text
1523 if not
(istextentry state
.mode
) && state
.uioh#eformsgs
1525 let s1 = "(press 'e' to review error messasges)" in
1526 if nonemptystr
s then s ^
" " ^
s1 else s1
1536 let len = Queue.length state
.tilelru
in
1538 match state
.throttle
with
1541 then preloadlayout state
.y
1543 | Some
(layout, _
, _
) ->
1547 if state
.memused
<= conf
.memlimit
1552 let (k
, p
, s) as lruitem
= Queue.pop state
.tilelru
in
1553 let n, gen
, colorspace
, angle
, pagew
, pageh
, col, row = k
in
1554 let (_
, pw, ph
, _
) = getpagedim
n in
1557 && colorspace
= conf
.colorspace
1558 && angle
= conf
.angle
1562 let x = col*conf
.tilew
1563 and y = row*conf
.tileh
in
1564 tilevisible (Lazy.force_val
layout) n x y
1566 then Queue.push lruitem state
.tilelru
1569 wcmd "freetile %s" (~
> p
);
1570 state
.memused
<- state
.memused
- s;
1571 state
.uioh#infochanged Memused
;
1572 Hashtbl.remove state
.tilemap k
;
1580 let logcurrently = function
1581 | Idle
-> dolog
"Idle"
1582 | Loading
(l, gen
) ->
1583 dolog
"Loading %d gen=%d curgen=%d" l.pageno gen state
.gen
1584 | Tiling
(l, pageopaque
, colorspace
, angle
, gen
, col, row, tilew
, tileh
) ->
1586 "Tiling %d[%d,%d] page=%s cs=%s angle"
1587 l.pageno
col row (~
> pageopaque
)
1588 (CSTE.to_string colorspace
)
1590 dolog
"gen=(%d,%d) (%d,%d) tile=(%d,%d) (%d,%d)"
1591 angle gen conf
.angle state
.gen
1593 conf
.tilew conf
.tileh
1600 let r = Str.regexp
" " in
1601 fun s -> Str.bounded_split
r s 2;
1604 let onpagerect pageno
f =
1606 match conf
.columns
with
1607 | Cmulti
(_
, b) -> b
1609 | Csplit
(_
, b) -> b
1611 if pageno
>= 0 && pageno
< Array.length
b
1613 let (_
, _
, _
, (w, h, _
, _
)) = b.(pageno
) in
1617 let gotopagexy1 pageno
x y =
1618 let _,w1,h1
,leftx
= getpagedim pageno
in
1619 let top = y /. (float h1
) in
1620 let left = x /. (float w1) in
1621 let py, w, h = getpageywh pageno
in
1622 let wh = state
.winh
- hscrollh () in
1623 let x = left *. (float w) in
1624 let x = leftx
+ state
.x + truncate
x in
1625 let wadj = wadjsb () in
1627 if x < 0 || x >= wadj + state
.winw
1631 let pdy = truncate
(top *. float h) in
1632 let y'
= py + pdy in
1633 let dy = y'
- state
.y in
1635 if x != state
.x || not
(dy > 0 && dy < wh)
1637 if conf
.presentation
1639 if abs
(py - y'
) > wh
1646 if state
.x != sx || state
.y != sy
1651 let ww = wadj + state
.winw
in
1653 and qy
= pdy / wh in
1655 and y = py + qy
* wh in
1656 let x = if -x + ww > w1 then -(w1-ww) else x
1657 and y'
= if y + wh > state
.maxy
then state
.maxy
- wh else y in
1659 if conf
.presentation
1661 if abs
(py - y'
) > wh
1671 gotoy_and_clear_text y;
1673 else gotoy_and_clear_text state
.y;
1676 let gotopagexy pageno
x y =
1677 match state
.mode
with
1678 | Birdseye
_ -> gotopage pageno
0.0
1681 | LinkNav
_ -> gotopagexy1 pageno
x y
1684 let getpassword () =
1685 let passcmd = getenvwithdef
"LLPP_ASKPASS" conf
.passcmd in
1689 match Unix.open_process_in
passcmd with
1690 | (exception exn
) ->
1693 "getpassword: open_process_in failed: %s" (exntos exn
));
1696 let s = try input_line ic
with End_of_file
-> E.s in
1698 match Unix.close_process_in ic
with
1699 | (exception exn
) ->
1701 (Printf.sprintf
"getpassword: close_process_in failed: %s"
1710 (* dolog "%S" cmds; *)
1711 let cl = splitatspace cmds
in
1713 try Scanf.sscanf
s fmt
f
1715 dolog
"error processing '%S': %s" cmds
(exntos exn
);
1718 let addoutline outline
=
1719 match state
.currently
with
1720 | Outlining outlines
->
1721 state
.currently
<- Outlining
(outline
:: outlines
)
1722 | Idle
-> state
.currently
<- Outlining
[outline
]
1725 dolog
"invalid outlining state";
1726 logcurrently state
.currently
1730 state
.uioh#infochanged Pdim
;
1733 | "clearrects" :: [] ->
1734 state
.rects
<- state
.rects1
;
1735 G.postRedisplay "clearrects";
1737 | "continue" :: args
:: [] ->
1738 let n = scan args
"%u" (fun n -> n) in
1739 state
.pagecount
<- n;
1740 begin match state
.currently
with
1742 state
.currently
<- Idle
;
1743 state
.outlines
<- Array.of_list
(List.rev
l)
1749 let cur, cmds
= state
.geomcmds
in
1751 then failwith
"umpossible";
1753 begin match List.rev cmds
with
1755 state
.geomcmds
<- E.s, [];
1756 state
.throttle
<- None
;
1760 state
.geomcmds
<- s, List.rev rest
;
1762 if conf
.maxwait
= None
&& not
!wtmode
1763 then G.postRedisplay "continue";
1765 | "msg" :: args
:: [] ->
1768 | "vmsg" :: args
:: [] ->
1770 then showtext ' ' args
1772 | "emsg" :: args
:: [] ->
1773 Buffer.add_string state
.errmsgs args
;
1774 state
.newerrmsgs
<- true;
1775 G.postRedisplay "error message"
1777 | "progress" :: args
:: [] ->
1778 let progress, text =
1781 f, String.sub args pos
(String.length args
- pos
))
1784 state
.progress <- progress;
1785 G.postRedisplay "progress"
1787 | "firstmatch" :: args
:: [] ->
1788 let pageno, c, x0, y0, x1, y1, x2
, y2
, x3
, y3
=
1789 scan args
"%u %d %f %f %f %f %f %f %f %f"
1790 (fun p
c x0 y0 x1 y1 x2 y2 x3 y3
->
1791 (p
, c, x0, y0, x1, y1, x2
, y2
, x3
, y3
))
1793 let xoff = float (xadjsb ()) in
1797 and x3
= x3
+. xoff in
1798 let y = (getpagey
pageno) + truncate
y0 in
1801 state
.rects1
<- [pageno, c, (x0, y0, x1, y1, x2
, y2
, x3
, y3
)]
1803 | "match" :: args
:: [] ->
1804 let pageno, c, x0, y0, x1, y1, x2
, y2
, x3
, y3
=
1805 scan args
"%u %d %f %f %f %f %f %f %f %f"
1806 (fun p
c x0 y0 x1 y1 x2 y2 x3 y3
->
1807 (p
, c, x0, y0, x1, y1, x2
, y2
, x3
, y3
))
1809 let xoff = float (xadjsb ()) in
1813 and x3
= x3
+. xoff in
1815 (pageno, c, (x0, y0, x1, y1, x2
, y2
, x3
, y3
)) :: state
.rects1
1817 | "page" :: args
:: [] ->
1818 let pageopaques, t
= scan args
"%s %f" (fun p t
-> p
, t
) in
1819 let pageopaque = ~
< pageopaques in
1820 begin match state
.currently
with
1821 | Loading
(l, gen
) ->
1822 vlog "page %d took %f sec" l.pageno t
;
1823 Hashtbl.replace state
.pagemap
(l.pageno, gen
) pageopaque;
1824 begin match state
.throttle
with
1826 let preloadedpages =
1828 then preloadlayout state
.y
1833 List.fold_left
(fun s l -> IntSet.add
l.pageno s)
1834 IntSet.empty
preloadedpages
1837 Hashtbl.fold (fun ((pageno, _) as key) opaque
accu ->
1838 if not
(IntSet.mem
pageno set)
1840 wcmd "freepage %s" (~
> opaque
);
1846 List.iter
(Hashtbl.remove state
.pagemap
) evictedpages;
1849 state
.currently
<- Idle
;
1852 tilepage l.pageno pageopaque state
.layout;
1854 load preloadedpages;
1855 let visible = pagevisible state
.layout l.pageno in
1858 match state
.mode
with
1859 | LinkNav
(Ltnotready
(pageno, dir
)) ->
1860 if pageno = l.pageno
1865 then LDfirstvisible
(l.pagex
, l.pagey, dir
)
1867 if dir
> 0 then LDfirst
else LDlast
1870 findlink
pageopaque ld
1875 showlinktype (getlink
pageopaque n);
1876 state
.mode
<- LinkNav
(Ltexact
(l.pageno, n))
1878 | LinkNav
(Ltgendir
_)
1879 | LinkNav
(Ltexact
_)
1885 if visible && layoutready state
.layout
1887 G.postRedisplay "page";
1891 | Some
(layout, _, _) ->
1892 state
.currently
<- Idle
;
1893 tilepage l.pageno pageopaque layout;
1900 dolog
"Inconsistent loading state";
1901 logcurrently state
.currently
;
1905 | "tile" :: args
:: [] ->
1906 let (x, y, opaques
, size
, t
) =
1907 scan args
"%u %u %s %u %f"
1908 (fun x y p size t
-> (x, y, p
, size
, t
))
1910 let opaque = ~
< opaques
in
1911 begin match state
.currently
with
1912 | Tiling
(l, pageopaque, cs
, angle
, gen
, col, row, tilew
, tileh
) ->
1913 vlog "tile %d [%d,%d] took %f sec" l.pageno col row t
;
1916 if tilew
!= conf
.tilew
|| tileh
!= conf
.tileh
1918 wcmd "freetile %s" (~
> opaque);
1919 state
.currently
<- Idle
;
1923 puttileopaque l col row gen cs angle
opaque size t
;
1924 state
.memused
<- state
.memused
+ size
;
1925 state
.uioh#infochanged Memused
;
1927 Queue.push
((l.pageno, gen
, cs
, angle
, l.pagew
, l.pageh
, col, row),
1928 opaque, size
) state
.tilelru
;
1931 match state
.throttle
with
1932 | None
-> state
.layout
1933 | Some
(layout, _, _) -> layout
1936 state
.currently
<- Idle
;
1938 && conf
.colorspace
= cs
1939 && conf
.angle
= angle
1940 && tilevisible layout l.pageno x y
1941 then conttiling l.pageno pageopaque;
1943 begin match state
.throttle
with
1945 preload state
.layout;
1947 && conf
.colorspace
= cs
1948 && conf
.angle
= angle
1949 && tilevisible state
.layout l.pageno x y
1950 && (not
!wtmode || layoutready state
.layout)
1951 then G.postRedisplay "tile nothrottle";
1953 | Some
(layout, y, _) ->
1954 let ready = layoutready layout in
1958 state
.layout <- layout;
1959 state
.throttle
<- None
;
1960 G.postRedisplay "throttle";
1969 dolog
"Inconsistent tiling state";
1970 logcurrently state
.currently
;
1974 | "pdim" :: args
:: [] ->
1975 let (n, w, h, _) as pdim
=
1976 scan args
"%u %u %u %u" (fun n w h x -> n, w, h, x)
1979 match conf
.fitmodel
with
1981 | FitPage
| FitProportional
->
1982 match conf
.columns
with
1983 | Csplit
_ -> (n, w, h, 0)
1984 | Csingle
_ | Cmulti
_ -> pdim
1986 state
.uioh#infochanged Pdim
;
1987 state
.pdims
<- pdim :: state
.pdims
1989 | "o" :: args
:: [] ->
1990 let (l, n, t
, h, pos
) =
1991 scan args
"%u %u %d %u %n"
1992 (fun l n t
h pos
-> l, n, t
, h, pos
)
1994 let s = String.sub args pos
(String.length args
- pos
) in
1995 addoutline (s, l, Oanchor
(n, float t
/. float h, 0.0))
1997 | "ou" :: args
:: [] ->
1998 let (l, len, pos
) = scan args
"%u %u %n" (fun l len pos
-> l, len, pos
) in
1999 let s = String.sub args pos
len in
2000 let pos2 = pos
+ len + 1 in
2001 let uri = String.sub args
pos2 (String.length args
- pos2) in
2002 addoutline (s, l, Ouri
uri)
2004 | "on" :: args
:: [] ->
2005 let (l, pos
) = scan args
"%u %n" (fun l pos
-> l, pos
) in
2006 let s = String.sub args pos
(String.length args
- pos
) in
2007 addoutline (s, l, Onone
)
2009 | "a" :: args
:: [] ->
2011 scan args
"%u %d %d" (fun n l t
-> n, l, t
)
2013 state
.reprf
<- (fun () -> gotopagexy n (float l) (float t
))
2015 | "info" :: args
:: [] ->
2016 let pos = nindex args '
\t'
in
2017 if pos >= 0 && String.sub args
0 pos = "Title"
2019 let s = String.sub args
(pos+1) @@ String.length args
- pos - 1 in
2022 state
.docinfo
<- (1, args
) :: state
.docinfo
2024 | "infoend" :: [] ->
2025 state
.uioh#infochanged Docinfo
;
2026 state
.docinfo
<- List.rev state
.docinfo
2030 then Wsi.settitle
"Wrong password";
2031 let password = getpassword () in
2033 then error
"document is password protected"
2034 else opendoc state
.path
password
2037 error
"unknown cmd `%S'" cmds
2042 let action = function
2043 | HCprev
-> cbget cb ~
-1
2044 | HCnext
-> cbget cb
1
2045 | HCfirst
-> cbget cb ~
-(cb
.rc)
2046 | HClast
-> cbget cb
(cb
.len - 1 - cb
.rc)
2047 and cancel
() = cb
.rc <- rc
2051 let search pattern forward
=
2052 match conf
.columns
with
2054 showtext '
!'
"searching does not work properly in split columns mode"
2057 if nonemptystr pattern
2060 match state
.layout with
2063 l.pageno, (l.pagey + if forward
then 0 else 0*l.pagevh)
2065 wcmd "search %d %d %d %d,%s\000"
2066 (btod conf
.icase
) pn py (btod forward
) pattern
;
2069 let intentry text key =
2071 if key >= 32 && key < 127
2077 let text = addchar text c in
2081 state
.text <- Printf.sprintf
"invalid char (%d, `%c')" key c;
2085 let linknentry text key =
2087 if key >= 32 && key < 127
2093 let text = addchar text c in
2097 state
.text <- Printf.sprintf
"invalid char (%d, `%c')" key c;
2105 let l = String.length
s in
2106 let rec loop pos n = if pos = l then n else
2107 let m = Char.code
s.[pos] - (if pos = 0 && l > 1 then 96 else 97) in
2108 loop (pos+1) (n*26 + m)
2111 let rec loop n = function
2114 match getopaque l.pageno with
2115 | None
-> loop n rest
2117 let m = getlinkcount
opaque in
2120 let under = getlink
opaque n in
2123 else loop (n-m) rest
2125 loop n state
.layout;
2129 let textentry text key =
2130 if key land 0xff00 = 0xff00
2132 else TEcont
(text ^ toutf8
key)
2135 let reqlayout angle fitmodel
=
2136 match state
.throttle
with
2138 if nogeomcmds state
.geomcmds
2139 then state
.anchor <- getanchor
();
2140 conf
.angle
<- angle
mod 360;
2143 match state
.mode
with
2144 | LinkNav
_ -> state
.mode
<- View
2149 conf
.fitmodel
<- fitmodel
;
2150 invalidate "reqlayout"
2152 wcmd "reqlayout %d %d %d"
2153 conf
.angle
(FMTE.to_int conf
.fitmodel
) (stateh state
.winh
)
2158 let settrim trimmargins trimfuzz
=
2159 if nogeomcmds state
.geomcmds
2160 then state
.anchor <- getanchor
();
2161 conf
.trimmargins
<- trimmargins
;
2162 conf
.trimfuzz
<- trimfuzz
;
2163 let x0, y0, x1, y1 = trimfuzz
in
2164 invalidate "settrim"
2166 wcmd "settrim %d %d %d %d %d" (btod conf
.trimmargins
) x0 y0 x1 y1);
2171 match state
.throttle
with
2173 let zoom = max
0.0001 zoom in
2174 if zoom <> conf
.zoom
2176 state
.prevzoom
<- (conf
.zoom, state
.x);
2178 reshape state
.winw state
.winh
;
2179 state
.text <- Printf.sprintf
"zoom is now %-5.2f" (zoom *. 100.0);
2182 | Some
(layout, y, started
) ->
2184 match conf
.maxwait
with
2188 let dt = now
() -. started
in
2196 let setcolumns mode columns coverA coverB
=
2197 state
.prevcolumns
<- Some
(conf
.columns
, conf
.zoom);
2201 then showtext '
!'
"split mode doesn't work in bird's eye"
2203 conf
.columns
<- Csplit
(-columns
, E.a);
2211 conf
.columns
<- Csingle
E.a;
2216 conf
.columns
<- Cmulti
((columns
, coverA
, coverB
), E.a);
2220 reshape state
.winw state
.winh
;
2223 let resetmstate () =
2224 state
.mstate
<- Mnone
;
2225 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
2228 let enterbirdseye () =
2229 let zoom = float conf
.thumbw
/. float state
.winw
in
2230 let birdseyepageno =
2231 let cy = state
.winh
/ 2 in
2235 let rec fold best
= function
2238 let d = cy - (l.pagedispy + l.pagevh/2)
2239 and dbest
= cy - (best
.pagedispy + best
.pagevh/2) in
2240 if abs
d < abs dbest
2247 state
.mode
<- Birdseye
(
2248 { conf
with zoom = conf
.zoom }, state
.x, birdseyepageno, -1, getanchor
()
2252 conf
.presentation
<- false;
2253 conf
.interpagespace
<- 10;
2254 conf
.hlinks
<- false;
2255 conf
.fitmodel
<- FitPage
;
2257 conf
.maxwait
<- None
;
2259 match conf
.beyecolumns
with
2262 Cmulti
((c, 0, 0), E.a)
2263 | None
-> Csingle
E.a
2267 state
.text <- Printf.sprintf
"birds eye mode on (zoom %3.1f%%)"
2272 reshape state
.winw state
.winh
;
2275 let leavebirdseye (c, leftx
, pageno, _, anchor) goback
=
2277 conf
.zoom <- c.zoom;
2278 conf
.presentation
<- c.presentation
;
2279 conf
.interpagespace
<- c.interpagespace
;
2280 conf
.maxwait
<- c.maxwait
;
2281 conf
.hlinks
<- c.hlinks
;
2282 conf
.fitmodel
<- c.fitmodel
;
2283 conf
.beyecolumns
<- (
2284 match conf
.columns
with
2285 | Cmulti
((c, _, _), _) -> Some
c
2287 | Csplit
_ -> failwith
"leaving bird's eye split mode"
2290 match c.columns
with
2291 | Cmulti
(c, _) -> Cmulti
(c, E.a)
2292 | Csingle
_ -> Csingle
E.a
2293 | Csplit
(c, _) -> Csplit
(c, E.a)
2297 state
.text <- Printf.sprintf
"birds eye mode off (zoom %3.1f%%)"
2300 reshape state
.winw state
.winh
;
2301 state
.anchor <- if goback
then anchor else (pageno, 0.0, 1.0);
2305 let togglebirdseye () =
2306 match state
.mode
with
2307 | Birdseye vals
-> leavebirdseye vals
true
2308 | View
-> enterbirdseye ()
2313 let upbirdseye incr
(conf
, leftx
, pageno, hooverpageno
, anchor) =
2314 let pageno = max
0 (pageno - incr
) in
2315 let rec loop = function
2316 | [] -> gotopage1 pageno 0
2317 | l :: _ when l.pageno = pageno ->
2318 if l.pagedispy >= 0 && l.pagey = 0
2319 then G.postRedisplay "upbirdseye"
2320 else gotopage1 pageno 0
2321 | _ :: rest
-> loop rest
2325 state
.mode
<- Birdseye
(conf
, leftx
, pageno, hooverpageno
, anchor)
2328 let downbirdseye incr
(conf
, leftx
, pageno, hooverpageno
, anchor) =
2329 let pageno = min
(state
.pagecount
- 1) (pageno + incr
) in
2330 state
.mode
<- Birdseye
(conf
, leftx
, pageno, hooverpageno
, anchor);
2331 let rec loop = function
2333 let y, h = getpageyh
pageno in
2334 let dy = (y - state
.y) - (state
.winh
- h - conf
.interpagespace
) in
2336 | l :: _ when l.pageno = pageno ->
2337 if l.pagevh != l.pageh
2338 then gotoy (clamp (l.pageh
- l.pagevh + conf
.interpagespace
))
2339 else G.postRedisplay "downbirdseye"
2340 | _ :: rest
-> loop rest
2346 let boundastep h step
=
2348 then bound step ~
-h 0
2352 let optentry mode
_ key =
2353 let btos b = if b then "on" else "off" in
2354 if key >= 32 && key < 127
2356 let c = Char.chr
key in
2360 try conf
.scrollstep
<- int_of_string
s with exc
->
2361 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2363 TEswitch
("scroll step: ", E.s, None
, intentry, ondone, true)
2368 conf
.autoscrollstep
<- boundastep state
.winh
(int_of_string
s);
2369 if state
.autoscroll
<> None
2370 then state
.autoscroll
<- Some conf
.autoscrollstep
2372 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2374 TEswitch
("auto scroll step: ", E.s, None
, intentry, ondone, true)
2379 let n, a, b = multicolumns_of_string
s in
2380 setcolumns mode
n a b;
2382 state
.text <- Printf.sprintf
"bad columns `%s': %s" s (exntos exc
)
2384 TEswitch
("columns: ", E.s, None
, textentry, ondone, true)
2389 let zoom = float (int_of_string
s) /. 100.0 in
2392 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2394 TEswitch
("zoom: ", E.s, None
, intentry, ondone, true)
2399 conf
.thumbw
<- bound
(int_of_string
s) 2 4096;
2401 Printf.sprintf
"thumbnail width is set to %d" conf
.thumbw
;
2402 begin match mode
with
2404 leavebirdseye beye
false;
2411 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2413 TEswitch
("thumbnail width: ", E.s, None
, intentry, ondone, true)
2418 Some
(int_of_string
s)
2420 state
.text <- Printf.sprintf
"bad integer `%s': %s"
2424 | Some angle
-> reqlayout angle conf
.fitmodel
2427 TEswitch
("rotation: ", E.s, None
, intentry, ondone, true)
2430 conf
.icase
<- not conf
.icase
;
2431 TEdone
("case insensitive search " ^
(btos conf
.icase
))
2434 conf
.preload <- not conf
.preload;
2436 TEdone
("preload " ^
(btos conf
.preload))
2439 conf
.verbose
<- not conf
.verbose
;
2440 TEdone
("verbose " ^
(btos conf
.verbose
))
2443 conf
.debug
<- not conf
.debug
;
2444 TEdone
("debug " ^
(btos conf
.debug
))
2447 conf
.maxhfit
<- not conf
.maxhfit
;
2448 state
.maxy
<- calcheight
();
2449 TEdone
("maxhfit " ^
(btos conf
.maxhfit
))
2452 conf
.crophack
<- not conf
.crophack
;
2453 TEdone
("crophack " ^
btos conf
.crophack
)
2457 match conf
.maxwait
with
2459 conf
.maxwait
<- Some infinity
;
2460 "always wait for page to complete"
2462 conf
.maxwait
<- None
;
2463 "show placeholder if page is not ready"
2468 conf
.underinfo
<- not conf
.underinfo
;
2469 TEdone
("underinfo " ^
btos conf
.underinfo
)
2472 conf
.savebmarks
<- not conf
.savebmarks
;
2473 TEdone
("persistent bookmarks " ^
btos conf
.savebmarks
)
2479 match state
.layout with
2484 conf
.interpagespace
<- int_of_string
s;
2485 docolumns conf
.columns
;
2486 state
.maxy
<- calcheight
();
2487 let y = getpagey
pageno in
2490 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2492 TEswitch
("vertical margin: ", E.s, None
, intentry, ondone, true)
2496 match conf
.fitmodel
with
2497 | FitProportional
-> FitWidth
2498 | FitWidth
| FitPage
-> FitProportional
2500 reqlayout conf
.angle
fm;
2501 TEdone
("proportional display " ^
btos (fm == FitProportional
))
2504 settrim (not conf
.trimmargins
) conf
.trimfuzz
;
2505 TEdone
("trim margins " ^
btos conf
.trimmargins
)
2508 conf
.invert
<- not conf
.invert
;
2509 TEdone
("invert colors " ^
btos conf
.invert
)
2513 cbput state
.hists
.sel
s;
2516 TEswitch
("selection command: ", E.s, Some
(onhist state
.hists
.sel
),
2517 textentry, ondone, true)
2521 then conf
.pax
<- Some
(ref (0.0, 0, 0))
2522 else conf
.pax
<- None
;
2523 TEdone
("PAX " ^
btos (conf
.pax
!= None
))
2526 state
.text <- Printf.sprintf
"bad option %d `%c'" key c;
2532 class type lvsource
= object
2533 method getitemcount
: int
2534 method getitem
: int -> (string * int)
2535 method hasaction
: int -> bool
2543 method getactive
: int
2544 method getfirst
: int
2546 method getminfo
: (int * int) array
2549 class virtual lvsourcebase
= object
2550 val mutable m_active
= 0
2551 val mutable m_first
= 0
2552 val mutable m_pan
= 0
2553 method getactive
= m_active
2554 method getfirst
= m_first
2555 method getpan
= m_pan
2556 method getminfo
: (int * int) array
= E.a
2559 let withoutlastutf8 s =
2560 let len = String.length
s in
2568 let b = Char.code
s.[pos] in
2569 if b land 0b11000000 = 0b11000000
2574 if Char.code
s.[len-1] land 0x80 = 0
2578 String.sub
s 0 first;
2581 let textentrykeyboard
2582 key _mask
((c, text, opthist
, onkey
, ondone, cancelonempty
), onleave
) =
2584 if key >= 0xffb0 && key <= 0xffb9
2585 then key - 0xffb0 + 48 else key
2588 state
.mode
<- Textentry
(te
, onleave
);
2591 G.postRedisplay "textentrykeyboard enttext";
2593 let histaction cmd
=
2596 | Some
(action, _) ->
2597 state
.mode
<- Textentry
(
2598 (c, action cmd
, opthist
, onkey
, ondone, cancelonempty
), onleave
2600 G.postRedisplay "textentry histaction"
2604 if emptystr
text && cancelonempty
2607 G.postRedisplay "textentrykeyboard after cancel";
2610 let s = withoutlastutf8 text in
2611 enttext (c, s, opthist
, onkey
, ondone, cancelonempty
)
2613 | @enter
| @kpenter
->
2616 G.postRedisplay "textentrykeyboard after confirm"
2618 | @up
| @kpup
-> histaction HCprev
2619 | @down
| @kpdown
-> histaction HCnext
2620 | @home
| @kphome
-> histaction HCfirst
2621 | @jend
| @kpend
-> histaction HClast
2626 begin match opthist
with
2628 | Some
(_, onhistcancel
) -> onhistcancel
()
2632 G.postRedisplay "textentrykeyboard after cancel2"
2635 enttext (c, E.s, opthist
, onkey
, ondone, cancelonempty
)
2638 | @delete
| @kpdelete
-> ()
2641 && key land 0xff00 != 0xff00 (* keyboard *)
2642 && key land 0xfe00 != 0xfe00 (* xkb *)
2643 && key land 0xfd00 != 0xfd00 (* 3270 *)
2645 begin match onkey
text key with
2649 G.postRedisplay "textentrykeyboard after confirm2";
2652 enttext (c, text, opthist
, onkey
, ondone, cancelonempty
);
2656 G.postRedisplay "textentrykeyboard after cancel3"
2659 state
.mode
<- Textentry
(te
, onleave
);
2660 G.postRedisplay "textentrykeyboard switch";
2664 vlog "unhandled key %s" (Wsi.keyname
key)
2667 let firstof first active
=
2668 if first > active
|| abs
(first - active
) > fstate
.maxrows
- 1
2669 then max
0 (active
- (fstate
.maxrows
/2))
2673 let calcfirst first active
=
2676 let rows = active
- first in
2677 if rows > fstate
.maxrows
then active
- fstate
.maxrows
else first
2681 let scrollph y maxy
=
2682 let sh = float (maxy
+ state
.winh
) /. float state
.winh
in
2683 let sh = float state
.winh
/. sh in
2684 let sh = max
sh (float conf
.scrollh
) in
2686 let percent = float y /. float maxy
in
2687 let position = (float state
.winh
-. sh) *. percent in
2690 if position +. sh > float state
.winh
2691 then float state
.winh
-. sh
2697 let coe s = (s :> uioh
);;
2699 class listview ~zebra ~helpmode ~
(source
:lvsource
) ~trusted ~modehash
=
2701 val m_pan
= source#getpan
2702 val m_first
= source#getfirst
2703 val m_active
= source#getactive
2705 val m_prev_uioh
= state
.uioh
2707 method private elemunder
y =
2711 let n = y / (fstate
.fontsize
+1) in
2712 if m_first
+ n < source#getitemcount
2714 if source#hasaction
(m_first
+ n)
2715 then Some
(m_first
+ n)
2722 GlFunc.blend_func ~src
:`src_alpha ~dst
:`one_minus_src_alpha
;
2723 GlDraw.color
(0., 0., 0.) ~alpha
:0.85;
2724 filledrect 0. 0. (float state
.winw
) (float state
.winh
);
2725 GlDraw.color
(1., 1., 1.);
2726 Gl.enable `texture_2d
;
2727 let fs = fstate
.fontsize
in
2729 let hw = (wadjsb () + xadjsb () + state
.winw
)/3 in
2730 let ww = fstate
.wwidth
in
2731 let tabw = 17.0*.ww in
2732 let itemcount = source#getitemcount
in
2733 let minfo = source#getminfo
in
2736 then float (xadjsb ()), float (state
.winw
- 1)
2737 else 0.0, float (state
.winw
- conf
.scrollbw
- 1)
2739 let xadj = xadjsb () in
2741 if (row - m_first
) > fstate
.maxrows
2744 if row >= 0 && row < itemcount
2746 let (s, level
) = source#getitem
row in
2747 let y = (row - m_first
) * nfs in
2749 (if conf
.leftscroll
then float xadj else 5.0)
2750 +. (float (level
+ m_pan
)) *. ww in
2753 (let c = if row land 1 = 0 then 1.0 else 0.92 in (c,c,c));
2757 Gl.disable `texture_2d
;
2758 let alpha = if source#hasaction
row then 0.9 else 0.3 in
2759 GlDraw.color
(1., 1., 1.) ~
alpha;
2760 linerect (x0 +. 1.) (float (y + 1)) (x1) (float (y + fs + 3));
2761 Gl.enable `texture_2d
;
2764 if zebra
&& row land 1 = 1
2768 GlDraw.color
(c,c,c);
2769 let drawtabularstring s =
2771 let x'
= truncate
(x0 +. x) in
2772 let pos = nindex
s '
\000'
in
2774 then drawstring1 fs x'
(y+nfs) s
2776 let s1 = String.sub
s 0 pos
2777 and s2
= String.sub
s (pos+1) (String.length
s - pos - 1) in
2782 let s'
= withoutlastutf8 s in
2783 let s = s' ^
"@Uellipsis" in
2784 let w = measurestr
fs s in
2785 if float x'
+. w +. ww < float (hw + x'
)
2790 if float x'
+. ww +. measurestr
fs s1 > float (hw + x'
)
2794 ignore
(drawstring1 fs x'
(y+nfs) s1);
2795 drawstring1 fs (hw + x'
) (y+nfs) s2
2799 let x = if helpmode
&& row > 0 then x +. ww else x in
2800 let tabpos = nindex
s '
\t'
in
2803 let len = String.length
s - tabpos - 1 in
2804 let s1 = String.sub
s 0 tabpos
2805 and s2
= String.sub
s (tabpos + 1) len in
2806 let nx = drawstr x s1 in
2808 let x = x +. (max
tabw sw) in
2811 let len = String.length
s - 2 in
2812 if len > 0 && s.[0] = '
\xc2'
&& s.[1] = '
\xb7'
2814 let s = String.sub
s 2 len in
2815 let x = if not helpmode
then x +. ww else x in
2816 GlDraw.color
(1.2, 1.2, 1.2);
2817 let vinc = drawstring1 (fs+fs/4)
2818 (truncate
(x -. ww)) (y+nfs) s in
2819 GlDraw.color
(1., 1., 1.);
2820 vinc +. (float fs *. 0.8)
2826 ignore
(drawtabularstring s);
2832 GlDraw.color
(1.0, 1.0, 1.0) ~
alpha:0.5;
2833 let xadj = float (xadjsb () + 5) in
2835 if (row - m_first
) > fstate
.maxrows
2838 if row >= 0 && row < itemcount
2840 let (s, level
) = source#getitem
row in
2841 let pos0 = nindex
s '
\000'
in
2842 let y = (row - m_first
) * nfs in
2843 let x = float (level
+ m_pan
) *. ww in
2844 let (first, last
) = minfo.(row) in
2846 if pos0 > 0 && first > pos0
2847 then String.sub
s (pos0+1) (first-pos0-1)
2848 else String.sub
s 0 first
2850 let suffix = String.sub
s first (last
- first) in
2851 let w1 = measurestr fstate
.fontsize
prefix in
2852 let w2 = measurestr fstate
.fontsize
suffix in
2853 let x = x +. if conf
.leftscroll
then xadj else 5.0 in
2854 let x = if pos0 > 0 && first > pos0 then x +. float hw else x in
2856 and y0 = float (y+2) in
2858 and y1 = float (y+fs+3) in
2859 filledrect x0 y0 x1 y1;
2864 Gl.disable `texture_2d
;
2865 if Array.length
minfo > 0 then loop m_first
;
2868 method updownlevel incr
=
2869 let len = source#getitemcount
in
2871 if m_active
>= 0 && m_active
< len
2872 then snd
(source#getitem m_active
)
2876 if i
= len then i
-1 else if i
= -1 then 0 else
2877 let _, l = source#getitem i
in
2878 if l != curlevel then i
else flow (i
+incr
)
2880 let active = flow m_active
in
2881 let first = calcfirst m_first
active in
2882 G.postRedisplay "outline updownlevel";
2883 {< m_active
= active; m_first
= first >}
2885 method private key1
key mask
=
2886 let set1 active first qsearch
=
2887 coe {< m_active
= active; m_first
= first; m_qsearch
= qsearch
>}
2889 let search active pattern incr
=
2890 let active = if active = -1 then m_first
else active in
2893 if n >= 0 && n < source#getitemcount
2895 let s, _ = source#getitem
n in
2897 (try ignore
(Str.search_forward re
s 0); true
2898 with Not_found
-> false)
2900 else loop (n + incr
)
2907 let re = Str.regexp_case_fold pattern
in
2913 let itemcount = source#getitemcount
in
2914 let find start incr
=
2916 if i
= -1 || i
= itemcount
2919 if source#hasaction i
2921 else find (i
+ incr
)
2926 let set active first =
2927 let first = bound
first 0 (itemcount - fstate
.maxrows
) in
2929 coe {< m_active
= active; m_first
= first; m_qsearch
= E.s >}
2932 let isvisible first n = n >= first && n - first <= fstate
.maxrows
in
2934 let incr1 = if incr
> 0 then 1 else -1 in
2935 if isvisible m_first m_active
2938 let next = m_active
+ incr
in
2940 if next < 0 || next >= itemcount
2942 else find next incr1
2944 if abs
(m_active
- next) > fstate
.maxrows
2950 let first = m_first
+ incr
in
2951 let first = bound
first 0 (itemcount - fstate
.maxrows
) in
2953 let next = m_active
+ incr
in
2954 let next = bound
next 0 (itemcount - 1) in
2961 if isvisible first next
2968 let first = min
next m_first
in
2970 if abs
(next - first) > fstate
.maxrows
2976 let first = m_first
+ incr
in
2977 let first = bound
first 0 (itemcount - 1) in
2979 let next = m_active
+ incr
in
2980 let next = bound
next 0 (itemcount - 1) in
2981 let next = find next incr1 in
2983 if next = -1 || abs
(m_active
- first) > fstate
.maxrows
2985 let active = if m_active
= -1 then next else m_active
in
2990 if isvisible first active
2996 G.postRedisplay "listview navigate";
3000 | (@r|@s) when Wsi.withctrl mask
->
3001 let incr = if key = @r then -1 else 1 in
3003 match search (m_active
+ incr) m_qsearch
incr with
3005 state
.text <- m_qsearch ^
" [not found]";
3008 state
.text <- m_qsearch
;
3009 active, firstof m_first
active
3011 G.postRedisplay "listview ctrl-r/s";
3012 set1 active first m_qsearch
;
3014 | @insert
when Wsi.withctrl mask
->
3015 if m_active
>= 0 && m_active
< source#getitemcount
3017 let s, _ = source#getitem m_active
in
3023 if emptystr m_qsearch
3026 let qsearch = withoutlastutf8 m_qsearch
in
3030 G.postRedisplay "listview empty qsearch";
3031 set1 m_active m_first
E.s;
3035 match search m_active
qsearch ~
-1 with
3037 state
.text <- qsearch ^
" [not found]";
3040 state
.text <- qsearch;
3041 active, firstof m_first
active
3043 G.postRedisplay "listview backspace qsearch";
3044 set1 active first qsearch
3047 | key when (key != 0 && key land 0xff00 != 0xff00) ->
3048 let pattern = m_qsearch ^ toutf8
key in
3050 match search m_active
pattern 1 with
3052 state
.text <- pattern ^
" [not found]";
3055 state
.text <- pattern;
3056 active, firstof m_first
active
3058 G.postRedisplay "listview qsearch add";
3059 set1 active first pattern;
3063 if emptystr m_qsearch
3065 G.postRedisplay "list view escape";
3068 source#exit ~uioh
:(coe self
)
3069 ~cancel
:true ~
active:m_active ~
first:m_first ~pan
:m_pan
3071 | None
-> m_prev_uioh
3076 G.postRedisplay "list view kill qsearch";
3077 coe {< m_qsearch
= E.s >}
3080 | @enter
| @kpenter
->
3082 let self = {< m_qsearch
= E.s >} in
3084 G.postRedisplay "listview enter";
3085 if m_active
>= 0 && m_active
< source#getitemcount
3087 source#exit ~uioh
:(coe self) ~cancel
:false
3088 ~
active:m_active ~
first:m_first ~pan
:m_pan
;
3091 source#exit ~uioh
:(coe self) ~cancel
:true
3092 ~
active:m_active ~
first:m_first ~pan
:m_pan
;
3095 begin match opt with
3096 | None
-> m_prev_uioh
3100 | @delete
| @kpdelete
->
3103 | @up
| @kpup
-> navigate ~
-1
3104 | @down
| @kpdown
-> navigate 1
3105 | @prior
| @kpprior
-> navigate ~
-(fstate
.maxrows
)
3106 | @next | @kpnext
-> navigate fstate
.maxrows
3108 | @right
| @kpright
->
3110 G.postRedisplay "listview right";
3111 coe {< m_pan
= m_pan
- 1 >}
3113 | @left | @kpleft
->
3115 G.postRedisplay "listview left";
3116 coe {< m_pan
= m_pan
+ 1 >}
3118 | @home
| @kphome
->
3119 let active = find 0 1 in
3120 G.postRedisplay "listview home";
3124 let first = max
0 (itemcount - fstate
.maxrows
) in
3125 let active = find (itemcount - 1) ~
-1 in
3126 G.postRedisplay "listview end";
3129 | key when (key = 0 || key land 0xff00 = 0xff00) ->
3133 dolog
"listview unknown key %#x" key; coe self
3135 method key key mask
=
3136 match state
.mode
with
3137 | Textentry te
-> textentrykeyboard key mask te
; coe self
3140 | LinkNav
_ -> self#key1
key mask
3142 method button button down
x y _ =
3145 | 1 when x > state
.winw
- conf
.scrollbw
->
3146 G.postRedisplay "listview scroll";
3149 let _, position, sh = self#
scrollph in
3150 if y > truncate
position && y < truncate
(position +. sh)
3152 state
.mstate
<- Mscrolly
;
3156 let s = float (max
0 (y - conf
.scrollh
)) /. float state
.winh
in
3157 let first = truncate
(s *. float source#getitemcount
) in
3158 let first = min source#getitemcount
first in
3159 Some
(coe {< m_first
= first; m_active
= first >})
3161 state
.mstate
<- Mnone
;
3165 begin match self#elemunder
y with
3167 G.postRedisplay "listview click";
3168 source#exit ~uioh
:(coe {< m_active
= n >})
3169 ~cancel
:false ~
active:n ~
first:m_first ~pan
:m_pan
3173 | n when (n == 4 || n == 5) && not down
->
3174 let len = source#getitemcount
in
3176 if n = 5 && m_first
+ fstate
.maxrows
>= len
3180 let first = m_first
+ (if n == 4 then -1 else 1) in
3181 bound
first 0 (len - 1)
3183 G.postRedisplay "listview wheel";
3184 Some
(coe {< m_first
= first >})
3185 | n when (n = 6 || n = 7) && not down
->
3186 let inc = if n = 7 then -1 else 1 in
3187 G.postRedisplay "listview hwheel";
3188 Some
(coe {< m_pan
= m_pan
+ inc >})
3193 | None
-> m_prev_uioh
3196 method multiclick
_ x y = self#button
1 true x y
3199 match state
.mstate
with
3201 let s = float (max
0 (y - conf
.scrollh
)) /. float state
.winh
in
3202 let first = truncate
(s *. float source#getitemcount
) in
3203 let first = min source#getitemcount
first in
3204 G.postRedisplay "listview motion";
3205 coe {< m_first
= first; m_active
= first >}
3213 method pmotion
x y =
3214 if x < state
.winw
- conf
.scrollbw
3217 match self#elemunder
y with
3218 | None
-> Wsi.setcursor
Wsi.CURSOR_INHERIT
; m_active
3219 | Some
n -> Wsi.setcursor
Wsi.CURSOR_INFO
; n
3223 then (G.postRedisplay "listview pmotion"; {< m_active
= n >})
3228 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
3232 method infochanged
_ = ()
3234 method scrollpw
= (0, 0.0, 0.0)
3236 let nfs = fstate
.fontsize
+ 1 in
3237 let y = m_first
* nfs in
3238 let itemcount = source#getitemcount
in
3239 let maxi = max
0 (itemcount - fstate
.maxrows
) in
3240 let maxy = maxi * nfs in
3241 let p, h = scrollph y maxy in
3244 method modehash
= modehash
3245 method eformsgs
= false
3246 method alwaysscrolly
= true
3249 class outlinelistview ~zebra ~source
=
3250 let settext autonarrow
s =
3253 let ss = source#statestr
in
3257 else "{" ^
ss ^
"} [" ^
s ^
"]"
3258 else state
.text <- s
3264 ~source
:(source
:> lvsource
)
3266 ~modehash
:(findkeyhash conf
"outline")
3269 val m_autonarrow
= false
3271 method! key key mask
=
3273 if emptystr state
.text
3275 else fstate
.maxrows - 2
3277 let calcfirst first active =
3280 let rows = active - first in
3281 if rows > maxrows then active - maxrows else first
3285 let active = m_active
+ incr in
3286 let active = bound
active 0 (source#getitemcount
- 1) in
3287 let first = calcfirst m_first
active in
3288 G.postRedisplay "outline navigate";
3289 coe {< m_active
= active; m_first
= first >}
3291 let navscroll first =
3293 let dist = m_active
- first in
3299 else first + maxrows
3302 G.postRedisplay "outline navscroll";
3303 coe {< m_first
= first; m_active
= active >}
3305 let ctrl = Wsi.withctrl mask
in
3310 then (source#denarrow
; E.s)
3312 let pattern = source#renarrow
in
3313 if nonemptystr m_qsearch
3314 then (source#narrow m_qsearch
; m_qsearch
)
3318 settext (not m_autonarrow
) text;
3319 G.postRedisplay "toggle auto narrowing";
3320 coe {< m_first
= 0; m_active
= 0; m_autonarrow
= not m_autonarrow
>}
3322 | @slash
when emptystr m_qsearch
&& not m_autonarrow
->
3324 G.postRedisplay "toggle auto narrowing";
3325 coe {< m_first
= 0; m_active
= 0; m_autonarrow
= true >}
3328 source#narrow m_qsearch
;
3330 then source#add_narrow_pattern m_qsearch
;
3331 G.postRedisplay "outline ctrl-n";
3332 coe {< m_first
= 0; m_active
= 0 >}
3335 let active = source#calcactive
(getanchor
()) in
3336 let first = firstof m_first
active in
3337 G.postRedisplay "outline ctrl-s";
3338 coe {< m_first
= first; m_active
= active >}
3341 G.postRedisplay "outline ctrl-u";
3342 if m_autonarrow
&& nonemptystr m_qsearch
3344 ignore
(source#renarrow
);
3345 settext m_autonarrow
E.s;
3346 coe {< m_first
= 0; m_active
= 0; m_qsearch
= E.s >}
3349 source#del_narrow_pattern
;
3350 let pattern = source#renarrow
in
3352 if emptystr
pattern then E.s else "Narrowed to " ^
pattern
3354 settext m_autonarrow
text;
3355 coe {< m_first
= 0; m_active
= 0; m_qsearch
= E.s >}
3359 let first = max
0 (m_active
- (fstate
.maxrows / 2)) in
3360 G.postRedisplay "outline ctrl-l";
3361 coe {< m_first
= first >}
3363 | @tab
when m_autonarrow
->
3364 if nonemptystr m_qsearch
3366 G.postRedisplay "outline list view tab";
3367 source#add_narrow_pattern m_qsearch
;
3369 coe {< m_qsearch
= E.s >}
3373 | @escape
when m_autonarrow
->
3374 if nonemptystr m_qsearch
3375 then source#add_narrow_pattern m_qsearch
;
3378 | @enter
| @kpenter
when m_autonarrow
->
3379 if nonemptystr m_qsearch
3380 then source#add_narrow_pattern m_qsearch
;
3383 | key when m_autonarrow
&& (key != 0 && key land 0xff00 != 0xff00) ->
3384 let pattern = m_qsearch ^ toutf8
key in
3385 G.postRedisplay "outlinelistview autonarrow add";
3386 source#narrow
pattern;
3387 settext true pattern;
3388 coe {< m_first
= 0; m_active
= 0; m_qsearch
= pattern >}
3390 | key when m_autonarrow
&& key = @backspace
->
3391 if emptystr m_qsearch
3394 let pattern = withoutlastutf8 m_qsearch
in
3395 G.postRedisplay "outlinelistview autonarrow backspace";
3396 ignore
(source#renarrow
);
3397 source#narrow
pattern;
3398 settext true pattern;
3399 coe {< m_first
= 0; m_active
= 0; m_qsearch
= pattern >}
3401 | @delete
| @kpdelete
->
3402 source#remove m_active
;
3403 G.postRedisplay "outline delete";
3404 let active = max
0 (m_active
-1) in
3405 coe {< m_first
= firstof m_first
active;
3406 m_active
= active >}
3408 | @up
| @kpup
when ctrl ->
3409 navscroll (max
0 (m_first
- 1))
3411 | @down
| @kpdown
when ctrl ->
3412 navscroll (min
(source#getitemcount
- 1) (m_first
+ 1))
3414 | @up
| @kpup
-> navigate ~
-1
3415 | @down
| @kpdown
-> navigate 1
3416 | @prior
| @kpprior
-> navigate ~
-(fstate
.maxrows)
3417 | @next | @kpnext
-> navigate fstate
.maxrows
3419 | @right
| @kpright
->
3423 G.postRedisplay "outline ctrl right";
3424 {< m_pan
= m_pan
+ 1 >}
3426 else self#updownlevel
1
3430 | @left | @kpleft
->
3434 G.postRedisplay "outline ctrl left";
3435 {< m_pan
= m_pan
- 1 >}
3437 else self#updownlevel ~
-1
3441 | @home
| @kphome
->
3442 G.postRedisplay "outline home";
3443 coe {< m_first
= 0; m_active
= 0 >}
3446 let active = source#getitemcount
- 1 in
3447 let first = max
0 (active - fstate
.maxrows) in
3448 G.postRedisplay "outline end";
3449 coe {< m_active
= active; m_first
= first >}
3451 | _ -> super#
key key mask
3454 let genhistoutlines =
3455 let order ty
(p1
, c1
, _, _, _) (p2
, c2
, _, _, _) =
3457 | `lastvisit
-> compare c1
.lastvisit c2
.lastvisit
3458 | `path
-> compare p2 p1
3459 | `file
-> compare
(Filename.basename p2
) (Filename.basename p1
)
3461 let e1 = emptystr c1
.title
3462 and e2
= emptystr c2
.title
in
3464 then compare
(Filename.basename p2
) (Filename.basename p1
)
3467 else compare c1
.title c2
.title
3469 let showfullpath = ref false in
3472 let s = if orderty
= t
then "[@Uradical] " ^
s else "[ ] " ^
s in
3473 s, 0, Oaction
(fun () -> Config.historder
:= t
; reeenterhist := true)
3475 let list = ref [] in
3476 if Config.gethist
list
3480 (fun accu (path
, c, b, x, a) ->
3481 let hist = (path
, (c, b, x, a)) in
3482 let s = if !showfullpath then path
else Filename.basename path
in
3483 let base = mbtoutf8
s in
3484 (base ^
"\000" ^
c.title
, 1, Ohistory
hist) :: accu
3486 [ setorty "Sort by time of last visit" `lastvisit
;
3487 setorty "Sort by file name" `file
;
3488 setorty "Sort by path" `path
;
3489 setorty "Sort by title" `title
;
3490 (if !showfullpath then "@Uradical "
3491 else " ") ^
"Show full path", 0, Oaction
(fun () ->
3492 showfullpath := not
!showfullpath; reeenterhist := true)
3493 ] (List.sort
(order orderty
) !list)
3499 let gotohist (path
, (c, bookmarks
, x, anchor)) =
3500 Config.save
leavebirdseye;
3501 state
.anchor <- anchor;
3503 state
.bookmarks
<- bookmarks
;
3504 state
.origin
<- E.s;
3506 let x0, y0, x1, y1 = conf
.trimfuzz
in
3507 wcmd "trimset %d %d %d %d %d" (btod conf
.trimmargins
) x0 y0 x1 y1;
3511 let makecheckers () =
3512 (* Based on lablGL-1.04/LablGlut/examples/lablGL/checker.ml which had
3514 converted by Issac Trotts. July 25, 2002 *)
3515 let image = GlPix.create `ubyte ~format
:`luminance ~width
:2 ~height
:2 in
3516 Raw.sets_string
(GlPix.to_raw
image) ~
pos:0 "\255\200\200\255";
3517 let id = GlTex.gen_texture
() in
3518 GlTex.bind_texture ~target
:`texture_2d
id;
3519 GlPix.store
(`unpack_alignment
1);
3520 GlTex.image2d
image;
3521 List.iter
(GlTex.parameter ~target
:`texture_2d
)
3522 [ `mag_filter `nearest
; `min_filter `nearest
];
3526 let setcheckers enabled
=
3527 match state
.checkerstexid
with
3529 if enabled
then state
.checkerstexid
<- Some
(makecheckers ())
3531 | Some checkerstexid
->
3534 GlTex.delete_texture checkerstexid
;
3535 state
.checkerstexid
<- None
;
3539 let describe_location () =
3540 let fn = page_of_y state
.y in
3541 let ln = page_of_y
(state
.y + state
.winh
- hscrollh () - 1) in
3542 let maxy = state
.maxy - (if conf
.maxhfit
then state
.winh
else 0) in
3546 else (100. *. (float state
.y /. float maxy))
3550 Printf.sprintf
"page %d of %d [%.2f%%]"
3551 (fn+1) state
.pagecount
percent
3554 "pages %d-%d of %d [%.2f%%]"
3555 (fn+1) (ln+1) state
.pagecount
percent
3558 let setpresentationmode v
=
3559 let n = page_of_y state
.y in
3560 state
.anchor <- (n, 0.0, 1.0);
3561 conf
.presentation
<- v
;
3562 if conf
.fitmodel
= FitPage
3563 then reqlayout conf
.angle conf
.fitmodel
;
3568 let btos b = if b then "@Uradical" else E.s in
3569 let showextended = ref false in
3570 let leave mode
_ = state
.mode
<- mode
in
3573 val mutable m_first_time
= true
3574 val mutable m_l
= []
3575 val mutable m_a
= E.a
3576 val mutable m_prev_uioh
= nouioh
3577 val mutable m_prev_mode
= View
3579 inherit lvsourcebase
3581 method reset prev_mode prev_uioh
=
3582 m_a
<- Array.of_list
(List.rev m_l
);
3584 m_prev_mode
<- prev_mode
;
3585 m_prev_uioh
<- prev_uioh
;
3589 if n >= Array.length m_a
3593 | _, _, _, Action
_ -> m_active
<- n
3594 | _, _, _, Noaction
-> loop (n+1)
3597 m_first_time
<- false;
3600 method int name get
set =
3602 (name
, `
int get
, 1, Action
(
3605 try set (int_of_string
s)
3607 state
.text <- Printf.sprintf
"bad integer `%s': %s"
3611 let te = name ^
": ", E.s, None
, intentry, ondone, true in
3612 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3616 method int_with_suffix name get
set =
3618 (name
, `intws get
, 1, Action
(
3621 try set (int_of_string_with_suffix
s)
3623 state
.text <- Printf.sprintf
"bad integer `%s': %s"
3628 name ^
": ", E.s, None
, intentry_with_suffix, ondone, true
3630 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3634 method bool ?
(offset
=1) ?
(btos=btos) name get
set =
3636 (name
, `
bool (btos, get
), offset
, Action
(
3643 method color name get
set =
3645 (name
, `color get
, 1, Action
(
3647 let invalid = (nan
, nan
, nan
) in
3650 try color_of_string
s
3652 state
.text <- Printf.sprintf
"bad color `%s': %s"
3659 let te = name ^
": ", E.s, None
, textentry, ondone, true in
3660 state
.text <- color_to_string
(get
());
3661 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3665 method string name get
set =
3667 (name
, `
string get
, 1, Action
(
3669 let ondone s = set s in
3670 let te = name ^
": ", E.s, None
, textentry, ondone, true in
3671 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3675 method colorspace name get
set =
3677 (name
, `
string get
, 1, Action
(
3681 inherit lvsourcebase
3684 m_active
<- CSTE.to_int conf
.colorspace
;
3687 method getitemcount
=
3688 Array.length
CSTE.names
3691 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3692 ignore
(uioh
, first, pan
);
3693 if not cancel
then set active;
3695 method hasaction
_ = true
3699 let modehash = findkeyhash conf
"info" in
3700 coe (new listview ~zebra
:false ~helpmode
:false
3701 ~
source ~trusted
:true ~
modehash)
3704 method paxmark name get
set =
3706 (name
, `
string get
, 1, Action
(
3710 inherit lvsourcebase
3713 m_active
<- MTE.to_int conf
.paxmark
;
3716 method getitemcount
= Array.length
MTE.names
3717 method getitem
n = (MTE.names
.(n), 0)
3718 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3719 ignore
(uioh
, first, pan
);
3720 if not cancel
then set active;
3722 method hasaction
_ = true
3726 let modehash = findkeyhash conf
"info" in
3727 coe (new listview ~zebra
:false ~helpmode
:false
3728 ~
source ~trusted
:true ~
modehash)
3731 method fitmodel name get
set =
3733 (name
, `
string get
, 1, Action
(
3737 inherit lvsourcebase
3740 m_active
<- FMTE.to_int conf
.fitmodel
;
3743 method getitemcount
= Array.length
FMTE.names
3744 method getitem
n = (FMTE.names
.(n), 0)
3745 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3746 ignore
(uioh
, first, pan
);
3747 if not cancel
then set active;
3749 method hasaction
_ = true
3753 let modehash = findkeyhash conf
"info" in
3754 coe (new listview ~zebra
:false ~helpmode
:false
3755 ~
source ~trusted
:true ~
modehash)
3758 method caption
s offset
=
3759 m_l
<- (s, `empty
, offset
, Noaction
) :: m_l
3761 method caption2
s f offset
=
3762 m_l
<- (s, `
string f, offset
, Noaction
) :: m_l
3764 method getitemcount
= Array.length m_a
3767 let tostr = function
3768 | `
int f -> string_of_int
(f ())
3769 | `intws
f -> string_with_suffix_of_int
(f ())
3771 | `color
f -> color_to_string
(f ())
3772 | `
bool (btos, f) -> btos (f ())
3775 let name, t
, offset
, _ = m_a
.(n) in
3776 ((let s = tostr t
in
3778 then Printf.sprintf
"%s\t%s" name s
3782 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3787 match m_a
.(active) with
3788 | _, _, _, Action
f -> f uioh
3789 | _, _, _, Noaction
-> uioh
3800 method hasaction
n =
3802 | _, _, _, Action
_ -> true
3803 | _, _, _, Noaction
-> false
3806 let rec fillsrc prevmode prevuioh
=
3807 let sep () = src#caption
E.s 0 in
3808 let colorp name get
set =
3810 (fun () -> color_to_string
(get
()))
3813 let c = color_of_string
v in
3816 state
.text <- Printf.sprintf
"bad color `%s': %s" v (exntos exn
)
3819 let oldmode = state
.mode
in
3820 let birdseye = isbirdseye state
.mode
in
3822 src#caption
(if birdseye then "Setup (Bird's eye)" else "Setup") 0;
3824 src#
bool "presentation mode"
3825 (fun () -> conf
.presentation
)
3826 (fun v -> setpresentationmode v);
3828 src#
bool "ignore case in searches"
3829 (fun () -> conf
.icase
)
3830 (fun v -> conf
.icase
<- v);
3833 (fun () -> conf
.preload)
3834 (fun v -> conf
.preload <- v);
3836 src#
bool "highlight links"
3837 (fun () -> conf
.hlinks
)
3838 (fun v -> conf
.hlinks
<- v);
3840 src#
bool "under info"
3841 (fun () -> conf
.underinfo
)
3842 (fun v -> conf
.underinfo
<- v);
3844 src#
bool "persistent bookmarks"
3845 (fun () -> conf
.savebmarks
)
3846 (fun v -> conf
.savebmarks
<- v);
3848 src#fitmodel
"fit model"
3849 (fun () -> FMTE.to_string conf
.fitmodel
)
3850 (fun v -> reqlayout conf
.angle
(FMTE.of_int
v));
3852 src#
bool "trim margins"
3853 (fun () -> conf
.trimmargins
)
3854 (fun v -> settrim v conf
.trimfuzz
; fillsrc prevmode prevuioh
);
3856 src#
bool "persistent location"
3857 (fun () -> conf
.jumpback
)
3858 (fun v -> conf
.jumpback
<- v);
3861 src#
int "inter-page space"
3862 (fun () -> conf
.interpagespace
)
3864 conf
.interpagespace
<- n;
3865 docolumns conf
.columns
;
3867 match state
.layout with
3872 state
.maxy <- calcheight
();
3873 let y = getpagey
pageno in
3878 (fun () -> conf
.pagebias
)
3879 (fun v -> conf
.pagebias
<- v);
3881 src#
int "scroll step"
3882 (fun () -> conf
.scrollstep
)
3883 (fun n -> conf
.scrollstep
<- n);
3885 src#
int "horizontal scroll step"
3886 (fun () -> conf
.hscrollstep
)
3887 (fun v -> conf
.hscrollstep
<- v);
3889 src#
int "auto scroll step"
3891 match state
.autoscroll
with
3893 | _ -> conf
.autoscrollstep
)
3895 let n = boundastep state
.winh
n in
3896 if state
.autoscroll
<> None
3897 then state
.autoscroll
<- Some
n;
3898 conf
.autoscrollstep
<- n);
3901 (fun () -> truncate
(conf
.zoom *. 100.))
3902 (fun v -> setzoom ((float v) /. 100.));
3905 (fun () -> conf
.angle
)
3906 (fun v -> reqlayout v conf
.fitmodel
);
3908 src#
int "scroll bar width"
3909 (fun () -> conf
.scrollbw
)
3912 reshape state
.winw state
.winh
;
3915 src#
int "scroll handle height"
3916 (fun () -> conf
.scrollh
)
3917 (fun v -> conf
.scrollh
<- v;);
3919 src#
int "thumbnail width"
3920 (fun () -> conf
.thumbw
)
3922 conf
.thumbw
<- min
4096 v;
3925 leavebirdseye beye
false;
3932 let mode = state
.mode in
3933 src#
string "columns"
3935 match conf
.columns
with
3937 | Cmulti
(multi
, _) -> multicolumns_to_string multi
3938 | Csplit
(count
, _) -> "-" ^ string_of_int count
3941 let n, a, b = multicolumns_of_string
v in
3942 setcolumns mode n a b);
3945 src#caption
"Pixmap cache" 0;
3946 src#int_with_suffix
"size (advisory)"
3947 (fun () -> conf
.memlimit
)
3948 (fun v -> conf
.memlimit
<- v);
3951 (fun () -> Printf.sprintf
"%s bytes, %d tiles"
3952 (string_with_suffix_of_int state
.memused
)
3953 (Hashtbl.length state
.tilemap
)) 1;
3956 src#caption
"Layout" 0;
3957 src#caption2
"Dimension"
3959 Printf.sprintf
"%dx%d (virtual %dx%d)"
3960 state
.winw state
.winh
3965 src#caption2
"Position" (fun () ->
3966 Printf.sprintf
"%dx%d" state
.x state
.y
3969 src#caption2
"Position" (fun () -> describe_location ()) 1
3973 src#
bool ~offset
:0 ~
btos:(fun v -> if v then "(on)" else "(off)")
3974 "Save these parameters as global defaults at exit"
3975 (fun () -> conf
.bedefault
)
3976 (fun v -> conf
.bedefault
<- v)
3980 let btos b = if b then "@Ulguillemet" else "@Urguillemet" in
3981 src#
bool ~offset
:0 ~
btos "Extended parameters"
3982 (fun () -> !showextended)
3983 (fun v -> showextended := v; fillsrc prevmode prevuioh
);
3987 (fun () -> conf
.checkers
)
3988 (fun v -> conf
.checkers
<- v; setcheckers v);
3989 src#
bool "update cursor"
3990 (fun () -> conf
.updatecurs
)
3991 (fun v -> conf
.updatecurs
<- v);
3992 src#
bool "scroll-bar on the left"
3993 (fun () -> conf
.leftscroll
)
3994 (fun v -> conf
.leftscroll
<- v);
3996 (fun () -> conf
.verbose
)
3997 (fun v -> conf
.verbose
<- v);
3998 src#
bool "invert colors"
3999 (fun () -> conf
.invert
)
4000 (fun v -> conf
.invert
<- v);
4002 (fun () -> conf
.maxhfit
)
4003 (fun v -> conf
.maxhfit
<- v);
4004 src#
bool "redirect stderr"
4005 (fun () -> conf
.redirectstderr)
4006 (fun v -> conf
.redirectstderr <- v; redirectstderr ());
4008 (fun () -> conf
.pax
!= None
)
4011 then conf
.pax
<- Some
(ref (now
(), 0, 0))
4012 else conf
.pax
<- None
);
4013 src#
string "uri launcher"
4014 (fun () -> conf
.urilauncher
)
4015 (fun v -> conf
.urilauncher
<- v);
4016 src#
string "path launcher"
4017 (fun () -> conf
.pathlauncher
)
4018 (fun v -> conf
.pathlauncher
<- v);
4019 src#
string "tile size"
4020 (fun () -> Printf.sprintf
"%dx%d" conf
.tilew conf
.tileh
)
4023 let w, h = Scanf.sscanf
v "%dx%d" (fun w h -> w, h) in
4024 conf
.tilew
<- max
64 w;
4025 conf
.tileh
<- max
64 h;
4028 state
.text <- Printf.sprintf
"bad tile size `%s': %s"
4031 src#
int "texture count"
4032 (fun () -> conf
.texcount
)
4035 then conf
.texcount
<- v
4036 else showtext '
!'
" Failed to set texture count please retry later"
4038 src#
int "slice height"
4039 (fun () -> conf
.sliceheight
)
4041 conf
.sliceheight
<- v;
4042 wcmd "sliceh %d" conf
.sliceheight
;
4044 src#
int "anti-aliasing level"
4045 (fun () -> conf
.aalevel
)
4047 conf
.aalevel
<- bound
v 0 8;
4048 state
.anchor <- getanchor
();
4049 opendoc state
.path state
.password;
4051 src#
string "page scroll scaling factor"
4052 (fun () -> string_of_float conf
.pgscale)
4055 let s = float_of_string
v in
4058 state
.text <- Printf.sprintf
4059 "bad page scroll scaling factor `%s': %s" v (exntos exn
)
4062 src#
int "ui font size"
4063 (fun () -> fstate
.fontsize
)
4064 (fun v -> setfontsize (bound
v 5 100));
4065 src#
int "hint font size"
4066 (fun () -> conf
.hfsize
)
4067 (fun v -> conf
.hfsize
<- bound
v 5 100);
4068 colorp "background color"
4069 (fun () -> conf
.bgcolor
)
4070 (fun v -> conf
.bgcolor
<- v);
4071 src#
bool "crop hack"
4072 (fun () -> conf
.crophack
)
4073 (fun v -> conf
.crophack
<- v);
4074 src#
string "trim fuzz"
4075 (fun () -> irect_to_string conf
.trimfuzz
)
4078 conf
.trimfuzz
<- irect_of_string
v;
4080 then settrim true conf
.trimfuzz
;
4082 state
.text <- Printf.sprintf
"bad irect `%s': %s" v (exntos exn
)
4084 src#
string "throttle"
4086 match conf
.maxwait
with
4087 | None
-> "show place holder if page is not ready"
4090 then "wait for page to fully render"
4092 "wait " ^ string_of_float
time
4093 ^
" seconds before showing placeholder"
4097 let f = float_of_string
v in
4099 then conf
.maxwait
<- None
4100 else conf
.maxwait
<- Some
f
4102 state
.text <- Printf.sprintf
"bad time `%s': %s" v (exntos exn
)
4104 src#
string "ghyll scroll"
4106 match conf
.ghyllscroll
with
4108 | Some nab
-> ghyllscroll_to_string nab
4111 try conf
.ghyllscroll
<- ghyllscroll_of_string
v
4113 state
.text <- Printf.sprintf
"bad ghyll `%s': %s" v (exntos exn
)
4115 src#
string "selection command"
4116 (fun () -> conf
.selcmd
)
4117 (fun v -> conf
.selcmd
<- v);
4118 src#
string "synctex command"
4119 (fun () -> conf
.stcmd
)
4120 (fun v -> conf
.stcmd
<- v);
4121 src#
string "pax command"
4122 (fun () -> conf
.paxcmd
)
4123 (fun v -> conf
.paxcmd
<- v);
4124 src#
string "ask password command"
4125 (fun () -> conf
.passcmd)
4126 (fun v -> conf
.passcmd <- v);
4127 src#
string "save path command"
4128 (fun () -> conf
.savecmd
)
4129 (fun v -> conf
.savecmd
<- v);
4130 src#colorspace
"color space"
4131 (fun () -> CSTE.to_string conf
.colorspace
)
4133 conf
.colorspace
<- CSTE.of_int
v;
4137 src#paxmark
"pax mark method"
4138 (fun () -> MTE.to_string conf
.paxmark
)
4139 (fun v -> conf
.paxmark
<- MTE.of_int
v);
4143 (fun () -> conf
.usepbo
)
4144 (fun v -> conf
.usepbo
<- v);
4145 src#
bool "mouse wheel scrolls pages"
4146 (fun () -> conf
.wheelbypage
)
4147 (fun v -> conf
.wheelbypage
<- v);
4148 src#
bool "open remote links in a new instance"
4149 (fun () -> conf
.riani
)
4150 (fun v -> conf
.riani
<- v);
4154 src#caption
"Document" 0;
4155 List.iter
(fun (_, s) -> src#caption
s 1) state
.docinfo
;
4156 src#caption2
"Pages"
4157 (fun () -> string_of_int state
.pagecount
) 1;
4158 src#caption2
"Dimensions"
4159 (fun () -> string_of_int
(List.length state
.pdims
)) 1;
4163 src#caption
"Trimmed margins" 0;
4164 src#caption2
"Dimensions"
4165 (fun () -> string_of_int
(List.length state
.pdims
)) 1;
4169 src#caption
"OpenGL" 0;
4170 src#caption
(Printf.sprintf
"Vendor\t%s" (GlMisc.get_string `vendor
)) 1;
4171 src#caption
(Printf.sprintf
"Renderer\t%s" (GlMisc.get_string `renderer
)) 1;
4174 src#caption
"Location" 0;
4175 if nonemptystr state
.origin
4176 then src#caption
("Orign\t" ^ mbtoutf8 state
.origin
) 1;
4177 src#caption
("Path\t" ^ mbtoutf8 state
.path
) 1;
4179 src#reset prevmode prevuioh
;
4184 let prevmode = state
.mode
4185 and prevuioh
= state
.uioh in
4186 fillsrc prevmode prevuioh
;
4187 let source = (src :> lvsource
) in
4188 let modehash = findkeyhash conf
"info" in
4189 state
.uioh <- coe (object (self)
4190 inherit listview ~zebra
:false ~helpmode
:false
4191 ~
source ~trusted
:true ~
modehash as super
4192 val mutable m_prevmemused
= 0
4193 method! infochanged
= function
4195 if m_prevmemused
!= state
.memused
4197 m_prevmemused
<- state
.memused
;
4198 G.postRedisplay "memusedchanged";
4200 | Pdim
-> G.postRedisplay "pdimchanged"
4201 | Docinfo
-> fillsrc prevmode prevuioh
4203 method! key key mask
=
4204 if not
(Wsi.withctrl mask
)
4207 | @left | @kpleft
-> coe (self#updownlevel ~
-1)
4208 | @right
| @kpright
-> coe (self#updownlevel
1)
4209 | _ -> super#
key key mask
4210 else super#
key key mask
4212 G.postRedisplay "info";
4218 inherit lvsourcebase
4219 method getitemcount
= Array.length state
.help
4221 let s, l, _ = state
.help
.(n) in
4224 method exit ~
uioh ~cancel ~
active ~
first ~pan
=
4228 match state
.help
.(active) with
4229 | _, _, Action
f -> Some
(f uioh)
4230 | _, _, Noaction
-> Some
uioh
4239 method hasaction
n =
4240 match state
.help
.(n) with
4241 | _, _, Action
_ -> true
4242 | _, _, Noaction
-> false
4248 let modehash = findkeyhash conf
"help" in
4250 state
.uioh <- coe (new listview
4251 ~zebra
:false ~helpmode
:true
4252 ~
source ~trusted
:true ~
modehash);
4253 G.postRedisplay "help";
4259 inherit lvsourcebase
4260 val mutable m_items
= E.a
4262 method getitemcount
= 1 + Array.length m_items
4267 else m_items
.(n-1), 0
4269 method exit ~
uioh ~cancel ~
active ~
first ~pan
=
4274 then Buffer.clear state
.errmsgs
;
4281 method hasaction
n =
4285 state
.newerrmsgs
<- false;
4286 let l = Str.split newlinere
(Buffer.contents state
.errmsgs
) in
4287 m_items
<- Array.of_list
l
4296 let source = (msgsource :> lvsource
) in
4297 let modehash = findkeyhash conf
"listview" in
4298 state
.uioh <- coe (object
4299 inherit listview ~zebra
:false ~helpmode
:false
4300 ~
source ~trusted
:false ~
modehash as super
4303 then msgsource#reset
;
4306 G.postRedisplay "msgs";
4310 let editor = getenvwithdef
"EDITOR" E.s in
4314 let tmppath = Filename.temp_file
"llpp" "note" in
4317 let oc = open_out
tmppath in
4321 let execstr = editor ^
" " ^
tmppath in
4323 match Unix.system
execstr with
4324 | (exception exn
) ->
4326 Printf.sprintf
"Unix.system(%S) failed: %s" execstr (exntos exn
);
4328 | Unix.WEXITED
0 -> filelines
tmppath
4331 Printf.sprintf
"editor process(%s) exited abnormally: %d"
4334 | Unix.WSIGNALED
n ->
4336 Printf.sprintf
"editor process(%s) was killed by signal %d"
4339 | Unix.WSTOPPED
n ->
4341 Printf.sprintf
"editor(%s) process was stopped by signal %d"
4345 match Unix.unlink
tmppath with
4346 | (exception exn
) ->
4348 Printf.sprintf
"failed to ulink %S: %s"
4349 tmppath (exntos exn
);
4354 let enterannotmode opaque slinkindex
=
4357 inherit lvsourcebase
4358 val mutable m_text
= E.s
4359 val mutable m_items
= E.a
4361 method getitemcount
= Array.length m_items
4364 let label, _func
= m_items
.(n) in
4367 method exit ~
uioh ~cancel ~
active ~
first ~pan
=
4368 ignore
(uioh, first, pan
);
4371 let _label, func
= m_items
.(active) in
4376 method hasaction
_ = true
4379 let rec split accu b i
=
4381 if p = String.length
s
4382 then (String.sub
s b (p-b), unit) :: accu
4384 if (i
> 70 && s.[p] = ' '
) || s.[p] = '
\r'
|| s.[p] = '
\n'
4386 let ss = if i
= 0 then E.s else String.sub
s b i
in
4387 split ((ss, unit)::accu) (p+1) 0
4392 wcmd "freepage %s" (~
> opaque);
4394 Hashtbl.fold (fun key opaque'
accu ->
4395 if opaque'
= opaque'
4396 then key :: accu else accu) state
.pagemap
[]
4398 List.iter
(Hashtbl.remove state
.pagemap
) keys;
4403 delannot
opaque slinkindex
;
4406 let edit inline
() =
4411 modannot
opaque slinkindex
s;
4417 let mode = state
.mode in
4420 ("annotation: ", m_text
, None
, textentry, update, true),
4421 fun _ -> state
.mode <- mode);
4425 let s = getusertext m_text
in
4430 ( "[Copy]", fun () -> selstring m_text
)
4431 :: ("[Delete]", dele)
4432 :: ("[Edit]", edit true)
4434 :: split [] 0 0 |> List.rev
|> Array.of_list
4441 let s = getannotcontents
opaque slinkindex
in
4444 let source = (msgsource :> lvsource
) in
4445 let modehash = findkeyhash conf
"listview" in
4446 state
.uioh <- coe (object
4447 inherit listview ~zebra
:false ~helpmode
:false
4448 ~
source ~trusted
:false ~
modehash
4450 G.postRedisplay "enterannotmode";
4453 let gotounder under =
4454 let getpath filename
=
4456 if nonemptystr filename
4458 if Filename.is_relative filename
4460 let dir = Filename.dirname state
.path in
4462 if Filename.is_implicit
dir
4463 then Filename.concat
(Sys.getcwd
()) dir
4466 Filename.concat
dir filename
4470 if Sys.file_exists
path
4475 | Ulinkgoto
(pageno, top) ->
4479 gotopage1 pageno top;
4485 | Uremote
(filename
, pageno) ->
4486 let path = getpath filename
in
4491 let command = Printf.sprintf
"%s -page %d %S" !selfexec pageno path in
4492 try addpid @@ popen
command []
4494 Printf.eprintf
"failed to execute `%s': %s\n" command (exntos exn
);
4497 let anchor = getanchor
() in
4498 let ranchor = state
.path, state
.password, anchor, state
.origin
in
4499 state
.origin
<- E.s;
4500 state
.anchor <- (pageno, 0.0, 0.0);
4501 state
.ranchors
<- ranchor :: state
.ranchors
;
4504 else showtext '
!'
("Could not find " ^ filename
)
4506 | Uremotedest
(filename
, destname
) ->
4507 let path = getpath filename
in
4512 let command = !selfexec ^
" " ^
path ^
" -dest " ^ destname
in
4513 try addpid @@ popen
command []
4516 "failed to execute `%s': %s\n" command (exntos exn
);
4519 let anchor = getanchor
() in
4520 let ranchor = state
.path, state
.password, anchor, state
.origin
in
4521 state
.origin
<- E.s;
4522 state
.nameddest
<- destname
;
4523 state
.ranchors
<- ranchor :: state
.ranchors
;
4526 else showtext '
!'
("Could not find " ^ filename
)
4528 | Uunexpected
_ | Ulaunch
_ | Unamed
_ | Utext
_ | Unone
-> ()
4529 | Uannotation
(opaque, slinkindex
) -> enterannotmode opaque slinkindex
4532 let gotooutline (_, _, kind
) =
4536 let (pageno, y, _) = anchor in
4538 (if conf
.presentation
then (pageno, y, 1.0) else anchor)
4542 | Ouri
uri -> gotounder (Ulinkuri
uri)
4543 | Olaunch cmd
-> gotounder (Ulaunch cmd
)
4544 | Oremote remote
-> gotounder (Uremote remote
)
4545 | Ohistory
hist -> gotohist hist
4546 | Oremotedest remotedest
-> gotounder (Uremotedest remotedest
)
4550 let outlinesource sourcetype
=
4552 inherit lvsourcebase
4553 val mutable m_items
= E.a
4554 val mutable m_minfo
= E.a
4555 val mutable m_orig_items
= E.a
4556 val mutable m_orig_minfo
= E.a
4557 val mutable m_narrow_patterns
= []
4558 val mutable m_hadremovals
= false
4559 val mutable m_gen
= -1
4561 method getitemcount
=
4562 Array.length m_items
+ (if m_hadremovals
then 1 else 0)
4565 if n == Array.length m_items
&& m_hadremovals
4567 ("[Confirm removal]", 0)
4569 let s, n, _ = m_items
.(n) in
4572 method exit ~
uioh ~cancel ~
active ~
first ~pan
=
4573 ignore
(uioh, first);
4574 let confrimremoval = m_hadremovals
&& active = Array.length m_items
in
4576 if m_narrow_patterns
= []
4577 then m_orig_items
, m_orig_minfo
4578 else m_items
, m_minfo
4582 if not
confrimremoval
4584 gotooutline m_items
.(active);
4589 state
.bookmarks
<- Array.to_list m_items
;
4590 m_orig_items
<- m_items
;
4591 m_orig_minfo
<- m_minfo
;
4601 method hasaction
_ = true
4604 if Array.length m_items
!= Array.length m_orig_items
4607 match m_narrow_patterns
with
4609 | many
-> String.concat
"@Uellipsis" (List.rev many
)
4611 "Narrowed to " ^
s ^
" (ctrl-u to restore)"
4615 match m_narrow_patterns
with
4618 | head
:: _ -> "@Uellipsis" ^ head
4620 method narrow
pattern =
4621 let reopt = try Some
(Str.regexp_case_fold
pattern) with _ -> None
in
4625 let rec loop accu minfo n =
4628 m_items
<- Array.of_list
accu;
4629 m_minfo
<- Array.of_list
minfo;
4632 let (s, _, t
) as o = m_items
.(n) in
4635 | Oaction
_ -> o :: accu, (0, 0) :: minfo
4636 | Onone
| Oanchor
_ | Ouri
_ | Olaunch
_
4637 | Oremote
_ | Oremotedest
_ | Ohistory
_ ->
4639 try Str.search_forward
re s 0
4640 with Not_found
-> -1
4643 then o :: accu, (first, Str.match_end
()) :: minfo
4646 loop accu minfo (n-1)
4648 loop [] [] (Array.length m_items
- 1)
4650 method! getminfo
= m_minfo
4654 match sourcetype
with
4655 | `bookmarks
-> Array.of_list state
.bookmarks
4656 | `outlines
-> state
.outlines
4657 | `history
-> genhistoutlines !Config.historder
4659 m_minfo
<- m_orig_minfo
;
4660 m_items
<- m_orig_items
4663 if sourcetype
= `bookmarks
4665 if m >= 0 && m < Array.length m_items
4667 m_hadremovals
<- true;
4668 m_items
<- Array.init
(Array.length m_items
- 1) (fun n ->
4669 let n = if n >= m then n+1 else n in
4674 method add_narrow_pattern
pattern =
4675 m_narrow_patterns
<- pattern :: m_narrow_patterns
4677 method del_narrow_pattern
=
4678 match m_narrow_patterns
with
4679 | _ :: rest
-> m_narrow_patterns
<- rest
4684 match m_narrow_patterns
with
4685 | pattern :: [] -> self#narrow
pattern; pattern
4687 List.fold_left
(fun accu pattern ->
4688 self#narrow
pattern;
4689 pattern ^
"@Uellipsis" ^
accu) E.s list
4691 method calcactive
anchor =
4692 let rely = getanchory anchor in
4693 let rec loop n best bestd
=
4694 if n = Array.length m_items
4697 let _, _, kind
= m_items
.(n) in
4700 let orely = getanchory anchor in
4701 let d = abs
(orely - rely) in
4704 else loop (n+1) best bestd
4705 | Onone
| Oremote
_ | Olaunch
_
4706 | Oremotedest
_ | Ouri
_ | Ohistory
_ | Oaction
_ ->
4707 loop (n+1) best bestd
4711 method reset
anchor items =
4712 m_hadremovals
<- false;
4713 if state
.gen
!= m_gen
4715 m_orig_items
<- items;
4717 m_narrow_patterns
<- [];
4719 m_orig_minfo
<- E.a;
4723 if items != m_orig_items
4725 m_orig_items
<- items;
4726 if m_narrow_patterns
== []
4727 then m_items
<- items;
4730 let active = self#calcactive
anchor in
4732 m_first
<- firstof m_first
active
4736 let enterselector sourcetype
=
4738 let source = outlinesource sourcetype
in
4741 match sourcetype
with
4742 | `bookmarks
-> Array.of_list state
.bookmarks
4743 | `
outlines -> state
.outlines
4744 | `history
-> genhistoutlines !Config.historder
4746 if Array.length
outlines = 0
4748 showtext ' ' errmsg
;
4751 state
.text <- source#greetmsg
;
4752 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
4753 let anchor = getanchor
() in
4754 source#reset
anchor outlines;
4756 coe (new outlinelistview ~zebra
:(sourcetype
=`history
) ~
source);
4757 G.postRedisplay "enter selector";
4761 let enteroutlinemode =
4762 let f = enterselector `
outlines in
4763 fun () -> f "Document has no outline";
4766 let enterbookmarkmode =
4767 let f = enterselector `bookmarks
in
4768 fun () -> f "Document has no bookmarks (yet)";
4771 let enterhistmode () = enterselector `history
"No history (yet)";;
4773 let quickbookmark ?title
() =
4774 match state
.layout with
4780 let tm = Unix.localtime
(now
()) in
4781 Printf.sprintf
"Quick (page %d) (bookmarked at %d/%d/%d %d:%d)"
4785 (tm.Unix.tm_year
+ 1900)
4788 | Some
title -> title
4790 state
.bookmarks
<- (title, 0, Oanchor
(getanchor1
l)) :: state
.bookmarks
4793 let setautoscrollspeed step goingdown
=
4794 let incr = max
1 ((abs step
) / 2) in
4795 let incr = if goingdown
then incr else -incr in
4796 let astep = boundastep state
.winh
(step
+ incr) in
4797 state
.autoscroll
<- Some
astep;
4801 match conf
.columns
with
4803 | Csingle
_ | Cmulti
_ -> state
.x != 0 || conf
.zoom > 1.0
4806 let panbound x = bound
x (-state
.w) (wadjsb () + state
.winw
);;
4808 let existsinrow pageno (columns
, coverA
, coverB
) p =
4809 let last = ((pageno - coverA
) mod columns
) + columns
in
4810 let rec any = function
4813 if l.pageno = coverA
- 1 || l.pageno = state
.pagecount
- coverB
4817 then (if l.pageno = last then false else any rest
)
4825 match state
.layout with
4827 let pageno = page_of_y state
.y in
4828 gotoghyll (getpagey
(pageno+1))
4830 match conf
.columns
with
4832 if conf
.presentation
&& rest
== [] && l.pageh
> l.pagey + l.pagevh
4834 let y = clamp (pgscale state
.winh
) in
4837 let pageno = min
(l.pageno+1) (state
.pagecount
-1) in
4838 gotoghyll (getpagey
pageno)
4839 | Cmulti
((c, _, _) as cl, _) ->
4840 if conf
.presentation
4841 && (existsinrow l.pageno cl
4842 (fun l -> l.pageh
> l.pagey + l.pagevh))
4844 let y = clamp (pgscale state
.winh
) in
4847 let pageno = min
(l.pageno+c) (state
.pagecount
-1) in
4848 gotoghyll (getpagey
pageno)
4850 if l.pageno < state
.pagecount
- 1 || l.pagecol
< n - 1
4852 let pagey, pageh
= getpageyh
l.pageno in
4853 let pagey = pagey + pageh
* l.pagecol
in
4854 let ips = if l.pagecol
= 0 then 0 else conf
.interpagespace
in
4855 gotoghyll (pagey + pageh
+ ips)
4859 match state
.layout with
4861 let pageno = page_of_y state
.y in
4862 gotoghyll (getpagey
(pageno-1))
4864 match conf
.columns
with
4866 if conf
.presentation
&& l.pagey != 0
4868 gotoghyll (clamp (pgscale ~
-(state
.winh
)))
4870 let pageno = max
0 (l.pageno-1) in
4871 gotoghyll (getpagey
pageno)
4872 | Cmulti
((c, _, coverB
) as cl, _) ->
4873 if conf
.presentation
&&
4874 (existsinrow l.pageno cl (fun l -> l.pagey != 0))
4876 gotoghyll (clamp (pgscale ~
-(state
.winh
)))
4879 if l.pageno = state
.pagecount
- coverB
4883 let pageno = max
0 (l.pageno-decr) in
4884 gotoghyll (getpagey
pageno)
4892 let pageno = max
0 (l.pageno-1) in
4893 let pagey, pageh
= getpageyh
pageno in
4896 let pagey, pageh
= getpageyh
l.pageno in
4897 pagey + pageh
* (l.pagecol
-1) - conf
.interpagespace
4903 if emptystr conf
.savecmd
4904 then error
"don't know where to save modified document"
4906 let command = Str.global_replace percentsre state
.path conf
.savecmd
in
4907 match Unix.open_process_in
command with
4908 | (exception exn
) ->
4910 (Printf.sprintf
"savecmd open_process_in failed: %s"
4913 let path = try input_line ic
with End_of_file
-> E.s in
4915 match Unix.close_process_in ic
with
4916 | (exception exn
) ->
4917 error
"error obtaining save path: %s" (exntos exn
)
4920 let tmp = path ^
".tmp" in
4922 Unix.rename
tmp path;
4925 let viewkeyboard key mask
=
4927 let mode = state
.mode in
4928 state
.mode <- Textentry
(te, fun _ -> state
.mode <- mode);
4931 G.postRedisplay "view:enttext"
4933 let ctrl = Wsi.withctrl mask
in
4935 if key >= 0xffb0 && key < 0xffb9 then key - 0xffb0 + 48 else key
4941 dolog
"hasunsavedchanges %b" @@ hasunsavedchanges
();
4942 if hasunsavedchanges
()
4946 if conf
.angle
mod 360 = 0 && not
(isbirdseye state
.mode)
4948 state
.mode <- LinkNav
(Ltgendir
0);
4951 else showtext '
!'
"Keyboard link navigation does not work under rotation"
4954 begin match state
.mstate
with
4957 G.postRedisplay "kill rect";
4960 | Mscrolly
| Mscrollx
4963 begin match state
.mode with
4966 G.postRedisplay "esc leave linknav"
4970 match state
.ranchors
with
4972 | (path, password, anchor, origin
) :: rest
->
4973 state
.ranchors
<- rest
;
4974 state
.anchor <- anchor;
4975 state
.origin
<- origin
;
4976 state
.nameddest
<- E.s;
4977 opendoc path password
4982 gotoghyll (getnav ~
-1)
4993 Hashtbl.iter
(fun _ opaque -> clearmark
opaque) state
.pagemap
;
4994 G.postRedisplay "dehighlight";
4996 | @slash
| @question
->
4997 let ondone isforw
s =
4998 cbput state
.hists
.pat
s;
4999 state
.searchpattern
<- s;
5002 let s = String.make
1 (Char.chr
key) in
5003 enttext (s, E.s, Some
(onhist state
.hists
.pat
),
5004 textentry, ondone (key = @slash
), true)
5006 | @plus
| @kpplus
| @equals
when ctrl ->
5007 let incr = if conf
.zoom +. 0.01 > 0.1 then 0.1 else 0.01 in
5008 setzoom (conf
.zoom +. incr)
5010 | @plus
| @kpplus
->
5013 try int_of_string
s with exc
->
5014 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
);
5020 state
.text <- "page bias is now " ^ string_of_int
n;
5023 enttext ("page bias: ", E.s, None
, intentry, ondone, true)
5025 | @minus
| @kpminus
when ctrl ->
5026 let decr = if conf
.zoom -. 0.1 < 0.1 then 0.01 else 0.1 in
5027 setzoom (max
0.01 (conf
.zoom -. decr))
5029 | @minus
| @kpminus
->
5030 let ondone msg
= state
.text <- msg
in
5032 "option [acfhilpstvxACFPRSZTISM]: ", E.s, None
,
5033 optentry state
.mode, ondone, true
5044 | (@1 | @2) when ctrl && conf
.fitmodel
!= FitPage
-> (* ctrl-1/2 *)
5046 match conf
.columns
with
5047 | Csingle
_ | Cmulti
_ -> 1
5048 | Csplit
(n, _) -> n
5050 let h = state
.winh
-
5051 conf
.interpagespace
lsl (if conf
.presentation
then 1 else 0)
5053 let zoom = zoomforh state
.winw
h (vscrollw ()) cols in
5054 if zoom > 0.0 && (key = 50 || zoom < 1.0)
5059 match conf
.fitmodel
with
5060 | FitWidth
-> FitProportional
5061 | FitProportional
-> FitPage
5062 | FitPage
-> FitWidth
5064 state
.text <- "fit model: " ^
FMTE.to_string
fm;
5065 reqlayout conf
.angle
fm
5073 | (48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57)
5074 when not
ctrl -> (* 0..9 *)
5077 try int_of_string
s with exc
->
5078 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
);
5084 cbput state
.hists
.pag
(string_of_int
n);
5085 gotopage1 (n + conf
.pagebias
- 1) 0;
5088 let pageentry text key =
5089 match Char.unsafe_chr
key with
5090 | '
g'
-> TEdone
text
5091 | _ -> intentry text key
5093 let text = String.make
1 (Char.chr
key) in
5094 enttext (":", text, Some
(onhist state
.hists
.pag
),
5095 pageentry, ondone, true)
5098 conf
.scrollb
<- if conf
.scrollb
= 0 then (scrollbvv
lor scrollbhv
) else 0;
5099 reshape state
.winw state
.winh
;
5102 state
.bzoom
<- not state
.bzoom
;
5104 showtext ' '
("block zoom " ^
if state
.bzoom
then "on" else "off")
5107 conf
.hlinks
<- not conf
.hlinks
;
5108 state
.text <- "highlightlinks " ^
if conf
.hlinks
then "on" else "off";
5109 G.postRedisplay "toggle highlightlinks";
5112 state
.glinks
<- true;
5113 let mode = state
.mode in
5114 state
.mode <- Textentry
(
5115 (":", E.s, None
, linknentry, linkndone gotounder, false),
5117 state
.glinks
<- false;
5121 G.postRedisplay "view:linkent(F)"
5124 state
.glinks
<- true;
5125 let mode = state
.mode in
5126 state
.mode <- Textentry
(
5128 ":", E.s, None
, linknentry, linkndone (fun under ->
5129 selstring (undertext under);
5133 state
.glinks
<- false;
5137 G.postRedisplay "view:linkent"
5140 begin match state
.autoscroll
with
5142 conf
.autoscrollstep
<- step
;
5143 state
.autoscroll
<- None
5145 if conf
.autoscrollstep
= 0
5146 then state
.autoscroll
<- Some
1
5147 else state
.autoscroll
<- Some conf
.autoscrollstep
5154 setpresentationmode (not conf
.presentation
);
5155 showtext ' '
("presentation mode " ^
5156 if conf
.presentation
then "on" else "off");
5159 if List.mem
Wsi.Fullscreen state
.winstate
5160 then Wsi.reshape conf
.cwinw conf
.cwinh
5161 else Wsi.fullscreen
()
5164 search state
.searchpattern
false
5167 search state
.searchpattern
true
5170 begin match state
.layout with
5173 gotoghyll (getpagey
l.pageno)
5179 | @delete
| @kpdelete
-> (* delete *)
5183 showtext ' '
(describe_location ());
5186 begin match state
.layout with
5189 Wsi.reshape (l.pagew
+ vscrollw ()) l.pageh
;
5194 enterbookmarkmode ()
5202 | @e when Buffer.length state
.errmsgs
> 0 ->
5207 match state
.layout with
5212 (s, 0, Oanchor
(getanchor1
l)) :: state
.bookmarks
5215 enttext ("bookmark: ", E.s, None
, textentry, ondone, true)
5219 showtext ' '
"Quick bookmark added";
5222 begin match state
.layout with
5224 let rect = getpdimrect
l.pagedimno
in
5228 (truncate
(1.8 *. (rect.(1) -. rect.(0))),
5229 truncate
(1.2 *. (rect.(3) -. rect.(0))))
5231 (truncate
(rect.(1) -. rect.(0)),
5232 truncate
(rect.(3) -. rect.(0)))
5234 let w = truncate
((float w)*.conf
.zoom)
5235 and h = truncate
((float h)*.conf
.zoom) in
5238 state
.anchor <- getanchor
();
5239 Wsi.reshape (w + vscrollw ()) (h + conf
.interpagespace
)
5241 G.postRedisplay "z";
5246 | @x -> state
.roam
()
5249 reqlayout (conf
.angle
+
5250 (if key = @Gt
then 30 else -30)) conf
.fitmodel
5254 bound
(conf
.colorscale
+. (if key = 93 then 0.1 else -0.1)) 0.0 1.0
5256 G.postRedisplay "brightness";
5258 | @c when state
.mode = View
->
5263 let m = (wadjsb () + state
.winw
- state
.w) / 2 in
5265 gotoy_and_clear_text state
.y
5269 match state
.prevcolumns
with
5270 | None
-> (1, 0, 0), 1.0
5271 | Some
(columns
, z
) ->
5274 | Csplit
(c, _) -> -c, 0, 0
5275 | Cmulti
((c, a, b), _) -> c, a, b
5276 | Csingle
_ -> 1, 0, 0
5280 setcolumns View
c a b;
5283 | @down
| @up
when ctrl && Wsi.withshift mask
->
5284 let zoom, x = state
.prevzoom
in
5288 | @k
| @up
| @kpup
->
5289 begin match state
.autoscroll
with
5291 begin match state
.mode with
5292 | Birdseye beye
-> upbirdseye 1 beye
5297 then gotoy_and_clear_text (clamp ~
-(state
.winh
/2))
5299 if not
(Wsi.withshift mask
) && conf
.presentation
5301 else gotoghyll1 true (clamp (-conf
.scrollstep
))
5305 setautoscrollspeed n false
5308 | @j
| @down
| @kpdown
->
5309 begin match state
.autoscroll
with
5311 begin match state
.mode with
5312 | Birdseye beye
-> downbirdseye 1 beye
5317 then gotoy_and_clear_text (clamp (state
.winh
/2))
5319 if not
(Wsi.withshift mask
) && conf
.presentation
5321 else gotoghyll1 true (clamp (conf
.scrollstep
))
5325 setautoscrollspeed n true
5328 | @left | @right
| @kpleft
| @kpright
when not
(Wsi.withalt mask
) ->
5334 else conf
.hscrollstep
5336 let dx = if key = @left || key = @kpleft
then dx else -dx in
5337 state
.x <- panbound (state
.x + dx);
5338 gotoy_and_clear_text state
.y
5341 G.postRedisplay "left/right"
5344 | @prior
| @kpprior
->
5348 match state
.layout with
5350 | l :: _ -> state
.y - l.pagey
5352 clamp (pgscale (-state
.winh
))
5356 | @next | @kpnext
->
5360 match List.rev state
.layout with
5362 | l :: _ -> getpagey
l.pageno
5364 clamp (pgscale state
.winh
)
5368 | @g | @home
| @kphome
->
5371 | @G
| @jend
| @kpend
->
5373 gotoghyll (clamp state
.maxy)
5375 | @right
| @kpright
when Wsi.withalt mask
->
5376 gotoghyll (getnav 1)
5377 | @left | @kpleft
when Wsi.withalt mask
->
5378 gotoghyll (getnav ~
-1)
5383 | @v when conf
.debug
->
5386 match getopaque l.pageno with
5389 let x0, y0, x1, y1 = pagebbox
opaque in
5390 let a,b = float x0, float y0 in
5391 let c,d = float x1, float y0 in
5392 let e,f = float x1, float y1 in
5393 let h,j
= float x0, float y1 in
5394 let rect = (a,b,c,d,e,f,h,j
) in
5396 state
.rects
<- (l.pageno, l.pageno mod 3, rect) :: state
.rects
;
5398 G.postRedisplay "v";
5401 let mode = state
.mode in
5402 let cmd = ref E.s in
5403 let onleave = function
5404 | Cancel
-> state
.mode <- mode
5407 match getopaque l.pageno with
5408 | Some
opaque -> pipesel opaque !cmd
5409 | None
-> ()) state
.layout;
5413 cbput state
.hists
.sel
s;
5417 "| ", !cmd, Some
(onhist state
.hists
.sel
), textentry, ondone, true
5419 G.postRedisplay "|";
5420 state
.mode <- Textentry
(te, onleave);
5423 vlog "huh? %s" (Wsi.keyname
key)
5426 let linknavkeyboard key mask
linknav =
5427 let getpage pageno =
5428 let rec loop = function
5430 | l :: _ when l.pageno = pageno -> Some
l
5431 | _ :: rest
-> loop rest
5432 in loop state
.layout
5434 let doexact (pageno, n) =
5435 match getopaque pageno, getpage pageno with
5436 | Some
opaque, Some
l ->
5437 if key = @enter
|| key = @kpenter
5439 let under = getlink
opaque n in
5440 G.postRedisplay "link gotounder";
5447 Some
(findlink
opaque LDfirst
), -1
5450 Some
(findlink
opaque LDlast
), 1
5453 Some
(findlink
opaque (LDleft
n)), -1
5456 Some
(findlink
opaque (LDright
n)), 1
5459 Some
(findlink
opaque (LDup
n)), -1
5462 Some
(findlink
opaque (LDdown
n)), 1
5467 begin match findpwl
l.pageno dir with
5471 state
.mode <- LinkNav
(Ltgendir
dir);
5472 let y, h = getpageyh
pageno in
5475 then y + h - state
.winh
5480 begin match getopaque pageno, getpage pageno with
5481 | Some
opaque, Some
_ ->
5483 let ld = if dir > 0 then LDfirst
else LDlast
in
5486 begin match link with
5488 showlinktype (getlink
opaque m);
5489 state
.mode <- LinkNav
(Ltexact
(pageno, m));
5490 G.postRedisplay "linknav jpage";
5491 | Lnotfound
-> notfound dir
5497 begin match opt with
5498 | Some Lnotfound
-> pwl l dir;
5499 | Some
(Lfound
m) ->
5503 let _, y0, _, y1 = getlinkrect
opaque m in
5505 then gotopage1 l.pageno y0
5507 let d = fstate
.fontsize
+ 1 in
5508 if y1 - l.pagey > l.pagevh - d
5509 then gotopage1 l.pageno (y1 - state
.winh
- hscrollh () + d)
5510 else G.postRedisplay "linknav";
5512 showlinktype (getlink
opaque m);
5513 state
.mode <- LinkNav
(Ltexact
(l.pageno, m));
5516 | None
-> viewkeyboard key mask
5518 | _ -> viewkeyboard key mask
5523 G.postRedisplay "leave linknav"
5527 | Ltgendir
_ | Ltnotready
_ -> viewkeyboard key mask
5528 | Ltexact exact
-> doexact exact
5531 let keyboard key mask
=
5532 if (key = 103 && Wsi.withctrl mask
) && not
(istextentry state
.mode)
5533 then wcmd "interrupt"
5534 else state
.uioh <- state
.uioh#
key key mask
5537 let birdseyekeyboard key mask
5538 ((oconf
, leftx
, pageno, hooverpageno
, anchor) as beye
) =
5540 match conf
.columns
with
5542 | Cmulti
((c, _, _), _) -> c
5543 | Csplit
_ -> failwith
"bird's eye split mode"
5545 let pgh layout = List.fold_left
5546 (fun m l -> max
l.pageh
m) state
.winh
layout in
5548 | @l when Wsi.withctrl mask
->
5549 let y, h = getpageyh
pageno in
5550 let top = (state
.winh
- h) / 2 in
5551 gotoy (max
0 (y - top))
5552 | @enter
| @kpenter
-> leavebirdseye beye
false
5553 | @escape
-> leavebirdseye beye
true
5554 | @up
-> upbirdseye incr beye
5555 | @down
-> downbirdseye incr beye
5556 | @left -> upbirdseye 1 beye
5557 | @right
-> downbirdseye 1 beye
5560 begin match state
.layout with
5564 state
.mode <- Birdseye
(
5565 oconf
, leftx
, l.pageno, hooverpageno
, anchor
5567 gotopage1 l.pageno 0;
5570 let layout = layout (state
.y-state
.winh
) (pgh state
.layout) in
5572 | [] -> gotoy (clamp (-state
.winh
))
5574 state
.mode <- Birdseye
(
5575 oconf
, leftx
, l.pageno, hooverpageno
, anchor
5577 gotopage1 l.pageno 0
5580 | [] -> gotoy (clamp (-state
.winh
))
5584 begin match List.rev state
.layout with
5586 let layout = layout (state
.y + (pgh state
.layout)) state
.winh
in
5587 begin match layout with
5589 let incr = l.pageh
- l.pagevh in
5594 oconf
, leftx
, state
.pagecount
- 1, hooverpageno
, anchor
5596 G.postRedisplay "birdseye pagedown";
5598 else gotoy (clamp (incr + conf
.interpagespace
*2));
5602 Birdseye
(oconf
, leftx
, l.pageno, hooverpageno
, anchor);
5603 gotopage1 l.pageno 0;
5606 | [] -> gotoy (clamp state
.winh
)
5610 state
.mode <- Birdseye
(oconf
, leftx
, 0, hooverpageno
, anchor);
5614 let pageno = state
.pagecount
- 1 in
5615 state
.mode <- Birdseye
(oconf
, leftx
, pageno, hooverpageno
, anchor);
5616 if not
(pagevisible state
.layout pageno)
5619 match List.rev state
.pdims
with
5621 | (_, _, h, _) :: _ -> h
5623 gotoy (max
0 (getpagey
pageno - (state
.winh
- h - conf
.interpagespace
)))
5624 else G.postRedisplay "birdseye end";
5626 | _ -> viewkeyboard key mask
5631 match state
.mode with
5632 | Textentry
_ -> scalecolor 0.4
5634 | View
-> scalecolor 1.0
5635 | Birdseye
(_, _, pageno, hooverpageno
, _) ->
5636 if l.pageno = hooverpageno
5639 if l.pageno = pageno
5641 let c = scalecolor 1.0 in
5643 GlDraw.line_width
3.0;
5644 let dispx = xadjsb () + l.pagedispx in
5646 (float (dispx-1)) (float (l.pagedispy-1))
5647 (float (dispx+l.pagevw+1))
5648 (float (l.pagedispy+l.pagevh+1))
5650 GlDraw.line_width
1.0;
5659 let postdrawpage l linkindexbase
=
5660 match getopaque l.pageno with
5662 if tileready l l.pagex
l.pagey
5664 let x = l.pagedispx - l.pagex
+ xadjsb ()
5665 and y = l.pagedispy - l.pagey in
5667 match conf
.columns
with
5668 | Csingle
_ | Cmulti
_ ->
5669 (if conf
.hlinks
then 1 else 0)
5671 && not
(isbirdseye state
.mode) then 2 else 0)
5675 match state
.mode with
5676 | Textentry
((_, s, _, _, _, _), _) when state
.glinks
-> s
5682 postprocess
opaque hlmask x y (linkindexbase
, s, conf
.hfsize
);
5687 let scrollindicator () =
5688 let sbw, ph
, sh = state
.uioh#
scrollph in
5689 let sbh, pw, sw = state
.uioh#scrollpw
in
5694 else ((state
.winw
- sbw), state
.winw
, 0)
5697 GlDraw.color (0.64, 0.64, 0.64);
5698 filledrect (float x0) 0. (float x1) (float state
.winh
);
5700 (float hx0
) (float (state
.winh
- sbh))
5701 (float (hx0
+ wadjsb () + state
.winw
)) (float state
.winh
)
5703 GlDraw.color (0.0, 0.0, 0.0);
5705 filledrect (float x0) ph
(float x1) (ph
+. sh);
5706 let pw = pw +. float hx0
in
5707 filledrect pw (float (state
.winh
- sbh)) (pw +. sw) (float state
.winh
);
5711 match state
.mstate
with
5712 | Mnone
| Mscrolly
| Mscrollx
| Mpan
_ | Mzoom
_ | Mzoomrect
_ ->
5715 | Msel
((x0, y0), (x1, y1)) ->
5716 let identify opaque l px py = Some
(opaque, l.pageno, px, py) in
5717 let o0,n0
,px0
,py0
= onppundermouse identify x0 y0 (~
< E.s, -1, 0, 0) in
5718 let _o1,n1
,px1
,py1
= onppundermouse identify x1 y1 (~
< E.s, -1, 0, 0) in
5719 if n0
!= -1 && n0
= n1
then seltext
o0 (px0
, py0
, px1
, py1
);
5722 let showrects = function [] -> () | rects
->
5724 GlDraw.color (0.0, 0.0, 1.0) ~
alpha:0.5;
5725 GlFunc.blend_func ~
src:`src_alpha ~dst
:`one_minus_src_alpha
;
5727 (fun (pageno, c, (x0, y0, x1, y1, x2
, y2
, x3
, y3
)) ->
5729 if l.pageno = pageno
5731 let dx = float (l.pagedispx - l.pagex
) in
5732 let dy = float (l.pagedispy - l.pagey) in
5733 GlDraw.color (0.0, 0.0, 1.0 /. float c) ~
alpha:0.5;
5734 Raw.sets_float state
.vraw ~
pos:0
5739 GlArray.vertex `two state
.vraw
;
5740 GlArray.draw_arrays `triangle_strip ~
first:0 ~count
:4;
5749 GlClear.color (scalecolor2 conf
.bgcolor
);
5750 GlClear.clear
[`
color];
5751 List.iter
drawpage state
.layout;
5753 match state
.mode with
5754 | LinkNav
(Ltexact
(pageno, linkno
)) ->
5755 begin match getopaque pageno with
5757 let dx = xadjsb () in
5758 let x0, y0, x1, y1 = getlinkrect
opaque linkno
in
5759 let x0 = x0 + dx and x1 = x1 + dx in
5766 | None
-> state
.rects
5768 | LinkNav
(Ltgendir
_) | LinkNav
(Ltnotready
_)
5771 | View
-> state
.rects
5774 let rec postloop linkindexbase
= function
5776 let linkindexbase = linkindexbase + postdrawpage l linkindexbase in
5777 postloop linkindexbase rest
5781 postloop 0 state
.layout;
5783 begin match state
.mstate
with
5784 | Mzoomrect
((x0, y0), (x1, y1)) ->
5786 GlDraw.color (0.3, 0.3, 0.3) ~
alpha:0.5;
5787 GlFunc.blend_func ~
src:`src_alpha ~dst
:`one_minus_src_alpha
;
5788 filledrect (float x0) (float y0) (float x1) (float y1);
5792 | Mscrolly
| Mscrollx
5801 let zoomrect x y x1 y1 =
5804 and y0 = min
y y1 in
5805 gotoy (state
.y + y0);
5806 state
.anchor <- getanchor
();
5807 let zoom = (float state
.w) /. float (x1 - x0) in
5810 let adjw = wadjsb () + state
.winw
in
5812 then (adjw - state
.w) / 2
5815 match conf
.fitmodel
with
5816 | FitWidth
| FitProportional
-> simple ()
5818 match conf
.columns
with
5820 onppundermouse (fun _ l _ _ -> Some
l.pagedispx) x0 y0 x0
5821 | Cmulti
_ | Csingle
_ -> simple ()
5823 state
.x <- (state
.x + margin) - x0;
5828 let annot inline
x y =
5829 match unproject x y with
5830 | Some
(opaque, n, ux
, uy
) ->
5832 addannot
opaque ux uy
text;
5833 wcmd "freepage %s" (~
> opaque);
5834 Hashtbl.remove state
.pagemap
(n, state
.gen
);
5840 let ondone s = add s in
5841 let mode = state
.mode in
5842 state
.mode <- Textentry
(
5843 ("annotation: ", E.s, None
, textentry, ondone, true),
5844 fun _ -> state
.mode <- mode);
5847 G.postRedisplay "annot"
5850 let s = getusertext E.s in
5851 let l = Str.split newlinere
s in
5859 let g opaque l px py =
5860 match rectofblock
opaque px py with
5862 let x0 = a.(0) -. 20. in
5863 let x1 = a.(1) +. 20. in
5864 let y0 = a.(2) -. 20. in
5865 let zoom = (float state
.w) /. (x1 -. x0) in
5866 let pagey = getpagey
l.pageno in
5867 gotoy_and_clear_text (pagey + truncate
y0);
5868 state
.anchor <- getanchor
();
5869 let margin = (state
.w - l.pagew
)/2 in
5870 state
.x <- -truncate
x0 - margin;
5875 match conf
.columns
with
5877 showtext '
!'
"block zooming does not work properly in split columns mode"
5878 | Cmulti
_ | Csingle
_ -> onppundermouse g x y ()
5882 let winw = wadjsb () + state
.winw - 1 in
5883 let s = float x /. float winw in
5884 let destx = truncate
(float (state
.w + winw) *. s) in
5885 state
.x <- winw - destx;
5886 gotoy_and_clear_text state
.y;
5887 state
.mstate
<- Mscrollx
;
5891 let s = float y /. float state
.winh
in
5892 let desty = truncate
(float (state
.maxy - state
.winh
) *. s) in
5893 gotoy_and_clear_text desty;
5894 state
.mstate
<- Mscrolly
;
5897 let viewmulticlick clicks
x y mask
=
5898 let g opaque l px py =
5906 if markunder
opaque px py mark
5910 match getopaque l.pageno with
5912 | Some
opaque -> pipesel opaque cmd
5914 state
.roam
<- (fun () -> dopipe conf
.paxcmd
);
5915 if not
(Wsi.withctrl mask
) then dopipe conf
.selcmd
;
5920 G.postRedisplay "viewmulticlick";
5921 onppundermouse g x y (fun () -> showtext '
!'
"Nothing to select") ();
5925 match conf
.columns
with
5927 | Csingle
_ | Cmulti
_ -> conf
.angle
mod 360 = 0
5930 let viewmouse button down
x y mask
=
5932 | n when (n == 4 || n == 5) && not down
->
5933 if Wsi.withctrl mask
5935 match state
.mstate
with
5936 | Mzoom
(oldn
, i
) ->
5944 if conf
.zoom +. 0.01 > 0.1 then 0.1 else 0.01
5946 if conf
.zoom -. 0.1 < 0.1 then -0.01 else -0.1
5948 let zoom = conf
.zoom -. incr in
5950 state
.mstate
<- Mzoom
(n, 0);
5952 state
.mstate
<- Mzoom
(n, i
+1);
5954 else state
.mstate
<- Mzoom
(n, 0)
5958 | Mscrolly
| Mscrollx
5960 | Mnone
-> state
.mstate
<- Mzoom
(n, 0)
5963 match state
.autoscroll
with
5964 | Some step
-> setautoscrollspeed step
(n=4)
5966 if conf
.wheelbypage
|| conf
.presentation
5975 then -conf
.scrollstep
5976 else conf
.scrollstep
5978 let incr = incr * 2 in
5979 let y = clamp incr in
5980 gotoy_and_clear_text y
5983 | n when (n = 6 || n = 7) && not down
&& canpan () ->
5985 panbound (state
.x + (if n = 7 then -2 else 2) * conf
.hscrollstep
);
5986 gotoy_and_clear_text state
.y
5988 | 1 when Wsi.withshift mask
->
5989 state
.mstate
<- Mnone
;
5992 match unproject x y with
5993 | Some
(_, pageno, ux
, uy
) ->
5994 let cmd = Printf.sprintf
5996 conf
.stcmd state
.path pageno ux uy
5998 addpid @@ popen
cmd []
6002 | 1 when Wsi.withctrl mask
->
6005 Wsi.setcursor
Wsi.CURSOR_CROSSHAIR
;
6006 state
.mstate
<- Mpan
(x, y)
6009 state
.mstate
<- Mnone
6014 if Wsi.withshift mask
6016 annot (not
(Wsi.withctrl mask
)) x y;
6017 G.postRedisplay "addannot"
6021 Wsi.setcursor
Wsi.CURSOR_CYCLE
;
6022 state
.mstate
<- Mzoomrect
(p, p)
6025 match state
.mstate
with
6026 | Mzoomrect
((x0, y0), _) ->
6027 if abs
(x-x0) > 10 && abs
(y - y0) > 10
6028 then zoomrect x0 y0 x y
6031 G.postRedisplay "kill accidental zoom rect";
6035 | Mscrolly
| Mscrollx
6041 | 1 when x > state
.winw - vscrollw () ->
6044 let _, position, sh = state
.uioh#
scrollph in
6045 if y > truncate
position && y < truncate
(position +. sh)
6046 then state
.mstate
<- Mscrolly
6049 state
.mstate
<- Mnone
6051 | 1 when y > state
.winh
- hscrollh () ->
6054 let _, position, sw = state
.uioh#scrollpw
in
6055 if x > truncate
position && x < truncate
(position +. sw)
6056 then state
.mstate
<- Mscrollx
6059 state
.mstate
<- Mnone
6061 | 1 when state
.bzoom
-> if not down
then zoomblock x y
6064 let dest = if down
then getunder x y else Unone
in
6065 begin match dest with
6068 | Uremote
_ | Uremotedest
_
6069 | Uunexpected
_ | Ulaunch
_ | Unamed
_ ->
6072 | Unone
when down
->
6073 Wsi.setcursor
Wsi.CURSOR_CROSSHAIR
;
6074 state
.mstate
<- Mpan
(x, y);
6076 | Uannotation
(opaque, slinkindex
) -> enterannotmode opaque slinkindex
6078 | Unone
| Utext
_ ->
6083 state
.mstate
<- Msel
((x, y), (x, y));
6084 G.postRedisplay "mouse select";
6088 match state
.mstate
with
6091 | Mzoom
_ | Mscrollx
| Mscrolly
->
6092 state
.mstate
<- Mnone
6094 | Mzoomrect
((x0, y0), _) ->
6098 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
6099 state
.mstate
<- Mnone
6101 | Msel
((x0, y0), (x1, y1)) ->
6102 let rec loop = function
6106 let a0 = l.pagedispy in
6107 let a1 = a0 + l.pagevh in
6108 let b0 = l.pagedispx in
6109 let b1 = b0 + l.pagevw in
6110 ((y0 >= a0 && y0 <= a1) || (y1 >= a0 && y1 <= a1))
6111 && ((x0 >= b0 && x0 <= b1) || (x1 >= b0 && x1 <= b1))
6115 match getopaque l.pageno with
6118 match Unix.pipe
() with
6122 "can not create sel pipe: %s"
6126 Ne.clo fd
(fun msg
->
6127 dolog
"%s close failed: %s" what msg
)
6130 try popen
cmd [r, 0; w, -1]
6132 dolog
"can not execute %S: %s"
6140 G.postRedisplay "copysel";
6142 else clo "Msel pipe/w" w;
6143 clo "Msel pipe/r" r;
6145 dosel conf
.selcmd
();
6146 state
.roam
<- dosel conf
.paxcmd
;
6158 let birdseyemouse button down
x y mask
6159 (conf
, leftx
, _, hooverpageno
, anchor) =
6162 let rec loop = function
6165 if y > l.pagedispy && y < l.pagedispy + l.pagevh
6166 && x > l.pagedispx && x < l.pagedispx + l.pagevw
6168 leavebirdseye (conf
, leftx
, l.pageno, hooverpageno
, anchor) false;
6174 | _ -> viewmouse button down
x y mask
6180 method key key mask
=
6181 begin match state
.mode with
6182 | Textentry
textentry -> textentrykeyboard key mask
textentry
6183 | Birdseye
birdseye -> birdseyekeyboard key mask
birdseye
6184 | View
-> viewkeyboard key mask
6185 | LinkNav
linknav -> linknavkeyboard key mask
linknav
6189 method button button bstate
x y mask
=
6190 begin match state
.mode with
6192 | View
-> viewmouse button bstate
x y mask
6193 | Birdseye beye
-> birdseyemouse button bstate
x y mask beye
6198 method multiclick clicks
x y mask
=
6199 begin match state
.mode with
6201 | View
-> viewmulticlick clicks
x y mask
6208 begin match state
.mode with
6210 | View
| Birdseye
_ | LinkNav
_ ->
6211 match state
.mstate
with
6212 | Mzoom
_ | Mnone
-> ()
6217 state
.mstate
<- Mpan
(x, y);
6219 then state
.x <- panbound (state
.x + dx);
6221 gotoy_and_clear_text y
6224 state
.mstate
<- Msel
(a, (x, y));
6225 G.postRedisplay "motion select";
6228 let y = min state
.winh
(max
0 y) in
6232 let x = min state
.winw (max
0 x) in
6235 | Mzoomrect
(p0
, _) ->
6236 state
.mstate
<- Mzoomrect
(p0
, (x, y));
6237 G.postRedisplay "motion zoomrect";
6241 method pmotion
x y =
6242 begin match state
.mode with
6243 | Birdseye
(conf
, leftx
, pageno, hooverpageno
, anchor) ->
6244 let rec loop = function
6246 if hooverpageno
!= -1
6248 state
.mode <- Birdseye
(conf
, leftx
, pageno, -1, anchor);
6249 G.postRedisplay "pmotion birdseye no hoover";
6252 if y > l.pagedispy && y < l.pagedispy + l.pagevh
6253 && x > l.pagedispx && x < l.pagedispx + l.pagevw
6255 state
.mode <- Birdseye
(conf
, leftx
, pageno, l.pageno, anchor);
6256 G.postRedisplay "pmotion birdseye hoover";
6266 match state
.mstate
with
6267 | Mpan
_ | Msel
_ | Mzoom
_ | Mscrolly
| Mscrollx
| Mzoomrect
_ -> ()
6275 let past, _, _ = !r in
6277 let delta = now -. past in
6280 else r := (now, x, y)
6284 method infochanged
_ = ()
6287 let maxy = state
.maxy - (if conf
.maxhfit
then state
.winh
else 0) in
6290 then 0.0, float state
.winh
6291 else scrollph state
.y maxy
6296 let winw = wadjsb () + state
.winw in
6297 let fwinw = float winw in
6299 let sw = fwinw /. float state
.w in
6300 let sw = fwinw *. sw in
6301 max
sw (float conf
.scrollh
)
6304 let maxx = state
.w + winw in
6305 let x = winw - state
.x in
6306 let percent = float x /. float maxx in
6307 (fwinw -. sw) *. percent
6309 hscrollh (), position, sw
6313 match state
.mode with
6314 | LinkNav
_ -> "links"
6315 | Textentry
_ -> "textentry"
6316 | Birdseye
_ -> "birdseye"
6319 findkeyhash conf
modename
6321 method eformsgs
= true
6322 method alwaysscrolly
= false
6325 let adderrmsg src msg
=
6326 Buffer.add_string state
.errmsgs msg
;
6327 state
.newerrmsgs
<- true;
6331 let adderrfmt src fmt
=
6332 Format.ksprintf
(fun s -> adderrmsg src s) fmt
;
6336 let cl = splitatspace cmds
in
6338 try Scanf.sscanf
s fmt
f
6340 adderrfmt "remote exec"
6341 "error processing '%S': %s\n" cmds
(exntos exn
)
6344 | "reload" :: [] -> reload ()
6345 | "goto" :: args
:: [] ->
6346 scan args
"%u %f %f"
6348 let cmd, _ = state
.geomcmds
in
6350 then gotopagexy pageno x y
6353 gotopagexy pageno x y;
6356 state
.reprf
<- f state
.reprf
6358 | "goto1" :: args
:: [] -> scan args
"%u %f" gotopage
6359 | "gotor" :: args
:: [] ->
6361 (fun filename
pageno -> gotounder (Uremote
(filename
, pageno)))
6362 | "gotord" :: args
:: [] ->
6364 (fun filename
dest -> gotounder (Uremotedest
(filename
, dest)))
6365 | "rect" :: args
:: [] ->
6366 scan args
"%u %u %f %f %f %f"
6367 (fun pageno color x0 y0 x1 y1 ->
6368 onpagerect pageno (fun w h ->
6369 let _,w1,h1
,_ = getpagedim
pageno in
6370 let sw = float w1 /. float w
6371 and sh = float h1
/. float h in
6375 and y1s
= y1 *. sh in
6376 let rect = (x0s,y0s
,x1s
,y0s
,x1s
,y1s
,x0s,y1s
) in
6378 state
.rects <- (pageno, color, rect) :: state
.rects;
6379 G.postRedisplay "rect";
6382 | "activatewin" :: [] -> Wsi.activatewin
()
6383 | "quit" :: [] -> raise Quit
6385 adderrfmt "remote command"
6386 "error processing remote command: %S\n" cmds
;
6390 let scratch = Bytes.create
80 in
6391 let buf = Buffer.create
80 in
6394 try Some
(Unix.read fd
scratch 0 80)
6396 | Unix.Unix_error
(Unix.EAGAIN
, _, _) -> None
6397 | Unix.Unix_error
(Unix.EINTR
, _, _) -> tempfr ()
6400 match tempfr () with
6406 if Buffer.length
buf > 0
6408 let s = Buffer.contents
buf in
6418 let pos = Bytes.index_from
scratch ppos '
\n'
in
6419 if pos >= n then -1 else pos
6420 with Not_found
-> -1
6424 Buffer.add_subbytes
buf scratch ppos
(nlpos-ppos
);
6425 let s = Buffer.contents
buf in
6431 Buffer.add_subbytes
buf scratch ppos
(n-ppos
);
6437 let remoteopen path =
6438 try Some
(Unix.openfile
path [Unix.O_NONBLOCK
; Unix.O_RDONLY
] 0o0)
6440 adderrfmt "remoteopen" "error opening %S: %s" path (exntos exn
);
6445 let gcconfig = ref E.s in
6446 let trimcachepath = ref E.s in
6447 let rcmdpath = ref E.s in
6448 let pageno = ref None
in
6449 let rootwid = ref 0 in
6450 let openlast = ref false in
6451 let nofc = ref false in
6452 selfexec := Sys.executable_name
;
6455 [("-p", Arg.String
(fun s -> state
.password <- s),
6456 "<password> Set password");
6460 Config.fontpath
:= s;
6461 selfexec := !selfexec ^
" -f " ^
Filename.quote
s;
6463 "<path> Set path to the user interface font");
6467 selfexec := !selfexec ^
" -c " ^
Filename.quote
s;
6468 Config.confpath
:= s),
6469 "<path> Set path to the configuration file");
6471 ("-last", Arg.Set
openlast, " Open last document");
6473 ("-page", Arg.Int
(fun pageno1
-> pageno := Some
(pageno1
-1)),
6474 "<page-number> Jump to page");
6476 ("-tcf", Arg.String
(fun s -> trimcachepath := s),
6477 "<path> Set path to the trim cache file");
6479 ("-dest", Arg.String
(fun s -> state
.nameddest
<- s),
6480 "<named-destination> Set named destination");
6482 ("-wtmode", Arg.Set
wtmode, " Operate in wt mode");
6483 ("-cxack", Arg.Set
cxack, " Cut corners");
6485 ("-remote", Arg.String
(fun s -> rcmdpath := s),
6486 "<path> Set path to the remote commands source");
6488 ("-origin", Arg.String
(fun s -> state
.origin
<- s),
6489 "<original-path> Set original path");
6491 ("-gc", Arg.Set_string
gcconfig,
6492 "<script-path> Collect garbage with the help of a script");
6494 ("-nofc", Arg.Set
nofc, " Do not use fontconfig");
6496 ("-v", Arg.Unit
(fun () ->
6498 "%s\nconfiguration path: %s\n"
6502 exit
0), " Print version and exit");
6504 ("-embed", Arg.Set_int
rootwid,
6505 "<window-id> Embed into window")
6508 (fun s -> state
.path <- s)
6509 ("Usage: " ^
Sys.argv
.(0) ^
" [options] some.pdf\nOptions:")
6512 then selfexec := !selfexec ^
" -wtmode";
6514 let histmode = emptystr state
.path && not
!openlast in
6516 if not
(Config.load !openlast)
6517 then prerr_endline
"failed to load configuration";
6518 begin match !pageno with
6519 | Some
pageno -> state
.anchor <- (pageno, 0.0, 0.0)
6523 if not
(emptystr
!gcconfig)
6526 match Unix.socketpair
Unix.PF_UNIX
Unix.SOCK_STREAM
0 with
6528 error
"gc socketpair failed: %s" (exntos exn
)
6531 match addpid @@ popen
!gcconfig [(c, 0); (c, 1)] with
6533 error
"failed to popen gc script: %s" (exntos exn
);
6539 let wsfd, winw, winh
= Wsi.init
(object (self)
6540 val mutable m_clicks
= 0
6541 val mutable m_click_x
= 0
6542 val mutable m_click_y
= 0
6543 val mutable m_lastclicktime
= infinity
6545 method private cleanup =
6546 state
.roam
<- noroam
;
6547 Hashtbl.iter
(fun _ opaque -> clearmark
opaque) state
.pagemap
6548 method expose
= G.postRedisplay"expose"
6552 | Wsi.Unobscured
-> "unobscured"
6553 | Wsi.PartiallyObscured
-> "partiallyobscured"
6554 | Wsi.FullyObscured
-> "fullyobscured"
6556 vlog "visibility change %s" name
6557 method display = display ()
6558 method map mapped
= vlog "mappped %b" mapped
6559 method reshape w h =
6562 method mouse
b d x y m =
6563 if d && canselect ()
6565 (* http://blogs.msdn.com/b/oldnewthing/archive/2004/10/18/243925.aspx *)
6571 if abs
x - m_click_x
> 10
6572 || abs
y - m_click_y
> 10
6573 || abs_float
(t -. m_lastclicktime
) > 0.3
6575 m_clicks
<- m_clicks
+ 1;
6576 m_lastclicktime
<- t;
6580 G.postRedisplay "cleanup";
6581 state
.uioh <- state
.uioh#button
b d x y m;
6583 else state
.uioh <- state
.uioh#multiclick m_clicks
x y m
6588 m_lastclicktime
<- infinity
;
6589 state
.uioh <- state
.uioh#button
b d x y m
6593 state
.uioh <- state
.uioh#button
b d x y m
6596 state
.mpos
<- (x, y);
6597 state
.uioh <- state
.uioh#motion
x y
6598 method pmotion
x y =
6599 state
.mpos
<- (x, y);
6600 state
.uioh <- state
.uioh#pmotion
x y
6602 let mascm = m land (
6603 Wsi.altmask
+ Wsi.shiftmask
+ Wsi.ctrlmask
+ Wsi.metamask
6606 let x = state
.x and y = state
.y in
6608 if x != state
.x || y != state
.y then self#
cleanup
6610 match state
.keystate
with
6612 let km = k
, mascm in
6615 let modehash = state
.uioh#
modehash in
6616 try Hashtbl.find modehash km
6618 try Hashtbl.find (findkeyhash conf
"global") km
6619 with Not_found
-> KMinsrt
(k
, m)
6621 | KMinsrt
(k
, m) -> keyboard k
m
6622 | KMinsrl
l -> List.iter
(fun (k
, m) -> keyboard k
m) l
6623 | KMmulti
(l, r) -> state
.keystate
<- KSinto
(l, r)
6625 | KSinto
((k'
, m'
) :: [], insrt
) when k'
=k
&& m'
land mascm = m'
->
6626 List.iter
(fun (k
, m) -> keyboard k
m) insrt
;
6627 state
.keystate
<- KSnone
6628 | KSinto
((k'
, m'
) :: keys, insrt
) when k'
=k
&& m'
land mascm = m'
->
6629 state
.keystate
<- KSinto
(keys, insrt
)
6630 | KSinto
_ -> state
.keystate
<- KSnone
6633 state
.mpos
<- (x, y);
6634 state
.uioh <- state
.uioh#pmotion
x y
6635 method leave = state
.mpos
<- (-1, -1)
6636 method winstate wsl
= state
.winstate
<- wsl
6637 method quit
= raise Quit
6638 end) !rootwid conf
.cwinw conf
.cwinh platform
in
6643 List.exists
GlMisc.check_extension
6644 [ "GL_ARB_texture_rectangle"
6645 ; "GL_EXT_texture_recangle"
6646 ; "GL_NV_texture_rectangle" ]
6648 then (prerr_endline
"OpenGL does not suppport rectangular textures"; exit
1);
6651 let r = GlMisc.get_string `renderer
in
6652 let p = "Mesa DRI Intel(" in
6653 let l = String.length
p in
6654 String.length
r > l && String.sub
r 0 l = p
6657 defconf
.sliceheight
<- 1024;
6658 defconf
.texcount
<- 32;
6659 defconf
.usepbo
<- true;
6663 match Unix.socketpair
Unix.PF_UNIX
Unix.SOCK_STREAM
0 with
6665 Printf.eprintf
"socketpair failed: %s" (exntos exn
);
6673 setcheckers conf
.checkers
;
6675 if conf
.redirectstderr
6679 (Buffer.to_bytes state
.errmsgs
)
6680 (match state
.errfd
with
6682 let s = Bytes.create
(80*24) in
6685 let r, _, _ = Unix.select
[fd
] [] [] 0.0 in
6687 then Unix.read fd
s 0 (Bytes.length
s)
6693 else Bytes.sub
s 0 n
6697 try ignore
(Unix.write state
.stderr
s 0 (Bytes.length
s))
6698 with exn
-> print_endline
(exntos exn
)
6703 conf
.angle
, conf
.fitmodel
, (conf
.trimmargins
, conf
.trimfuzz
),
6704 conf
.texcount
, conf
.sliceheight
, conf
.mustoresize
, conf
.colorspace
,
6705 !Config.fontpath
, !trimcachepath,
6706 GlMisc.check_extension
"GL_ARB_pixel_buffer_object",
6709 List.iter
GlArray.enable
[`texture_coord
; `vertex
];
6715 Wsi.settitle
"llpp (history)";
6719 state
.text <- "Opening " ^
(mbtoutf8 state
.path);
6720 opendoc state
.path state
.password;
6725 Sys.set_signal
Sys.sighup
(Sys.Signal_handle
(fun _ -> reload ()));
6728 if nonemptystr
!rcmdpath
6729 then remoteopen !rcmdpath
6734 let rec loop deadline
=
6736 if pidcount
.contents
> 0
6738 match Unix.wait
() with
6739 | (exception exn
) -> dolog
"Unix.wait: %s" @@ exntos exn
6746 match state
.errfd
with
6747 | None
-> [state
.ss; state
.wsfd]
6748 | Some fd
-> [state
.ss; state
.wsfd; fd
]
6753 | Some fd
-> fd
:: r
6757 state
.redisplay
<- false;
6764 if deadline
= infinity
6766 else max
0.0 (deadline
-. now)
6771 try Unix.select
r [] [] timeout
6772 with Unix.Unix_error
(Unix.EINTR
, _, _) -> [], [], []
6778 if state
.ghyll
== noghyll
6780 match state
.autoscroll
with
6781 | Some step
when step
!= 0 ->
6782 let y = state
.y + step
in
6786 else if y >= state
.maxy then 0 else y
6789 if state
.mode = View
6790 then state
.text <- E.s;
6793 else deadline
+. 0.01
6798 let rec checkfds = function
6800 | fd
:: rest
when fd
= state
.ss ->
6801 let cmd = readcmd state
.ss in
6805 | fd
:: rest
when fd
= state
.wsfd ->
6809 | fd
:: rest
when Some fd
= !optrfd ->
6810 begin match remote fd
with
6811 | None
-> optrfd := remoteopen !rcmdpath;
6812 | opt -> optrfd := opt
6817 let s = Bytes.create
80 in
6818 let n = tempfailureretry
(Unix.read fd
s 0) 80 in
6819 if conf
.redirectstderr
6821 Buffer.add_substring state
.errmsgs
(Bytes.to_string
s) 0 n;
6822 state
.newerrmsgs
<- true;
6823 state
.redisplay
<- true;
6826 prerr_string
(String.sub
(Bytes.to_string
s) 0 n);
6832 if !reeenterhist then (
6834 reeenterhist := false;
6838 if deadline
= infinity
6842 match state
.autoscroll
with
6843 | Some step
when step
!= 0 -> deadline1
6844 | _ -> if state
.ghyll
== noghyll
then infinity
else deadline1
6852 Config.save leavebirdseye;
6853 if hasunsavedchanges
()