6 external init
: Unix.file_descr
-> params
-> unit = "ml_init";;
7 external seltext
: opaque
-> (int * int * int * int) -> unit = "ml_seltext";;
8 external hassel
: opaque
-> bool = "ml_hassel";;
9 external copysel
: Unix.file_descr
-> opaque
-> unit = "ml_copysel";;
10 external getpdimrect
: int -> float array
= "ml_getpdimrect";;
11 external whatsunder
: opaque
-> int -> int -> under
= "ml_whatsunder";;
12 external markunder
: opaque
-> int -> int -> mark
-> bool = "ml_markunder";;
13 external clearmark
: opaque
-> unit = "ml_clearmark";;
14 external zoomforh
: int -> int -> int -> int -> float = "ml_zoom_for_height";;
15 external drawstr
: int -> int -> int -> string -> float = "ml_draw_string";;
16 external measurestr
: int -> string -> float = "ml_measure_string";;
17 external postprocess
:
18 opaque
-> int -> int -> int -> (int * string * int) -> int
20 external pagebbox
: opaque
-> (int * int * int * int) = "ml_getpagebox";;
21 external setaalevel
: int -> unit = "ml_setaalevel";;
22 external realloctexts
: int -> bool = "ml_realloctexts";;
23 external findlink
: opaque
-> linkdir
-> link
= "ml_findlink";;
24 external getlink
: opaque
-> int -> under
= "ml_getlink";;
25 external getlinkrect
: opaque
-> int -> irect
= "ml_getlinkrect";;
26 external getlinkcount
: opaque
-> int = "ml_getlinkcount";;
27 external findpwl
: int -> int -> pagewithlinks
= "ml_find_page_with_links";;
28 external getpbo
: width
-> height
-> colorspace
-> opaque
= "ml_getpbo";;
29 external freepbo
: opaque
-> unit = "ml_freepbo";;
30 external unmappbo
: opaque
-> unit = "ml_unmappbo";;
31 external pbousable
: unit -> bool = "ml_pbo_usable";;
32 external unproject
: opaque
-> int -> int -> (int * int) option
34 external drawtile
: tileparams
-> opaque
-> unit = "ml_drawtile";;
35 external rectofblock
: opaque
-> int -> int -> float array
option
37 external begintiles
: unit -> unit = "ml_begintiles";;
38 external endtiles
: unit -> unit = "ml_endtiles";;
39 external addannot
: opaque
-> int -> int -> string -> unit = "ml_addannot";;
40 external modannot
: opaque
-> slinkindex
-> string -> unit = "ml_modannot";;
41 external delannot
: opaque
-> slinkindex
-> unit = "ml_delannot";;
42 external hasunsavedchanges
: unit -> bool = "ml_hasunsavedchanges";;
43 external savedoc
: string -> unit = "ml_savedoc";;
44 external getannotcontents
: opaque
-> slinkindex
-> string
45 = "ml_getannotcontents";;
47 let selfexec = ref E.s
;;
49 let drawstring size x y s
=
51 Gl.enable `texture_2d
;
52 GlFunc.blend_func ~src
:`src_alpha ~dst
:`one_minus_src_alpha
;
53 ignore
(drawstr size x y s
);
55 Gl.disable `texture_2d
;
58 let drawstring1 size x y s
=
62 let drawstring2 size x y fmt
=
63 Printf.kprintf
(drawstring size
(x
+1) (y
+size
+1)) fmt
67 dolog
"l %d dim=%d {" l
.pageno l
.pagedimno
;
68 dolog
" WxH %dx%d" l
.pagew l
.pageh
;
69 dolog
" vWxH %dx%d" l
.pagevw l
.pagevh
;
70 dolog
" pagex,y %d,%d" l
.pagex l
.pagey
;
71 dolog
" dispx,y %d,%d" l
.pagedispx l
.pagedispy
;
72 dolog
" column %d" l
.pagecol
;
76 let debugrect (x0
, y0
, x1
, y1
, x2
, y2
, x3
, y3
) =
78 dolog
" x0,y0=(% f, % f)" x0 y0
;
79 dolog
" x1,y1=(% f, % f)" x1 y1
;
80 dolog
" x2,y2=(% f, % f)" x2 y2
;
81 dolog
" x3,y3=(% f, % f)" x3 y3
;
85 let isbirdseye = function
92 let istextentry = function
99 let wtmode = ref false;;
100 let cxack = ref false;;
102 let pgscale h
= truncate
(float h
*. conf
.pgscale);;
105 if not state
.uioh#alwaysscrolly
&& (conf
.scrollb
land scrollbhv
= 0)
106 || (state
.x
= 0 && state
.w
<= state
.winw
- conf
.scrollbw
)
112 if not state
.uioh#alwaysscrolly
&& (conf
.scrollb
land scrollbvv
= 0)
117 let wadjsb () = -vscrollw ();;
118 let xadjsb () = if conf
.leftscroll
then vscrollw () else 0;;
121 fstate
.fontsize
<- n
;
122 fstate
.wwidth
<- measurestr fstate
.fontsize
"w";
123 fstate
.maxrows
<- (state
.winh
- fstate
.fontsize
- 1) / (fstate
.fontsize
+ 1);
129 Printf.kprintf prerr_endline fmt
131 Printf.kprintf ignore fmt
135 if emptystr conf
.pathlauncher
136 then print_endline state
.path
138 let command = Str.global_replace percentsre state
.path conf
.pathlauncher
in
139 try addpid
@@ popen
command []
141 Printf.eprintf
"failed to execute `%s': %s\n" command (exntos exn
);
146 let redirectstderr () =
147 let clofail what errmsg
= dolog
"failed to close %s: %s" what errmsg
in
148 if conf
.redirectstderr
150 match Unix.pipe
() with
152 dolog
"failed to create stderr redirection pipes: %s" (exntos exn
)
155 begin match Unix.dup
Unix.stderr
with
157 dolog
"failed to dup stderr: %s" (exntos exn
);
158 Ne.clo r
(clofail "pipe/r");
159 Ne.clo w
(clofail "pipe/w");
162 begin match Unix.dup2 w
Unix.stderr
with
164 dolog
"failed to dup2 to stderr: %s" (exntos exn
);
165 Ne.clo dupstderr
(clofail "stderr duplicate");
166 Ne.clo r
(clofail "redir pipe/r");
167 Ne.clo w
(clofail "redir pipe/w");
170 state
.stderr
<- dupstderr
;
171 state
.errfd
<- Some r
;
175 state
.newerrmsgs
<- false;
176 begin match state
.errfd
with
178 begin match Unix.dup2 state
.stderr
Unix.stderr
with
180 dolog
"failed to dup2 original stderr: %s" (exntos exn
)
182 Ne.clo fd
(clofail "dup of stderr");
187 prerr_string
(Buffer.contents state
.errmsgs
);
189 Buffer.clear state
.errmsgs
;
195 let postRedisplay who
=
197 then prerr_endline
("redisplay for " ^ who
);
198 state
.redisplay
<- true;
202 let getopaque pageno
=
203 try Some
(Hashtbl.find state
.pagemap
(pageno
, state
.gen
))
204 with Not_found
-> None
207 let putopaque pageno opaque
=
208 Hashtbl.replace state
.pagemap
(pageno
, state
.gen
) opaque
211 let pagetranslatepoint l x y
=
212 let dy = y
- l
.pagedispy
in
213 let y = dy + l
.pagey
in
214 let dx = x
- l
.pagedispx
in
215 let x = dx + l
.pagex
in
219 let onppundermouse g
x y d
=
222 begin match getopaque l
.pageno
with
224 let x0 = l
.pagedispx
in
225 let x1 = x0 + l
.pagevw
in
226 let y0 = l
.pagedispy
in
227 let y1 = y0 + l
.pagevh
in
228 if y >= y0 && y <= y1 && x >= x0 && x <= x1
230 let px, py
= pagetranslatepoint l
x y in
231 match g opaque l
px py
with
244 let g opaque l
px py
=
247 match rectofblock opaque
px py
with
249 let rect = (a
.(0),a
.(2),a
.(1),a
.(2),a
.(1),a
.(3),a
.(0),a
.(3)) in
250 state
.rects
<- [l
.pageno
, l
.pageno
mod 3, rect];
251 G.postRedisplay "getunder";
254 let under = whatsunder opaque
px py
in
255 if under = Unone
then None
else Some
under
257 onppundermouse g x y Unone
262 match unproject opaque
x y with
263 | Some
(x, y) -> Some
(Some
(opaque
, l
.pageno
, x, y))
266 onppundermouse g x y None
;
270 state
.text
<- Printf.sprintf
"%c%s" c s
;
271 G.postRedisplay "showtext";
274 let pipesel opaque cmd
=
277 match Unix.pipe
() with
280 (Printf.sprintf
"pipesel can not create pipe: %s" (exntos exn
));
282 let doclose what fd
=
283 Ne.clo fd
(fun msg
-> dolog
"%s close failed: %s" what msg
)
286 try popen cmd
[r
, 0; w
, -1]
288 dolog
"can not execute %S: %s" cmd
(exntos exn
);
294 G.postRedisplay "pipesel";
296 else doclose "pipesel pipe/w" w
;
297 doclose "pipesel pipe/r" r
;
301 let g opaque l
px py
=
302 if markunder opaque
px py conf
.paxmark
305 match getopaque l
.pageno
with
307 | Some opaque
-> pipesel opaque conf
.paxcmd
312 G.postRedisplay "paxunder";
313 if conf
.paxmark
= Mark_page
316 match getopaque l
.pageno
with
318 | Some opaque
-> clearmark opaque
) state
.layout
;
320 onppundermouse g x y (fun () -> showtext '
!'
"Whoopsie daisy");
324 match Unix.pipe
() with
326 showtext '
!'
(Printf.sprintf
"pipe failed: %s" (exntos exn
))
329 Ne.clo fd
(fun msg
->
330 showtext '
!'
(Printf.sprintf
"failed to close %s: %s" cap msg
)
334 try popen conf
.selcmd
[r
, 0; w
, -1]
337 (Printf.sprintf
"failed to execute %s: %s"
338 conf
.selcmd
(exntos exn
));
344 let l = String.length s
in
345 let bytes = Bytes.unsafe_of_string s
in
346 let n = tempfailureretry
(Unix.write w
bytes 0) l in
351 "failed to write %d characters to sel pipe, wrote %d"
356 (Printf.sprintf
"failed to write to sel pipe: %s"
361 clo "selstring pipe/r" r
;
362 clo "selstring pipe/w" w
;
365 let undertext ?
(nopath
=false) = function
368 | Ulinkgoto
(pageno
, _
) ->
370 then "page " ^ string_of_int
(pageno
+1)
371 else Printf.sprintf
"%s: page %d" state
.path
(pageno
+1)
372 | Utext s
-> "font: " ^ s
373 | Uunexpected s
-> "unexpected: " ^ s
374 | Ulaunch s
-> "launch: " ^ s
375 | Unamed s
-> "named: " ^ s
376 | Uremote
(filename
, pageno
) ->
377 Printf.sprintf
"%s: page %d" filename
(pageno
+1)
378 | Uremotedest
(filename
, destname
) ->
379 Printf.sprintf
"%s: destination %S" filename destname
380 | Uannotation
(opaque
, slinkindex
) ->
381 "annotation: " ^ getannotcontents opaque slinkindex
384 let updateunder x y =
385 match getunder x y with
386 | Unone
-> Wsi.setcursor
Wsi.CURSOR_INHERIT
388 if conf
.underinfo
then showtext 'u'
("ri: " ^ uri
);
389 Wsi.setcursor
Wsi.CURSOR_INFO
390 | Ulinkgoto
(pageno
, _
) ->
392 then showtext 'p'
("age: " ^ string_of_int
(pageno
+1));
393 Wsi.setcursor
Wsi.CURSOR_INFO
395 if conf
.underinfo
then showtext '
f'
("ont: " ^ s
);
396 Wsi.setcursor
Wsi.CURSOR_TEXT
398 if conf
.underinfo
then showtext 'u'
("nexpected: " ^ s
);
399 Wsi.setcursor
Wsi.CURSOR_INHERIT
401 if conf
.underinfo
then showtext '
l'
("aunch: " ^ s
);
402 Wsi.setcursor
Wsi.CURSOR_INHERIT
404 if conf
.underinfo
then showtext '
n'
("amed: " ^ s
);
405 Wsi.setcursor
Wsi.CURSOR_INHERIT
406 | Uremote
(filename
, pageno
) ->
407 if conf
.underinfo
then showtext 'r'
408 (Printf.sprintf
"emote: %s (%d)" filename
(pageno
+1));
409 Wsi.setcursor
Wsi.CURSOR_INFO
410 | Uremotedest
(filename
, destname
) ->
411 if conf
.underinfo
then showtext 'r'
412 (Printf.sprintf
"emote destination: %s (%S)" filename destname
);
413 Wsi.setcursor
Wsi.CURSOR_INFO
415 if conf
.underinfo
then showtext 'a'
"nnotation";
416 Wsi.setcursor
Wsi.CURSOR_INFO
419 let showlinktype under =
420 if conf
.underinfo
&& under != Unone
421 then showtext ' '
@@ undertext under
424 let intentry_with_suffix text key
=
426 if key
>= 32 && key
< 127
430 match Char.lowercase
c with
432 let text = addchar
text c in
436 let text = addchar
text c in
440 state
.text <- Printf.sprintf
"invalid char (%d, `%c')" key
c;
445 let s = Bytes.create
4 in
446 let n = tempfailureretry
(Unix.read fd
s 0) 4 in
447 if n != 4 then error
"incomplete read(len) = %d" n;
448 let len = (Char.code
(Bytes.get
s 0) lsl 24)
449 lor (Char.code
(Bytes.get
s 1) lsl 16)
450 lor (Char.code
(Bytes.get
s 2) lsl 8)
451 lor (Char.code
(Bytes.get
s 3))
453 let s = Bytes.create
len in
454 let n = tempfailureretry
(Unix.read fd
s 0) len in
455 if n != len then error
"incomplete read(data) %d vs %d" n len;
460 let b = Buffer.create
16 in
461 Buffer.add_string
b "llll";
464 let s = Buffer.to_bytes
b in
465 let n = Bytes.length
s in
467 (* dolog "wcmd %S" (String.sub s 4 len); *)
468 Bytes.set
s 0 (Char.chr
((len lsr 24) land 0xff));
469 Bytes.set
s 1 (Char.chr
((len lsr 16) land 0xff));
470 Bytes.set
s 2 (Char.chr
((len lsr 8) land 0xff));
471 Bytes.set
s 3 (Char.chr
(len land 0xff));
472 let n'
= tempfailureretry
(Unix.write state
.ss
s 0) n in
473 if n'
!= n then error
"write failed %d vs %d" n'
n;
477 let nogeomcmds cmds
=
479 | s, [] -> emptystr
s
483 let layoutN ((columns
, coverA
, coverB
), b) y sh
=
484 let sh = sh - (hscrollh ()) in
485 let wadj = wadjsb () in
486 let rec fold accu
n =
487 if n = Array.length
b
490 let pdimno, dx, vy
, (_
, w
, h
, xoff
) = b.(n) in
493 || n = state
.pagecount
- coverB
494 || (n - coverA
) mod columns
= columns
- 1)
500 let pagey = max
0 (y - vy
) in
501 let pagedispy = if pagey > 0 then 0 else vy
- y in
502 let pagedispx, pagex
=
504 if n = coverA
- 1 || n = state
.pagecount
- coverB
505 then state
.x + (wadj + state
.winw
- w
) / 2
506 else dx + xoff
+ state
.x
513 let vw = wadj + state
.winw
- pagedispx in
514 let pw = w
- pagex
in
517 let pagevh = min
(h
- pagey) (sh - pagedispy) in
518 if pagevw > 0 && pagevh > 0
529 ; pagedispx = pagedispx
530 ; pagedispy = pagedispy
542 if Array.length
b = 0
544 else List.rev
(fold [] (page_of_y
y))
547 let layoutS (columns
, b) y sh =
548 let sh = sh - hscrollh () in
549 let wadj = wadjsb () in
550 let rec fold accu n =
551 if n = Array.length
b
554 let pdimno, px, vy
, (_
, pagew
, pageh
, xoff
) = b.(n) in
561 let x = xoff
+ state
.x in
562 let pagey = max
0 (y - vy
) in
563 let pagedispy = if pagey > 0 then 0 else vy
- y in
564 let pagedispx, pagex
=
578 let pagecolw = pagew
/columns
in
580 if pagecolw < state
.winw
581 then pagedispx + ((wadj + state
.winw
- pagecolw) / 2)
585 let vw = wadj + state
.winw
- pagedispx in
586 let pw = pagew
- pagex
in
589 let pagevw = min
pagevw pagecolw in
590 let pagevh = min
(pageh
- pagey) (sh - pagedispy) in
591 if pagevw > 0 && pagevh > 0
602 ; pagedispx = pagedispx
603 ; pagedispy = pagedispy
604 ; pagecol
= n mod columns
619 if nogeomcmds state
.geomcmds
621 match conf
.columns
with
622 | Csingle
b -> layoutN ((1, 0, 0), b) y sh
623 | Cmulti
c -> layoutN c y sh
624 | Csplit
s -> layoutS s y sh
629 let y = state
.y + incr
in
631 let y = min
y (state
.maxy
- (if conf
.maxhfit
then state
.winh
else 0)) in
636 let tilex = l.pagex
mod conf
.tilew
in
637 let tiley = l.pagey mod conf
.tileh
in
639 let col = l.pagex
/ conf
.tilew
in
640 let row = l.pagey / conf
.tileh
in
642 let xadj = xadjsb () in
643 let rec rowloop row y0 dispy h
=
647 let dh = conf
.tileh
- y0 in
649 let rec colloop col x0 dispx w
=
653 let dw = conf
.tilew
- x0 in
655 let dispx'
= xadj + dispx in
656 f col row dispx' dispy
x0 y0 dw dh;
657 colloop (col+1) 0 (dispx+dw) (w
-dw)
660 colloop col tilex l.pagedispx l.pagevw;
661 rowloop (row+1) 0 (dispy
+dh) (h
-dh)
664 if l.pagevw > 0 && l.pagevh > 0
665 then rowloop row tiley l.pagedispy l.pagevh;
668 let gettileopaque l col row =
670 l.pageno
, state
.gen
, conf
.colorspace
, conf
.angle
, l.pagew
, l.pageh
, col, row
672 try Some
(Hashtbl.find state
.tilemap
key)
673 with Not_found
-> None
676 let puttileopaque l col row gen colorspace angle opaque size elapsed
=
677 let key = l.pageno
, gen
, colorspace
, angle
, l.pagew
, l.pageh
, col, row in
678 Hashtbl.add state
.tilemap
key (opaque
, size
, elapsed
)
681 let filledrect x0 y0 x1 y1 =
682 GlArray.disable `texture_coord
;
683 Raw.sets_float state
.vraw ~pos
:0 [| x0; y0; x0; y1; x1; y0; x1; y1 |];
684 GlArray.vertex `two state
.vraw
;
685 GlArray.draw_arrays `triangle_strip ~first
:0 ~count
:4;
686 GlArray.enable `texture_coord
;
689 let linerect x0 y0 x1 y1 =
690 GlArray.disable `texture_coord
;
691 Raw.sets_float state
.vraw ~pos
:0 [| x0; y0; x0; y1; x1; y1; x1; y0 |];
692 GlArray.vertex `two state
.vraw
;
693 GlArray.draw_arrays `line_loop ~first
:0 ~count
:4;
694 GlArray.enable `texture_coord
;
697 let drawtiles l color
=
699 let wadj = wadjsb () in
701 let f col row x y tilex tiley w h
=
702 match gettileopaque l col row with
703 | Some
(opaque
, _
, t
) ->
704 let params = x, y, w
, h
, tilex, tiley in
706 then GlTex.env
(`mode `blend
);
707 drawtile
params opaque
;
709 then GlTex.env
(`mode `modulate
);
713 let s = Printf.sprintf
717 let w = measurestr fstate
.fontsize
s in
718 GlDraw.color
(0.0, 0.0, 0.0);
719 filledrect (float (x-2))
722 (float (y + fstate
.fontsize
+ 2));
723 GlDraw.color
(1.0, 1.0, 1.0);
724 drawstring fstate
.fontsize
x (y + fstate
.fontsize
- 1) s;
734 let lw = wadj + state
.winw
- x in
737 let lh = state
.winh
- y in
741 then GlTex.env
(`mode `blend
);
742 begin match state
.checkerstexid
with
744 Gl.enable `texture_2d
;
745 GlTex.bind_texture ~target
:`texture_2d id
;
749 and y1 = float (y+h
) in
751 let tw = float w /. 16.0
752 and th
= float h
/. 16.0 in
753 let tx0 = float tilex /. 16.0
754 and ty0
= float tiley /. 16.0 in
756 and ty1
= ty0
+. th
in
757 Raw.sets_float state
.vraw ~pos
:0
758 [| x0; y0; x0; y1; x1; y0; x1; y1 |];
759 Raw.sets_float state
.traw ~pos
:0
760 [| tx0; ty0
; tx0; ty1
; tx1; ty0
; tx1; ty1
|];
761 GlArray.vertex `two state
.vraw
;
762 GlArray.tex_coord `two state
.traw
;
763 GlArray.draw_arrays `triangle_strip ~first
:0 ~count
:4;
764 Gl.disable `texture_2d
;
767 GlDraw.color
(1.0, 1.0, 1.0);
768 filledrect (float x) (float y) (float (x+w)) (float (y+h
));
771 then GlTex.env
(`mode `modulate
);
772 if w > 128 && h
> fstate
.fontsize
+ 10
774 let c = if conf
.invert
then 1.0 else 0.0 in
775 GlDraw.color
(c, c, c);
778 then (col*conf
.tilew
, row*conf
.tileh
)
781 drawstring2 fstate
.fontsize
x y "Loading %d [%d,%d]" l.pageno
c r
;
790 let pagevisible layout n = List.exists
(fun l -> l.pageno
= n) layout;;
792 let tilevisible1 l x y =
794 and ax1
= l.pagex
+ l.pagevw
796 and ay1
= l.pagey + l.pagevh in
800 let bx1 = min
(bx0 + conf
.tilew
) l.pagew
801 and by1
= min
(by0
+ conf
.tileh
) l.pageh
in
803 let rx0 = max
ax0 bx0
804 and ry0
= max ay0 by0
805 and rx1
= min ax1
bx1
806 and ry1
= min ay1 by1
in
808 let nonemptyintersection = rx1
> rx0 && ry1
> ry0
in
812 let tilevisible layout n x y =
813 let rec findpageinlayout m
= function
814 | l :: rest
when l.pageno
= n ->
815 tilevisible1 l x y || (
816 match conf
.columns
with
817 | Csplit
(c, _
) when c > m
-> findpageinlayout (m
+1) rest
822 | _
:: rest
-> findpageinlayout 0 rest
825 findpageinlayout 0 layout;
828 let tileready l x y =
829 tilevisible1 l x y &&
830 gettileopaque l (x/conf
.tilew
) (y/conf
.tileh
) != None
833 let tilepage n p
layout =
834 let rec loop = function
838 let f col row _ _ _ _ _ _
=
839 if state
.currently
= Idle
841 match gettileopaque l col row with
844 let x = col*conf
.tilew
845 and y = row*conf
.tileh
in
847 let w = l.pagew
- x in
851 let h = l.pageh
- y in
856 then getpbo
w h conf
.colorspace
859 wcmd "tile %s %d %d %d %d %s"
860 (~
> p
) x y w h (~
> pbo);
863 l, p
, conf
.colorspace
, conf
.angle
,
864 state
.gen
, col, row, conf
.tilew
, conf
.tileh
873 if nogeomcmds state
.geomcmds
877 let preloadlayout y =
878 let y = if y < state
.winh
then 0 else y - state
.winh
in
879 let h = state
.winh
*3 in
885 if state
.currently
!= Idle
890 begin match getopaque l.pageno
with
892 wcmd "page %d %d" l.pageno
l.pagedimno
;
893 state
.currently
<- Loading
(l, state
.gen
);
895 tilepage l.pageno opaque pages
;
900 if nogeomcmds state
.geomcmds
906 if conf
.preload && state
.currently
= Idle
907 then load (preloadlayout state
.y);
910 let layoutready layout =
911 let rec fold all ls
=
914 let seen = ref false in
915 let allvisible = ref true in
916 let foo col row _ _ _ _ _ _
=
918 allvisible := !allvisible &&
919 begin match gettileopaque l col row with
925 fold (!seen && !allvisible) rest
928 let alltilesvisible = fold true layout in
933 let y = bound
y 0 state
.maxy
in
934 let y, layout, proceed
=
935 match conf
.maxwait
with
936 | Some time
when state
.ghyll
== noghyll
->
937 begin match state
.throttle
with
939 let layout = layout y state
.winh
in
940 let ready = layoutready layout in
944 state
.throttle
<- Some
(layout, y, now
());
946 else G.postRedisplay "gotoy showall (None)";
948 | Some
(_
, _
, started
) ->
949 let dt = now
() -. started
in
952 state
.throttle
<- None
;
953 let layout = layout y state
.winh
in
955 G.postRedisplay "maxwait";
962 let layout = layout y state
.winh
in
963 if not
!wtmode || layoutready layout
964 then G.postRedisplay "gotoy ready";
970 state
.layout <- layout;
971 begin match state
.mode
with
974 | Ltexact
(pageno
, linkno
) ->
975 let rec loop = function
977 state
.mode
<- LinkNav
(Ltgendir
0)
978 | l :: _
when l.pageno
= pageno
->
979 begin match getopaque pageno
with
980 | None
-> state
.mode
<- LinkNav
(Ltnotready
(pageno
, 0))
982 let x0, y0, x1, y1 = getlinkrect opaque linkno
in
983 if not
(x0 >= l.pagex
&& x1 <= l.pagex
+ l.pagevw
984 && y0 >= l.pagey && y1 <= l.pagey + l.pagevh)
985 then state
.mode
<- LinkNav
(Ltgendir
0)
987 | _
:: rest
-> loop rest
990 | Ltnotready _
| Ltgendir _
-> ()
996 begin match state
.mode
with
997 | Birdseye
(conf
, leftx
, pageno
, hooverpageno
, anchor
) ->
998 if not
(pagevisible layout pageno
)
1000 match state
.layout with
1003 state
.mode
<- Birdseye
(
1004 conf
, leftx
, l.pageno
, hooverpageno
, anchor
1009 | Ltnotready
(_
, dir
)
1012 let rec loop = function
1015 match getopaque l.pageno
with
1016 | None
-> Ltnotready
(l.pageno
, dir
)
1021 then LDfirstvisible
(l.pagex
, l.pagey, dir
)
1023 if dir
> 0 then LDfirst
else LDlast
1029 | Lnotfound
-> loop rest
1031 showlinktype (getlink opaque
n);
1032 Ltexact
(l.pageno
, n)
1036 state
.mode
<- LinkNav
linknav
1044 state
.ghyll
<- noghyll
;
1047 let mx, my
= state
.mpos
in
1052 let conttiling pageno opaque
=
1053 tilepage pageno opaque
1054 (if conf
.preload then preloadlayout state
.y else state
.layout)
1057 let gotoy_and_clear_text y =
1058 if not conf
.verbose
then state
.text <- E.s;
1062 let getanchory (n, top
, dtop
) =
1063 let y, h = getpageyh
n in
1064 if conf
.presentation
1066 let ips = calcips
h in
1067 y + truncate
(top
*.float h -. dtop
*.float ips) + ips;
1069 y + truncate
(top
*.float h -. dtop
*.float conf
.interpagespace
)
1072 let gotoanchor anchor
=
1073 gotoy (getanchory anchor
);
1077 cbput state
.hists
.nav
(getanchor
());
1081 let anchor = cbgetc state
.hists
.nav dir
in
1085 let gotoghyll1 single
y =
1086 let scroll f n a
b =
1087 (* http://devmaster.net/forums/topic/9796-ease-in-ease-out-algorithm/ *)
1089 let s x = 3.0*.x**2.0 -. 2.0*.x**3.0 in
1091 then s (float f /. float a
)
1094 then 1.0 -. s ((float (f-b) /. float (n-b)))
1100 let ins = float a
*. 0.5
1101 and outs
= float (n-b) *. 0.5 in
1103 ins +. outs
+. float ones
1105 let rec set nab
y sy
=
1106 let (_N
, _A
, _B
), y =
1109 let scl = if y > sy
then 2 else -2 in
1110 let _N, _
, _
= nab
in
1111 (_N,0,_N), y+conf
.scrollstep
*scl
1113 let sum = summa
_N _A _B
in
1114 let dy = float (y - sy
) in
1118 then state
.ghyll
<- noghyll
1121 let s = scroll n _N _A _B
in
1122 let y1 = y1 +. ((s *. dy) /. sum) in
1123 gotoy_and_clear_text (truncate
y1);
1124 state
.ghyll
<- gf (n+1) y1;
1128 | Some
y'
when single
-> set nab
y' state
.y
1129 | Some
y'
-> set (_N/2, 1, 1) y' state
.y
1131 gf 0 (float state
.y)
1134 match conf
.ghyllscroll
with
1135 | Some nab
when not conf
.presentation
->
1136 if state
.ghyll
== noghyll
1137 then set nab
y state
.y
1138 else state
.ghyll
(Some
y)
1140 gotoy_and_clear_text y
1143 let gotoghyll = gotoghyll1 false;;
1145 let gotopage n top
=
1146 let y, h = getpageyh
n in
1147 let y = y + (truncate
(top
*. float h)) in
1151 let gotopage1 n top
=
1152 let y = getpagey
n in
1157 let invalidate s f =
1162 match state
.geomcmds
with
1163 | ps
, [] when emptystr ps
->
1165 state
.geomcmds
<- s, [];
1168 state
.geomcmds
<- ps
, [s, f];
1170 | ps
, (s'
, _
) :: rest
when s'
= s ->
1171 state
.geomcmds
<- ps
, ((s, f) :: rest
);
1174 state
.geomcmds
<- ps
, ((s, f) :: cmds
);
1178 Hashtbl.iter
(fun _ opaque
->
1179 wcmd "freepage %s" (~
> opaque
);
1181 Hashtbl.clear state
.pagemap
;
1185 if not
(Queue.is_empty state
.tilelru
)
1187 Queue.iter
(fun (k
, p
, s) ->
1188 wcmd "freetile %s" (~
> p
);
1189 state
.memused
<- state
.memused
- s;
1190 Hashtbl.remove state
.tilemap k
;
1192 state
.uioh#infochanged Memused
;
1193 Queue.clear state
.tilelru
;
1199 let h = truncate
(float h*.conf
.zoom
) in
1200 let d = conf
.interpagespace
lsl (if conf
.presentation
then 1 else 0) in
1204 let opendoc path password
=
1206 state
.password
<- password
;
1207 state
.gen
<- state
.gen
+ 1;
1208 state
.docinfo
<- [];
1209 state
.outlines
<- [||];
1212 setaalevel conf
.aalevel
;
1214 if emptystr state
.origin
1218 Wsi.settitle
("llpp " ^
(mbtoutf8
(Filename.basename
titlepath)));
1219 wcmd "open %d %d %s\000%s\000" (btod
!wtmode) (btod
!cxack) path password
;
1220 invalidate "reqlayout"
1222 wcmd "reqlayout %d %d %d %s\000"
1223 conf
.angle
(FMTE.to_int conf
.fitmodel
)
1224 (stateh state
.winh
) state
.nameddest
1229 state
.anchor <- getanchor
();
1230 opendoc state
.path state
.password
;
1234 let c = c *. conf
.colorscale
in
1238 let scalecolor2 (r
, g, b) =
1239 (r
*. conf
.colorscale
, g *. conf
.colorscale
, b *. conf
.colorscale
);
1242 let docolumns columns
=
1243 let wadj = wadjsb () in
1246 let a = Array.make state
.pagecount
(-1, -1, -1, (-1, -1, -1, -1)) in
1247 let wadj = wadjsb () in
1248 let rec loop pageno
pdimno pdim
y ph pdims
=
1249 if pageno
= state
.pagecount
1252 let pdimno, ((_
, w, h, xoff
) as pdim
), pdims
=
1254 | ((pageno'
, _
, _
, _
) as pdim
) :: rest
when pageno'
= pageno
->
1255 pdimno+1, pdim
, rest
1259 let x = max
0 (((wadj + state
.winw
- w) / 2) - xoff
) in
1261 (if conf
.presentation
1262 then (if pageno
= 0 then calcips
h else calcips ph
+ calcips
h)
1263 else (if pageno
= 0 then 0 else conf
.interpagespace
)
1266 a.(pageno
) <- (pdimno, x, y, pdim
);
1267 loop (pageno
+1) pdimno pdim
(y + h) h pdims
1269 loop 0 ~
-1 (-1,-1,-1,-1) 0 0 state
.pdims
;
1270 conf
.columns
<- Csingle
a;
1272 | Cmulti
((columns
, coverA
, coverB
), _
) ->
1273 let a = Array.make state
.pagecount
(-1, -1, -1, (-1, -1, -1, -1)) in
1274 let rec loop pageno
pdimno pdim
x y rowh pdims
=
1275 let rec fixrow m
= if m
= pageno
then () else
1276 let (pdimno, x, y, ((_
, _
, h, _
) as pdim
)) = a.(m
) in
1279 let y = y + (rowh
- h) / 2 in
1280 a.(m
) <- (pdimno, x, y, pdim
);
1284 if pageno
= state
.pagecount
1285 then fixrow (((pageno
- 1) / columns
) * columns
)
1287 let pdimno, ((_
, w, h, xoff
) as pdim
), pdims
=
1289 | ((pageno'
, _
, _
, _
) as pdim
) :: rest
when pageno'
= pageno
->
1290 pdimno+1, pdim
, rest
1295 if pageno
= coverA
- 1 || pageno
= state
.pagecount
- coverB
1297 let x = (wadj + state
.winw
- w) / 2 in
1299 if conf
.presentation
then calcips
h else conf
.interpagespace
in
1300 x, y + ips + rowh
, h
1303 if (pageno
- coverA
) mod columns
= 0
1305 let x = max
0 (wadj + state
.winw
- state
.w) / 2 in
1307 if conf
.presentation
1309 let ips = calcips
h in
1310 y + (if pageno
= 0 then 0 else calcips rowh
+ ips)
1312 y + (if pageno
= 0 then 0 else conf
.interpagespace
)
1316 else x, y, max rowh
h
1320 if pageno
> 1 && (pageno
- coverA
) mod columns
= 0
1323 if pageno
= columns
&& conf
.presentation
1325 let ips = calcips rowh
in
1326 for i
= 0 to pred columns
1328 let (pdimno, x, y, pdim
) = a.(i
) in
1329 a.(i
) <- (pdimno, x, y+ips, pdim
)
1335 fixrow (pageno
- columns
);
1340 a.(pageno
) <- (pdimno, x, y, pdim
);
1341 let x = x + w + xoff
*2 + conf
.interpagespace
in
1342 loop (pageno
+1) pdimno pdim
x y rowh' pdims
1344 loop 0 ~
-1 (-1,-1,-1,-1) 0 0 0 state
.pdims
;
1345 conf
.columns
<- Cmulti
((columns
, coverA
, coverB
), a);
1348 let a = Array.make
(state
.pagecount
*c) (-1, -1, -1, (-1, -1, -1, -1)) in
1349 let rec loop pageno
pdimno pdim
y pdims
=
1350 if pageno
= state
.pagecount
1353 let pdimno, ((_
, w, h, _
) as pdim
), pdims
=
1355 | ((pageno'
, _
, _
, _
) as pdim
) :: rest
when pageno'
= pageno
->
1356 pdimno+1, pdim
, rest
1361 let rec loop1 n x y =
1362 if n = c then y else (
1363 a.(pageno
*c + n) <- (pdimno, x, y, pdim
);
1364 loop1 (n+1) (x+cw) (y + h + conf
.interpagespace
)
1367 let y = loop1 0 0 y in
1368 loop (pageno
+1) pdimno pdim
y pdims
1370 loop 0 ~
-1 (-1,-1,-1,-1) 0 state
.pdims
;
1371 conf
.columns
<- Csplit
(c, a);
1375 docolumns conf
.columns
;
1376 state
.maxy
<- calcheight
();
1377 if state
.reprf
== noreprf
1379 match state
.mode
with
1380 | Birdseye
(_
, _
, pageno
, _
, _
) ->
1381 let y, h = getpageyh pageno
in
1382 let top = (state
.winh
- h) / 2 in
1383 gotoy (max
0 (y - top))
1386 | LinkNav _
-> gotoanchor state
.anchor
1390 state
.reprf
<- noreprf
;
1394 let reshape ?
(firsttime
=false) w h =
1395 GlDraw.viewport ~
x:0 ~
y:0 ~
w:w ~
h:h;
1396 if not firsttime
&& nogeomcmds state
.geomcmds
1397 then state
.anchor <- getanchor
();
1400 let w = wadjsb () + (truncate
(float w *. conf
.zoom
)) in
1403 setfontsize fstate
.fontsize
;
1404 GlMat.mode `modelview
;
1405 GlMat.load_identity
();
1407 GlMat.mode `projection
;
1408 GlMat.load_identity
();
1409 GlMat.rotate ~
x:1.0 ~angle
:180.0 ();
1410 GlMat.translate ~
x:~
-.1.0 ~
y:~
-.1.0 ();
1411 GlMat.scale3
(2.0 /. float state
.winw
, 2.0 /. float state
.winh
, 1.0);
1416 else float state
.x /. float state
.w
1418 invalidate "geometry"
1422 then state
.x <- truncate
(relx *. float w);
1424 match conf
.columns
with
1426 | Cmulti
((c, _
, _
), _
) -> (w - (c-1)*conf
.interpagespace
) / c
1427 | Csplit
(c, _
) -> w * c
1429 wcmd "geometry %d %d %d"
1430 w (stateh h) (FMTE.to_int conf
.fitmodel
)
1435 let len = String.length state
.text in
1436 let x0 = xadjsb () in
1439 match state
.mode
with
1440 | Textentry _
| View
| LinkNav _
->
1441 let h, _
, _
= state
.uioh#scrollpw
in
1446 filledrect x (float (state
.winh
- (fstate
.fontsize
+ 4) - hscrollh))
1447 (x+.w) (float (state
.winh
- hscrollh))
1450 let w = float (wadjsb () + state
.winw
- 1) in
1451 if state
.progress
>= 0.0 && state
.progress
< 1.0
1453 GlDraw.color
(0.3, 0.3, 0.3);
1454 let w1 = w *. state
.progress
in
1456 GlDraw.color
(0.0, 0.0, 0.0);
1457 rect (float x0+.w1) (float x0+.w-.w1)
1460 GlDraw.color
(0.0, 0.0, 0.0);
1464 GlDraw.color
(1.0, 1.0, 1.0);
1465 drawstring fstate
.fontsize
1466 (if conf
.leftscroll
then x0 + 2 else x0 + if len > 0 then 8 else 2)
1467 (state
.winh
- hscrollh - 5) s;
1470 match state
.mode
with
1471 | Textentry
((prefix
, text, _
, _
, _
, _
), _
) ->
1475 Printf.sprintf
"%s%s_ [%s]" prefix
text state
.text
1477 Printf.sprintf
"%s%s_" prefix
text
1483 | LinkNav _
-> state
.text
1488 if not
(istextentry state
.mode
) && state
.uioh#eformsgs
1490 let s1 = "(press 'e' to review error messasges)" in
1491 if nonemptystr
s then s ^
" " ^
s1 else s1
1501 let len = Queue.length state
.tilelru
in
1503 match state
.throttle
with
1506 then preloadlayout state
.y
1508 | Some
(layout, _
, _
) ->
1512 if state
.memused
<= conf
.memlimit
1517 let (k
, p
, s) as lruitem
= Queue.pop state
.tilelru
in
1518 let n, gen
, colorspace
, angle
, pagew
, pageh
, col, row = k
in
1519 let (_
, pw, ph
, _
) = getpagedim
n in
1522 && colorspace
= conf
.colorspace
1523 && angle
= conf
.angle
1527 let x = col*conf
.tilew
1528 and y = row*conf
.tileh
in
1529 tilevisible (Lazy.force_val
layout) n x y
1531 then Queue.push lruitem state
.tilelru
1534 wcmd "freetile %s" (~
> p
);
1535 state
.memused
<- state
.memused
- s;
1536 state
.uioh#infochanged Memused
;
1537 Hashtbl.remove state
.tilemap k
;
1545 let onpagerect pageno
f =
1547 match conf
.columns
with
1548 | Cmulti
(_
, b) -> b
1550 | Csplit
(_
, b) -> b
1552 if pageno
>= 0 && pageno
< Array.length
b
1554 let (_
, _
, _
, (_
, w, h, _
)) = b.(pageno
) in
1558 let gotopagexy1 pageno
x y =
1559 let _,w1,h1
,leftx
= getpagedim pageno
in
1560 let top = y /. (float h1
) in
1561 let left = x /. (float w1) in
1562 let py, w, h = getpageywh pageno
in
1563 let wh = state
.winh
- hscrollh () in
1564 let x = left *. (float w) in
1565 let x = leftx
+ state
.x + truncate
x in
1566 let wadj = wadjsb () in
1568 if x < 0 || x >= wadj + state
.winw
1572 let pdy = truncate
(top *. float h) in
1573 let y'
= py + pdy in
1574 let dy = y'
- state
.y in
1576 if x != state
.x || not
(dy > 0 && dy < wh)
1578 if conf
.presentation
1580 if abs
(py - y'
) > wh
1587 if state
.x != sx || state
.y != sy
1592 let ww = wadj + state
.winw
in
1594 and qy
= pdy / wh in
1596 and y = py + qy
* wh in
1597 let x = if -x + ww > w1 then -(w1-ww) else x
1598 and y'
= if y + wh > state
.maxy
then state
.maxy
- wh else y in
1600 if conf
.presentation
1602 if abs
(py - y'
) > wh
1612 gotoy_and_clear_text y;
1614 else gotoy_and_clear_text state
.y;
1617 let gotopagexy pageno
x y =
1618 match state
.mode
with
1619 | Birdseye
_ -> gotopage pageno
0.0
1622 | LinkNav
_ -> gotopagexy1 pageno
x y
1625 let getpassword () =
1626 let passcmd = getenvwithdef
"LLPP_ASKPASS" conf
.passcmd in
1631 showtext '
!'
@@ "error getting password: " ^
s;
1632 dolog
"%s" s) passcmd;
1636 (* dolog "%S" cmds; *)
1637 let cl = splitatspace cmds
in
1639 try Scanf.sscanf
s fmt
f
1641 dolog
"error processing '%S': %s" cmds
(exntos exn
);
1644 let addoutline outline
=
1645 match state
.currently
with
1646 | Outlining outlines
->
1647 state
.currently
<- Outlining
(outline
:: outlines
)
1648 | Idle
-> state
.currently
<- Outlining
[outline
]
1651 dolog
"invalid outlining state";
1652 logcurrently state
.currently
1656 state
.uioh#infochanged Pdim
;
1659 | "clearrects" :: [] ->
1660 state
.rects
<- state
.rects1
;
1661 G.postRedisplay "clearrects";
1663 | "continue" :: args
:: [] ->
1664 let n = scan args
"%u" (fun n -> n) in
1665 state
.pagecount
<- n;
1666 begin match state
.currently
with
1668 state
.currently
<- Idle
;
1669 state
.outlines
<- Array.of_list
(List.rev
l)
1675 let cur, cmds
= state
.geomcmds
in
1677 then failwith
"umpossible";
1679 begin match List.rev cmds
with
1681 state
.geomcmds
<- E.s, [];
1682 state
.throttle
<- None
;
1686 state
.geomcmds
<- s, List.rev rest
;
1688 if conf
.maxwait
= None
&& not
!wtmode
1689 then G.postRedisplay "continue";
1691 | "msg" :: args
:: [] ->
1694 | "vmsg" :: args
:: [] ->
1696 then showtext ' ' args
1698 | "emsg" :: args
:: [] ->
1699 Buffer.add_string state
.errmsgs args
;
1700 state
.newerrmsgs
<- true;
1701 G.postRedisplay "error message"
1703 | "progress" :: args
:: [] ->
1704 let progress, text =
1707 f, String.sub args pos
(String.length args
- pos
))
1710 state
.progress <- progress;
1711 G.postRedisplay "progress"
1713 | "firstmatch" :: args
:: [] ->
1714 let pageno, c, x0, y0, x1, y1, x2
, y2
, x3
, y3
=
1715 scan args
"%u %d %f %f %f %f %f %f %f %f"
1716 (fun p
c x0 y0 x1 y1 x2 y2 x3 y3
->
1717 (p
, c, x0, y0, x1, y1, x2
, y2
, x3
, y3
))
1719 let xoff = float (xadjsb ()) in
1723 and x3
= x3
+. xoff in
1724 let y = (getpagey
pageno) + truncate
y0 in
1727 state
.rects1
<- [pageno, c, (x0, y0, x1, y1, x2
, y2
, x3
, y3
)]
1729 | "match" :: args
:: [] ->
1730 let pageno, c, x0, y0, x1, y1, x2
, y2
, x3
, y3
=
1731 scan args
"%u %d %f %f %f %f %f %f %f %f"
1732 (fun p
c x0 y0 x1 y1 x2 y2 x3 y3
->
1733 (p
, c, x0, y0, x1, y1, x2
, y2
, x3
, y3
))
1735 let xoff = float (xadjsb ()) in
1739 and x3
= x3
+. xoff in
1741 (pageno, c, (x0, y0, x1, y1, x2
, y2
, x3
, y3
)) :: state
.rects1
1743 | "page" :: args
:: [] ->
1744 let pageopaques, t
= scan args
"%s %f" (fun p t
-> p
, t
) in
1745 let pageopaque = ~
< pageopaques in
1746 begin match state
.currently
with
1747 | Loading
(l, gen
) ->
1748 vlog "page %d took %f sec" l.pageno t
;
1749 Hashtbl.replace state
.pagemap
(l.pageno, gen
) pageopaque;
1750 begin match state
.throttle
with
1752 let preloadedpages =
1754 then preloadlayout state
.y
1759 List.fold_left
(fun s l -> IntSet.add
l.pageno s)
1760 IntSet.empty
preloadedpages
1763 Hashtbl.fold (fun ((pageno, _) as key) opaque
accu ->
1764 if not
(IntSet.mem
pageno set)
1766 wcmd "freepage %s" (~
> opaque
);
1772 List.iter
(Hashtbl.remove state
.pagemap
) evictedpages;
1775 state
.currently
<- Idle
;
1778 tilepage l.pageno pageopaque state
.layout;
1780 load preloadedpages;
1781 let visible = pagevisible state
.layout l.pageno in
1784 match state
.mode
with
1785 | LinkNav
(Ltnotready
(pageno, dir
)) ->
1786 if pageno = l.pageno
1791 then LDfirstvisible
(l.pagex
, l.pagey, dir
)
1793 if dir
> 0 then LDfirst
else LDlast
1796 findlink
pageopaque ld
1801 showlinktype (getlink
pageopaque n);
1802 state
.mode
<- LinkNav
(Ltexact
(l.pageno, n))
1804 | LinkNav
(Ltgendir
_)
1805 | LinkNav
(Ltexact
_)
1811 if visible && layoutready state
.layout
1813 G.postRedisplay "page";
1817 | Some
(layout, _, _) ->
1818 state
.currently
<- Idle
;
1819 tilepage l.pageno pageopaque layout;
1826 dolog
"Inconsistent loading state";
1827 logcurrently state
.currently
;
1831 | "tile" :: args
:: [] ->
1832 let (x, y, opaques
, size
, t
) =
1833 scan args
"%u %u %s %u %f"
1834 (fun x y p size t
-> (x, y, p
, size
, t
))
1836 let opaque = ~
< opaques
in
1837 begin match state
.currently
with
1838 | Tiling
(l, pageopaque, cs
, angle
, gen
, col, row, tilew
, tileh
) ->
1839 vlog "tile %d [%d,%d] took %f sec" l.pageno col row t
;
1842 if tilew
!= conf
.tilew
|| tileh
!= conf
.tileh
1844 wcmd "freetile %s" (~
> opaque);
1845 state
.currently
<- Idle
;
1849 puttileopaque l col row gen cs angle
opaque size t
;
1850 state
.memused
<- state
.memused
+ size
;
1851 state
.uioh#infochanged Memused
;
1853 Queue.push
((l.pageno, gen
, cs
, angle
, l.pagew
, l.pageh
, col, row),
1854 opaque, size
) state
.tilelru
;
1857 match state
.throttle
with
1858 | None
-> state
.layout
1859 | Some
(layout, _, _) -> layout
1862 state
.currently
<- Idle
;
1864 && conf
.colorspace
= cs
1865 && conf
.angle
= angle
1866 && tilevisible layout l.pageno x y
1867 then conttiling l.pageno pageopaque;
1869 begin match state
.throttle
with
1871 preload state
.layout;
1873 && conf
.colorspace
= cs
1874 && conf
.angle
= angle
1875 && tilevisible state
.layout l.pageno x y
1876 && (not
!wtmode || layoutready state
.layout)
1877 then G.postRedisplay "tile nothrottle";
1879 | Some
(layout, y, _) ->
1880 let ready = layoutready layout in
1884 state
.layout <- layout;
1885 state
.throttle
<- None
;
1886 G.postRedisplay "throttle";
1895 dolog
"Inconsistent tiling state";
1896 logcurrently state
.currently
;
1900 | "pdim" :: args
:: [] ->
1901 let (n, w, h, _) as pdim
=
1902 scan args
"%u %u %u %u" (fun n w h x -> n, w, h, x)
1905 match conf
.fitmodel
with
1907 | FitPage
| FitProportional
->
1908 match conf
.columns
with
1909 | Csplit
_ -> (n, w, h, 0)
1910 | Csingle
_ | Cmulti
_ -> pdim
1912 state
.uioh#infochanged Pdim
;
1913 state
.pdims
<- pdim :: state
.pdims
1915 | "o" :: args
:: [] ->
1916 let (l, n, t
, h, pos
) =
1917 scan args
"%u %u %d %u %n"
1918 (fun l n t
h pos
-> l, n, t
, h, pos
)
1920 let s = String.sub args pos
(String.length args
- pos
) in
1921 addoutline (s, l, Oanchor
(n, float t
/. float h, 0.0))
1923 | "ou" :: args
:: [] ->
1924 let (l, len, pos
) = scan args
"%u %u %n" (fun l len pos
-> l, len, pos
) in
1925 let s = String.sub args pos
len in
1926 let pos2 = pos
+ len + 1 in
1927 let uri = String.sub args
pos2 (String.length args
- pos2) in
1928 addoutline (s, l, Ouri
uri)
1930 | "on" :: args
:: [] ->
1931 let (l, pos
) = scan args
"%u %n" (fun l pos
-> l, pos
) in
1932 let s = String.sub args pos
(String.length args
- pos
) in
1933 addoutline (s, l, Onone
)
1935 | "a" :: args
:: [] ->
1937 scan args
"%u %d %d" (fun n l t
-> n, l, t
)
1939 state
.reprf
<- (fun () -> gotopagexy n (float l) (float t
))
1941 | "info" :: args
:: [] ->
1942 let pos = nindex args '
\t'
in
1943 if pos >= 0 && String.sub args
0 pos = "Title"
1945 let s = String.sub args
(pos+1) @@ String.length args
- pos - 1 in
1949 state
.docinfo
<- (1, args
) :: state
.docinfo
1951 | "infoend" :: [] ->
1952 state
.uioh#infochanged Docinfo
;
1953 state
.docinfo
<- List.rev state
.docinfo
1957 then Wsi.settitle
"Wrong password";
1958 let password = getpassword () in
1960 then error
"document is password protected"
1961 else opendoc state
.path
password
1964 error
"unknown cmd `%S'" cmds
1969 let action = function
1970 | HCprev
-> cbget cb ~
-1
1971 | HCnext
-> cbget cb
1
1972 | HCfirst
-> cbget cb ~
-(cb
.rc)
1973 | HClast
-> cbget cb
(cb
.len - 1 - cb
.rc)
1974 and cancel
() = cb
.rc <- rc
1978 let search pattern forward
=
1979 match conf
.columns
with
1981 showtext '
!'
"searching does not work properly in split columns mode"
1984 if nonemptystr pattern
1987 match state
.layout with
1990 l.pageno, (l.pagey + if forward
then 0 else 0*l.pagevh)
1992 wcmd "search %d %d %d %d,%s\000"
1993 (btod conf
.icase
) pn py (btod forward
) pattern
;
1996 let intentry text key =
1998 if key >= 32 && key < 127
2004 let text = addchar
text c in
2008 state
.text <- Printf.sprintf
"invalid char (%d, `%c')" key c;
2016 let l = String.length
s in
2017 let rec loop pos n = if pos = l then n else
2018 let m = Char.code
s.[pos] - (if pos = 0 && l > 1 then 96 else 97) in
2019 loop (pos+1) (n*26 + m)
2022 let rec loop n = function
2025 match getopaque l.pageno with
2026 | None
-> loop n rest
2028 let m = getlinkcount
opaque in
2031 let under = getlink
opaque n in
2034 else loop (n-m) rest
2036 loop n state
.layout;
2040 let linknentry text key =
2042 if key >= 32 && key < 127
2048 let text = addchar
text c in
2049 linknact (fun under -> state
.text <- undertext ~nopath
:true under) text;
2053 state
.text <- Printf.sprintf
"invalid char (%d, `%c')" key c;
2057 let textentry text key =
2058 if key land 0xff00 = 0xff00
2060 else TEcont
(text ^ toutf8
key)
2063 let reqlayout angle fitmodel
=
2064 match state
.throttle
with
2066 if nogeomcmds state
.geomcmds
2067 then state
.anchor <- getanchor
();
2068 conf
.angle
<- angle
mod 360;
2071 match state
.mode
with
2072 | LinkNav
_ -> state
.mode
<- View
2077 conf
.fitmodel
<- fitmodel
;
2078 invalidate "reqlayout"
2080 wcmd "reqlayout %d %d %d"
2081 conf
.angle
(FMTE.to_int conf
.fitmodel
) (stateh state
.winh
)
2086 let settrim trimmargins trimfuzz
=
2087 if nogeomcmds state
.geomcmds
2088 then state
.anchor <- getanchor
();
2089 conf
.trimmargins
<- trimmargins
;
2090 conf
.trimfuzz
<- trimfuzz
;
2091 let x0, y0, x1, y1 = trimfuzz
in
2092 invalidate "settrim"
2094 wcmd "settrim %d %d %d %d %d" (btod conf
.trimmargins
) x0 y0 x1 y1);
2099 match state
.throttle
with
2101 let zoom = max
0.0001 zoom in
2102 if zoom <> conf
.zoom
2104 state
.prevzoom
<- (conf
.zoom, state
.x);
2106 reshape state
.winw state
.winh
;
2107 state
.text <- Printf.sprintf
"zoom is now %-5.2f" (zoom *. 100.0);
2110 | Some
(layout, y, started
) ->
2112 match conf
.maxwait
with
2116 let dt = now
() -. started
in
2124 let setcolumns mode columns coverA coverB
=
2125 state
.prevcolumns
<- Some
(conf
.columns
, conf
.zoom);
2129 then showtext '
!'
"split mode doesn't work in bird's eye"
2131 conf
.columns
<- Csplit
(-columns
, E.a);
2139 conf
.columns
<- Csingle
E.a;
2144 conf
.columns
<- Cmulti
((columns
, coverA
, coverB
), E.a);
2148 reshape state
.winw state
.winh
;
2151 let resetmstate () =
2152 state
.mstate
<- Mnone
;
2153 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
2156 let enterbirdseye () =
2157 let zoom = float conf
.thumbw
/. float state
.winw
in
2158 let birdseyepageno =
2159 let cy = state
.winh
/ 2 in
2163 let rec fold best
= function
2166 let d = cy - (l.pagedispy + l.pagevh/2)
2167 and dbest
= cy - (best
.pagedispy + best
.pagevh/2) in
2168 if abs
d < abs dbest
2175 state
.mode
<- Birdseye
(
2176 { conf
with zoom = conf
.zoom }, state
.x, birdseyepageno, -1, getanchor
()
2180 conf
.presentation
<- false;
2181 conf
.interpagespace
<- 10;
2182 conf
.hlinks
<- false;
2183 conf
.fitmodel
<- FitPage
;
2185 conf
.maxwait
<- None
;
2187 match conf
.beyecolumns
with
2190 Cmulti
((c, 0, 0), E.a)
2191 | None
-> Csingle
E.a
2195 state
.text <- Printf.sprintf
"birds eye mode on (zoom %3.1f%%)"
2200 reshape state
.winw state
.winh
;
2203 let leavebirdseye (c, leftx
, pageno, _, anchor) goback
=
2205 conf
.zoom <- c.zoom;
2206 conf
.presentation
<- c.presentation
;
2207 conf
.interpagespace
<- c.interpagespace
;
2208 conf
.maxwait
<- c.maxwait
;
2209 conf
.hlinks
<- c.hlinks
;
2210 conf
.fitmodel
<- c.fitmodel
;
2211 conf
.beyecolumns
<- (
2212 match conf
.columns
with
2213 | Cmulti
((c, _, _), _) -> Some
c
2215 | Csplit
_ -> failwith
"leaving bird's eye split mode"
2218 match c.columns
with
2219 | Cmulti
(c, _) -> Cmulti
(c, E.a)
2220 | Csingle
_ -> Csingle
E.a
2221 | Csplit
(c, _) -> Csplit
(c, E.a)
2225 state
.text <- Printf.sprintf
"birds eye mode off (zoom %3.1f%%)"
2228 reshape state
.winw state
.winh
;
2229 state
.anchor <- if goback
then anchor else (pageno, 0.0, 1.0);
2233 let togglebirdseye () =
2234 match state
.mode
with
2235 | Birdseye vals
-> leavebirdseye vals
true
2236 | View
-> enterbirdseye ()
2241 let upbirdseye incr
(conf
, leftx
, pageno, hooverpageno
, anchor) =
2242 let pageno = max
0 (pageno - incr
) in
2243 let rec loop = function
2244 | [] -> gotopage1 pageno 0
2245 | l :: _ when l.pageno = pageno ->
2246 if l.pagedispy >= 0 && l.pagey = 0
2247 then G.postRedisplay "upbirdseye"
2248 else gotopage1 pageno 0
2249 | _ :: rest
-> loop rest
2253 state
.mode
<- Birdseye
(conf
, leftx
, pageno, hooverpageno
, anchor)
2256 let downbirdseye incr
(conf
, leftx
, pageno, hooverpageno
, anchor) =
2257 let pageno = min
(state
.pagecount
- 1) (pageno + incr
) in
2258 state
.mode
<- Birdseye
(conf
, leftx
, pageno, hooverpageno
, anchor);
2259 let rec loop = function
2261 let y, h = getpageyh
pageno in
2262 let dy = (y - state
.y) - (state
.winh
- h - conf
.interpagespace
) in
2264 | l :: _ when l.pageno = pageno ->
2265 if l.pagevh != l.pageh
2266 then gotoy (clamp (l.pageh
- l.pagevh + conf
.interpagespace
))
2267 else G.postRedisplay "downbirdseye"
2268 | _ :: rest
-> loop rest
2274 let optentry mode
_ key =
2275 let btos b = if b then "on" else "off" in
2276 if key >= 32 && key < 127
2278 let c = Char.chr
key in
2282 try conf
.scrollstep
<- int_of_string
s with exc
->
2283 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2285 TEswitch
("scroll step: ", E.s, None
, intentry, ondone, true)
2290 conf
.autoscrollstep
<- boundastep state
.winh
(int_of_string
s);
2291 if state
.autoscroll
<> None
2292 then state
.autoscroll
<- Some conf
.autoscrollstep
2294 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2296 TEswitch
("auto scroll step: ", E.s, None
, intentry, ondone, true)
2301 let n, a, b = multicolumns_of_string
s in
2302 setcolumns mode
n a b;
2304 state
.text <- Printf.sprintf
"bad columns `%s': %s" s (exntos exc
)
2306 TEswitch
("columns: ", E.s, None
, textentry, ondone, true)
2311 let zoom = float (int_of_string
s) /. 100.0 in
2314 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2316 TEswitch
("zoom: ", E.s, None
, intentry, ondone, true)
2321 conf
.thumbw
<- bound
(int_of_string
s) 2 4096;
2323 Printf.sprintf
"thumbnail width is set to %d" conf
.thumbw
;
2324 begin match mode
with
2326 leavebirdseye beye
false;
2333 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2335 TEswitch
("thumbnail width: ", E.s, None
, intentry, ondone, true)
2340 Some
(int_of_string
s)
2342 state
.text <- Printf.sprintf
"bad integer `%s': %s"
2346 | Some angle
-> reqlayout angle conf
.fitmodel
2349 TEswitch
("rotation: ", E.s, None
, intentry, ondone, true)
2352 conf
.icase
<- not conf
.icase
;
2353 TEdone
("case insensitive search " ^
(btos conf
.icase
))
2356 conf
.preload <- not conf
.preload;
2358 TEdone
("preload " ^
(btos conf
.preload))
2361 conf
.verbose
<- not conf
.verbose
;
2362 TEdone
("verbose " ^
(btos conf
.verbose
))
2365 conf
.debug
<- not conf
.debug
;
2366 TEdone
("debug " ^
(btos conf
.debug
))
2369 conf
.maxhfit
<- not conf
.maxhfit
;
2370 state
.maxy
<- calcheight
();
2371 TEdone
("maxhfit " ^
(btos conf
.maxhfit
))
2374 conf
.crophack
<- not conf
.crophack
;
2375 TEdone
("crophack " ^
btos conf
.crophack
)
2379 match conf
.maxwait
with
2381 conf
.maxwait
<- Some infinity
;
2382 "always wait for page to complete"
2384 conf
.maxwait
<- None
;
2385 "show placeholder if page is not ready"
2390 conf
.underinfo
<- not conf
.underinfo
;
2391 TEdone
("underinfo " ^
btos conf
.underinfo
)
2394 conf
.savebmarks
<- not conf
.savebmarks
;
2395 TEdone
("persistent bookmarks " ^
btos conf
.savebmarks
)
2401 match state
.layout with
2406 conf
.interpagespace
<- int_of_string
s;
2407 docolumns conf
.columns
;
2408 state
.maxy
<- calcheight
();
2409 let y = getpagey
pageno in
2412 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2414 TEswitch
("vertical margin: ", E.s, None
, intentry, ondone, true)
2418 match conf
.fitmodel
with
2419 | FitProportional
-> FitWidth
2420 | FitWidth
| FitPage
-> FitProportional
2422 reqlayout conf
.angle
fm;
2423 TEdone
("proportional display " ^
btos (fm == FitProportional
))
2426 settrim (not conf
.trimmargins
) conf
.trimfuzz
;
2427 TEdone
("trim margins " ^
btos conf
.trimmargins
)
2430 conf
.invert
<- not conf
.invert
;
2431 TEdone
("invert colors " ^
btos conf
.invert
)
2435 cbput state
.hists
.sel
s;
2438 TEswitch
("selection command: ", E.s, Some
(onhist state
.hists
.sel
),
2439 textentry, ondone, true)
2443 then conf
.pax
<- Some
(ref (0.0, 0, 0))
2444 else conf
.pax
<- None
;
2445 TEdone
("PAX " ^
btos (conf
.pax
!= None
))
2448 state
.text <- Printf.sprintf
"bad option %d `%c'" key c;
2454 class type lvsource
= object
2455 method getitemcount
: int
2456 method getitem
: int -> (string * int)
2457 method hasaction
: int -> bool
2465 method getactive
: int
2466 method getfirst
: int
2468 method getminfo
: (int * int) array
2471 class virtual lvsourcebase
= object
2472 val mutable m_active
= 0
2473 val mutable m_first
= 0
2474 val mutable m_pan
= 0
2475 method getactive
= m_active
2476 method getfirst
= m_first
2477 method getpan
= m_pan
2478 method getminfo
: (int * int) array
= E.a
2481 let textentrykeyboard
2482 key _mask
((c, text, opthist
, onkey
, ondone, cancelonempty
), onleave
) =
2485 if key >= 0xffb0 && key <= 0xffb9
2486 then key - 0xffb0 + 48 else key
2489 state
.mode
<- Textentry
(te
, onleave
);
2491 G.postRedisplay "textentrykeyboard enttext";
2493 let histaction cmd
=
2496 | Some
(action, _) ->
2497 state
.mode
<- Textentry
(
2498 (c, action cmd
, opthist
, onkey
, ondone, cancelonempty
), onleave
2500 G.postRedisplay "textentry histaction"
2504 if emptystr
text && cancelonempty
2507 G.postRedisplay "textentrykeyboard after cancel";
2510 let s = withoutlastutf8
text in
2511 enttext (c, s, opthist
, onkey
, ondone, cancelonempty
)
2513 | @enter
| @kpenter
->
2516 G.postRedisplay "textentrykeyboard after confirm"
2518 | @up
| @kpup
-> histaction HCprev
2519 | @down
| @kpdown
-> histaction HCnext
2520 | @home
| @kphome
-> histaction HCfirst
2521 | @jend
| @kpend
-> histaction HClast
2526 begin match opthist
with
2528 | Some
(_, onhistcancel
) -> onhistcancel
()
2532 G.postRedisplay "textentrykeyboard after cancel2"
2535 enttext (c, E.s, opthist
, onkey
, ondone, cancelonempty
)
2538 | @delete
| @kpdelete
-> ()
2541 && key land 0xff00 != 0xff00 (* keyboard *)
2542 && key land 0xfe00 != 0xfe00 (* xkb *)
2543 && key land 0xfd00 != 0xfd00 (* 3270 *)
2545 begin match onkey
text key with
2549 G.postRedisplay "textentrykeyboard after confirm2";
2552 enttext (c, text, opthist
, onkey
, ondone, cancelonempty
);
2556 G.postRedisplay "textentrykeyboard after cancel3"
2559 state
.mode
<- Textentry
(te
, onleave
);
2560 G.postRedisplay "textentrykeyboard switch";
2564 vlog "unhandled key %s" (Wsi.keyname
key)
2567 let firstof first active
=
2568 if first
> active
|| abs
(first
- active
) > fstate
.maxrows
- 1
2569 then max
0 (active
- (fstate
.maxrows
/2))
2573 let calcfirst first active
=
2576 let rows = active
- first
in
2577 if rows > fstate
.maxrows
then active
- fstate
.maxrows
else first
2581 let scrollph y maxy
=
2582 let sh = float (maxy
+ state
.winh
) /. float state
.winh
in
2583 let sh = float state
.winh
/. sh in
2584 let sh = max
sh (float conf
.scrollh
) in
2586 let percent = float y /. float maxy
in
2587 let position = (float state
.winh
-. sh) *. percent in
2590 if position +. sh > float state
.winh
2591 then float state
.winh
-. sh
2597 let coe s = (s :> uioh
);;
2599 class listview ~zebra ~helpmode ~
(source
:lvsource
) ~trusted ~modehash
=
2601 val m_pan
= source#getpan
2602 val m_first
= source#getfirst
2603 val m_active
= source#getactive
2605 val m_prev_uioh
= state
.uioh
2607 method private elemunder
y =
2611 let n = y / (fstate
.fontsize
+1) in
2612 if m_first
+ n < source#getitemcount
2614 if source#hasaction
(m_first
+ n)
2615 then Some
(m_first
+ n)
2622 GlFunc.blend_func ~src
:`src_alpha ~dst
:`one_minus_src_alpha
;
2623 GlDraw.color
(0., 0., 0.) ~alpha
:0.85;
2624 filledrect 0. 0. (float state
.winw
) (float state
.winh
);
2625 GlDraw.color
(1., 1., 1.);
2626 Gl.enable `texture_2d
;
2627 let fs = fstate
.fontsize
in
2629 let hw = (wadjsb () + xadjsb () + state
.winw
)/3 in
2630 let ww = fstate
.wwidth
in
2631 let tabw = 17.0*.ww in
2632 let itemcount = source#getitemcount
in
2633 let minfo = source#getminfo
in
2636 then float (xadjsb ()), float (state
.winw
- 1)
2637 else 0.0, float (state
.winw
- conf
.scrollbw
- 1)
2639 let xadj = xadjsb () in
2641 if (row - m_first
) > fstate
.maxrows
2644 if row >= 0 && row < itemcount
2646 let (s, level
) = source#getitem
row in
2647 let y = (row - m_first
) * nfs in
2649 (if conf
.leftscroll
then float xadj else 5.0)
2650 +. (float (level
+ m_pan
)) *. ww in
2653 (let c = if row land 1 = 0 then 1.0 else 0.92 in (c,c,c));
2657 Gl.disable `texture_2d
;
2658 let alpha = if source#hasaction
row then 0.9 else 0.3 in
2659 GlDraw.color
(1., 1., 1.) ~
alpha;
2660 linerect (x0 +. 1.) (float (y + 1)) (x1) (float (y + fs + 3));
2661 Gl.enable `texture_2d
;
2664 if zebra
&& row land 1 = 1
2668 GlDraw.color
(c,c,c);
2669 let drawtabularstring s =
2671 let x'
= truncate
(x0 +. x) in
2672 let pos = nindex
s '
\000'
in
2674 then drawstring1 fs x'
(y+nfs) s
2676 let s1 = String.sub
s 0 pos
2677 and s2
= String.sub
s (pos+1) (String.length
s - pos - 1) in
2682 let s'
= withoutlastutf8
s in
2683 let s = s' ^
"@Uellipsis" in
2684 let w = measurestr
fs s in
2685 if float x'
+. w +. ww < float (hw + x'
)
2690 if float x'
+. ww +. measurestr
fs s1 > float (hw + x'
)
2694 ignore
(drawstring1 fs x'
(y+nfs) s1);
2695 drawstring1 fs (hw + x'
) (y+nfs) s2
2699 let x = if helpmode
&& row > 0 then x +. ww else x in
2700 let tabpos = nindex
s '
\t'
in
2703 let len = String.length
s - tabpos - 1 in
2704 let s1 = String.sub
s 0 tabpos
2705 and s2
= String.sub
s (tabpos + 1) len in
2706 let nx = drawstr x s1 in
2708 let x = x +. (max
tabw sw) in
2711 let len = String.length
s - 2 in
2712 if len > 0 && s.[0] = '
\xc2'
&& s.[1] = '
\xb7'
2714 let s = String.sub
s 2 len in
2715 let x = if not helpmode
then x +. ww else x in
2716 GlDraw.color
(1.2, 1.2, 1.2);
2717 let vinc = drawstring1 (fs+fs/4)
2718 (truncate
(x -. ww)) (y+nfs) s in
2719 GlDraw.color
(1., 1., 1.);
2720 vinc +. (float fs *. 0.8)
2726 ignore
(drawtabularstring s);
2732 GlDraw.color
(1.0, 1.0, 1.0) ~
alpha:0.5;
2733 let xadj = float (xadjsb () + 5) in
2735 if (row - m_first
) > fstate
.maxrows
2738 if row >= 0 && row < itemcount
2740 let (s, level
) = source#getitem
row in
2741 let pos0 = nindex
s '
\000'
in
2742 let y = (row - m_first
) * nfs in
2743 let x = float (level
+ m_pan
) *. ww in
2744 let (first
, last
) = minfo.(row) in
2746 if pos0 > 0 && first
> pos0
2747 then String.sub
s (pos0+1) (first
-pos0-1)
2748 else String.sub
s 0 first
2750 let suffix = String.sub
s first
(last
- first
) in
2751 let w1 = measurestr fstate
.fontsize
prefix in
2752 let w2 = measurestr fstate
.fontsize
suffix in
2753 let x = x +. if conf
.leftscroll
then xadj else 5.0 in
2754 let x = if pos0 > 0 && first
> pos0 then x +. float hw else x in
2756 and y0 = float (y+2) in
2758 and y1 = float (y+fs+3) in
2759 filledrect x0 y0 x1 y1;
2764 Gl.disable `texture_2d
;
2765 if Array.length
minfo > 0 then loop m_first
;
2768 method updownlevel incr
=
2769 let len = source#getitemcount
in
2771 if m_active
>= 0 && m_active
< len
2772 then snd
(source#getitem m_active
)
2776 if i
= len then i
-1 else if i
= -1 then 0 else
2777 let _, l = source#getitem i
in
2778 if l != curlevel then i
else flow (i
+incr
)
2780 let active = flow m_active
in
2781 let first = calcfirst m_first
active in
2782 G.postRedisplay "outline updownlevel";
2783 {< m_active
= active; m_first
= first >}
2785 method private key1
key mask
=
2786 let set1 active first qsearch
=
2787 coe {< m_active
= active; m_first
= first; m_qsearch
= qsearch
>}
2789 let search active pattern incr
=
2790 let active = if active = -1 then m_first
else active in
2793 if n >= 0 && n < source#getitemcount
2795 let s, _ = source#getitem
n in
2797 (try ignore
(Str.search_forward re
s 0); true
2798 with Not_found
-> false)
2800 else loop (n + incr
)
2807 let re = Str.regexp_case_fold pattern
in
2813 let itemcount = source#getitemcount
in
2814 let find start incr
=
2816 if i
= -1 || i
= itemcount
2819 if source#hasaction i
2821 else find (i
+ incr
)
2826 let set active first =
2827 let first = bound
first 0 (itemcount - fstate
.maxrows
) in
2829 coe {< m_active
= active; m_first
= first; m_qsearch
= E.s >}
2832 let isvisible first n = n >= first && n - first <= fstate
.maxrows
in
2834 let incr1 = if incr
> 0 then 1 else -1 in
2835 if isvisible m_first m_active
2838 let next = m_active
+ incr
in
2840 if next < 0 || next >= itemcount
2842 else find next incr1
2844 if abs
(m_active
- next) > fstate
.maxrows
2850 let first = m_first
+ incr
in
2851 let first = bound
first 0 (itemcount - fstate
.maxrows
) in
2853 let next = m_active
+ incr
in
2854 let next = bound
next 0 (itemcount - 1) in
2861 if isvisible first next
2868 let first = min
next m_first
in
2870 if abs
(next - first) > fstate
.maxrows
2876 let first = m_first
+ incr
in
2877 let first = bound
first 0 (itemcount - 1) in
2879 let next = m_active
+ incr
in
2880 let next = bound
next 0 (itemcount - 1) in
2881 let next = find next incr1 in
2883 if next = -1 || abs
(m_active
- first) > fstate
.maxrows
2885 let active = if m_active
= -1 then next else m_active
in
2890 if isvisible first active
2896 G.postRedisplay "listview navigate";
2900 | (@r
|@s) when Wsi.withctrl mask
->
2901 let incr = if key = @r
then -1 else 1 in
2903 match search (m_active
+ incr) m_qsearch
incr with
2905 state
.text <- m_qsearch ^
" [not found]";
2908 state
.text <- m_qsearch
;
2909 active, firstof m_first
active
2911 G.postRedisplay "listview ctrl-r/s";
2912 set1 active first m_qsearch
;
2914 | @insert
when Wsi.withctrl mask
->
2915 if m_active
>= 0 && m_active
< source#getitemcount
2917 let s, _ = source#getitem m_active
in
2923 if emptystr m_qsearch
2926 let qsearch = withoutlastutf8 m_qsearch
in
2930 G.postRedisplay "listview empty qsearch";
2931 set1 m_active m_first
E.s;
2935 match search m_active
qsearch ~
-1 with
2937 state
.text <- qsearch ^
" [not found]";
2940 state
.text <- qsearch;
2941 active, firstof m_first
active
2943 G.postRedisplay "listview backspace qsearch";
2944 set1 active first qsearch
2947 | key when (key != 0 && key land 0xff00 != 0xff00) ->
2948 let pattern = m_qsearch ^ toutf8
key in
2950 match search m_active
pattern 1 with
2952 state
.text <- pattern ^
" [not found]";
2955 state
.text <- pattern;
2956 active, firstof m_first
active
2958 G.postRedisplay "listview qsearch add";
2959 set1 active first pattern;
2963 if emptystr m_qsearch
2965 G.postRedisplay "list view escape";
2966 let mx, my
= state
.mpos
in
2970 source#exit ~uioh
:(coe self
)
2971 ~cancel
:true ~
active:m_active ~
first:m_first ~pan
:m_pan
2973 | None
-> m_prev_uioh
2978 G.postRedisplay "list view kill qsearch";
2979 coe {< m_qsearch
= E.s >}
2982 | @enter
| @kpenter
->
2984 let self = {< m_qsearch
= E.s >} in
2986 G.postRedisplay "listview enter";
2987 if m_active
>= 0 && m_active
< source#getitemcount
2989 source#exit ~uioh
:(coe self) ~cancel
:false
2990 ~
active:m_active ~
first:m_first ~pan
:m_pan
;
2993 source#exit ~uioh
:(coe self) ~cancel
:true
2994 ~
active:m_active ~
first:m_first ~pan
:m_pan
;
2997 begin match opt with
2998 | None
-> m_prev_uioh
3002 | @delete
| @kpdelete
->
3005 | @up
| @kpup
-> navigate ~
-1
3006 | @down
| @kpdown
-> navigate 1
3007 | @prior
| @kpprior
-> navigate ~
-(fstate
.maxrows
)
3008 | @next | @kpnext
-> navigate fstate
.maxrows
3010 | @right
| @kpright
->
3012 G.postRedisplay "listview right";
3013 coe {< m_pan
= m_pan
- 1 >}
3015 | @left | @kpleft
->
3017 G.postRedisplay "listview left";
3018 coe {< m_pan
= m_pan
+ 1 >}
3020 | @home
| @kphome
->
3021 let active = find 0 1 in
3022 G.postRedisplay "listview home";
3026 let first = max
0 (itemcount - fstate
.maxrows
) in
3027 let active = find (itemcount - 1) ~
-1 in
3028 G.postRedisplay "listview end";
3031 | key when (key = 0 || key land 0xff00 = 0xff00) ->
3035 dolog
"listview unknown key %#x" key; coe self
3037 method key key mask
=
3038 match state
.mode
with
3039 | Textentry te
-> textentrykeyboard key mask te
; coe self
3042 | LinkNav
_ -> self#key1
key mask
3044 method button button down
x y _ =
3047 | 1 when x > state
.winw
- conf
.scrollbw
->
3048 G.postRedisplay "listview scroll";
3051 let _, position, sh = self#
scrollph in
3052 if y > truncate
position && y < truncate
(position +. sh)
3054 state
.mstate
<- Mscrolly
;
3058 let s = float (max
0 (y - conf
.scrollh
)) /. float state
.winh
in
3059 let first = truncate
(s *. float source#getitemcount
) in
3060 let first = min source#getitemcount
first in
3061 Some
(coe {< m_first
= first; m_active
= first >})
3063 state
.mstate
<- Mnone
;
3067 begin match self#elemunder
y with
3069 G.postRedisplay "listview click";
3070 source#exit ~uioh
:(coe {< m_active
= n >})
3071 ~cancel
:false ~
active:n ~
first:m_first ~pan
:m_pan
3075 | n when (n == 4 || n == 5) && not down
->
3076 let len = source#getitemcount
in
3078 if n = 5 && m_first
+ fstate
.maxrows
>= len
3082 let first = m_first
+ (if n == 4 then -1 else 1) in
3083 bound
first 0 (len - 1)
3085 G.postRedisplay "listview wheel";
3086 Some
(coe {< m_first
= first >})
3087 | n when (n = 6 || n = 7) && not down
->
3088 let inc = if n = 7 then -1 else 1 in
3089 G.postRedisplay "listview hwheel";
3090 Some
(coe {< m_pan
= m_pan
+ inc >})
3095 | None
-> m_prev_uioh
3098 method multiclick
_ x y = self#button
1 true x y
3101 match state
.mstate
with
3103 let s = float (max
0 (y - conf
.scrollh
)) /. float state
.winh
in
3104 let first = truncate
(s *. float source#getitemcount
) in
3105 let first = min source#getitemcount
first in
3106 G.postRedisplay "listview motion";
3107 coe {< m_first
= first; m_active
= first >}
3115 method pmotion
x y =
3116 if x < state
.winw
- conf
.scrollbw
3119 match self#elemunder
y with
3120 | None
-> Wsi.setcursor
Wsi.CURSOR_INHERIT
; m_active
3121 | Some
n -> Wsi.setcursor
Wsi.CURSOR_INFO
; n
3125 then (G.postRedisplay "listview pmotion"; {< m_active
= n >})
3130 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
3134 method infochanged
_ = ()
3136 method scrollpw
= (0, 0.0, 0.0)
3138 let nfs = fstate
.fontsize
+ 1 in
3139 let y = m_first
* nfs in
3140 let itemcount = source#getitemcount
in
3141 let maxi = max
0 (itemcount - fstate
.maxrows
) in
3142 let maxy = maxi * nfs in
3143 let p, h = scrollph y maxy in
3146 method modehash
= modehash
3147 method eformsgs
= false
3148 method alwaysscrolly
= true
3151 class outlinelistview ~zebra ~source
=
3152 let settext autonarrow
s =
3155 let ss = source#statestr
in
3159 else "{" ^
ss ^
"} [" ^
s ^
"]"
3160 else state
.text <- s
3166 ~source
:(source
:> lvsource
)
3168 ~modehash
:(findkeyhash conf
"outline")
3171 val m_autonarrow
= false
3173 method! key key mask
=
3175 if emptystr state
.text
3177 else fstate
.maxrows - 2
3179 let calcfirst first active =
3182 let rows = active - first in
3183 if rows > maxrows then active - maxrows else first
3187 let active = m_active
+ incr in
3188 let active = bound
active 0 (source#getitemcount
- 1) in
3189 let first = calcfirst m_first
active in
3190 G.postRedisplay "outline navigate";
3191 coe {< m_active
= active; m_first
= first >}
3193 let navscroll first =
3195 let dist = m_active
- first in
3201 else first + maxrows
3204 G.postRedisplay "outline navscroll";
3205 coe {< m_first
= first; m_active
= active >}
3207 let ctrl = Wsi.withctrl mask
in
3212 then (source#denarrow
; E.s)
3214 let pattern = source#renarrow
in
3215 if nonemptystr m_qsearch
3216 then (source#narrow m_qsearch
; m_qsearch
)
3220 settext (not m_autonarrow
) text;
3221 G.postRedisplay "toggle auto narrowing";
3222 coe {< m_first
= 0; m_active
= 0; m_autonarrow
= not m_autonarrow
>}
3224 | @slash
when emptystr m_qsearch
&& not m_autonarrow
->
3226 G.postRedisplay "toggle auto narrowing";
3227 coe {< m_first
= 0; m_active
= 0; m_autonarrow
= true >}
3230 source#narrow m_qsearch
;
3232 then source#add_narrow_pattern m_qsearch
;
3233 G.postRedisplay "outline ctrl-n";
3234 coe {< m_first
= 0; m_active
= 0 >}
3237 let active = source#calcactive
(getanchor
()) in
3238 let first = firstof m_first
active in
3239 G.postRedisplay "outline ctrl-s";
3240 coe {< m_first
= first; m_active
= active >}
3243 G.postRedisplay "outline ctrl-u";
3244 if m_autonarrow
&& nonemptystr m_qsearch
3246 ignore
(source#renarrow
);
3247 settext m_autonarrow
E.s;
3248 coe {< m_first
= 0; m_active
= 0; m_qsearch
= E.s >}
3251 source#del_narrow_pattern
;
3252 let pattern = source#renarrow
in
3254 if emptystr
pattern then E.s else "Narrowed to " ^
pattern
3256 settext m_autonarrow
text;
3257 coe {< m_first
= 0; m_active
= 0; m_qsearch
= E.s >}
3261 let first = max
0 (m_active
- (fstate
.maxrows / 2)) in
3262 G.postRedisplay "outline ctrl-l";
3263 coe {< m_first
= first >}
3265 | @tab
when m_autonarrow
->
3266 if nonemptystr m_qsearch
3268 G.postRedisplay "outline list view tab";
3269 source#add_narrow_pattern m_qsearch
;
3271 coe {< m_qsearch
= E.s >}
3275 | @escape
when m_autonarrow
->
3276 if nonemptystr m_qsearch
3277 then source#add_narrow_pattern m_qsearch
;
3280 | @enter
| @kpenter
when m_autonarrow
->
3281 if nonemptystr m_qsearch
3282 then source#add_narrow_pattern m_qsearch
;
3285 | key when m_autonarrow
&& (key != 0 && key land 0xff00 != 0xff00) ->
3286 let pattern = m_qsearch ^ toutf8
key in
3287 G.postRedisplay "outlinelistview autonarrow add";
3288 source#narrow
pattern;
3289 settext true pattern;
3290 coe {< m_first
= 0; m_active
= 0; m_qsearch
= pattern >}
3292 | key when m_autonarrow
&& key = @backspace
->
3293 if emptystr m_qsearch
3296 let pattern = withoutlastutf8 m_qsearch
in
3297 G.postRedisplay "outlinelistview autonarrow backspace";
3298 ignore
(source#renarrow
);
3299 source#narrow
pattern;
3300 settext true pattern;
3301 coe {< m_first
= 0; m_active
= 0; m_qsearch
= pattern >}
3303 | @delete
| @kpdelete
->
3304 source#remove m_active
;
3305 G.postRedisplay "outline delete";
3306 let active = max
0 (m_active
-1) in
3307 coe {< m_first
= firstof m_first
active;
3308 m_active
= active >}
3310 | @up
| @kpup
when ctrl ->
3311 navscroll (max
0 (m_first
- 1))
3313 | @down
| @kpdown
when ctrl ->
3314 navscroll (min
(source#getitemcount
- 1) (m_first
+ 1))
3316 | @up
| @kpup
-> navigate ~
-1
3317 | @down
| @kpdown
-> navigate 1
3318 | @prior
| @kpprior
-> navigate ~
-(fstate
.maxrows)
3319 | @next | @kpnext
-> navigate fstate
.maxrows
3321 | @right
| @kpright
->
3325 G.postRedisplay "outline ctrl right";
3326 {< m_pan
= m_pan
+ 1 >}
3328 else self#updownlevel
1
3332 | @left | @kpleft
->
3336 G.postRedisplay "outline ctrl left";
3337 {< m_pan
= m_pan
- 1 >}
3339 else self#updownlevel ~
-1
3343 | @home
| @kphome
->
3344 G.postRedisplay "outline home";
3345 coe {< m_first
= 0; m_active
= 0 >}
3348 let active = source#getitemcount
- 1 in
3349 let first = max
0 (active - fstate
.maxrows) in
3350 G.postRedisplay "outline end";
3351 coe {< m_active
= active; m_first
= first >}
3353 | _ -> super#
key key mask
3356 let genhistoutlines =
3357 let order ty
(p1
, c1
, _, _, _, _) (p2
, c2
, _, _, _, _) =
3359 | `lastvisit
-> compare c1
.lastvisit c2
.lastvisit
3360 | `path
-> compare p2 p1
3361 | `file
-> compare
(Filename.basename p2
) (Filename.basename p1
)
3363 let e1 = emptystr c1
.title
3364 and e2
= emptystr c2
.title
in
3366 then compare
(Filename.basename p2
) (Filename.basename p1
)
3369 else compare c1
.title c2
.title
3371 let showfullpath = ref false in
3372 let showorigin = ref true in
3373 let orderty : historder
ref = ref `lastvisit
in
3376 let s = if !orderty = t
then "[@Uradical] " ^
s else "[ ] " ^
s in
3377 s, 0, Oreaction
(fun () -> orderty := t
; f ())
3379 match Config.gethist
() with
3384 (fun accu (path
, c, b, x, a, o) ->
3385 let hist = (path
, (c, b, x, a, o)) in
3387 let s = if nonemptystr
o && !showorigin then o else path
in
3388 if !showfullpath then s else Filename.basename
s
3390 let base = mbtoutf8
s in
3391 (base ^
"\000" ^
c.title
, 1, Ohistory
hist) :: accu
3393 [ setorty "Sort by time of last visit" `lastvisit
;
3394 setorty "Sort by file name" `file
;
3395 setorty "Sort by path" `path
;
3396 setorty "Sort by title" `title
;
3397 (if !showfullpath then "@Uradical "
3398 else " ") ^
"Show full path", 0, Oreaction
(fun () ->
3399 showfullpath := not
!showfullpath;
3401 (if !showorigin then "@Uradical "
3402 else " ") ^
"Show origin", 0, Oreaction
(fun () ->
3403 showorigin := not
!showorigin;
3405 ] (List.sort
(order !orderty) list
)
3411 let gotohist (path
, (c, bookmarks
, x, anchor, origin
)) =
3412 Config.save
leavebirdseye;
3413 state
.anchor <- anchor;
3414 state
.bookmarks
<- bookmarks
;
3415 state
.origin
<- origin
;
3418 let x0, y0, x1, y1 = conf
.trimfuzz
in
3419 wcmd "trimset %d %d %d %d %d" (btod conf
.trimmargins
) x0 y0 x1 y1;
3420 reshape ~firsttime
:true state
.winw state
.winh
;
3421 opendoc path origin
;
3425 let makecheckers () =
3426 (* Based on lablGL-1.04/LablGlut/examples/lablGL/checker.ml which had
3428 converted by Issac Trotts. July 25, 2002 *)
3429 let image = GlPix.create `ubyte ~format
:`luminance ~width
:2 ~height
:2 in
3430 Raw.sets_string
(GlPix.to_raw
image) ~
pos:0 "\255\200\200\255";
3431 let id = GlTex.gen_texture
() in
3432 GlTex.bind_texture ~target
:`texture_2d
id;
3433 GlPix.store
(`unpack_alignment
1);
3434 GlTex.image2d
image;
3435 List.iter
(GlTex.parameter ~target
:`texture_2d
)
3436 [ `mag_filter `nearest
; `min_filter `nearest
];
3440 let setcheckers enabled
=
3441 match state
.checkerstexid
with
3443 if enabled
then state
.checkerstexid
<- Some
(makecheckers ())
3445 | Some checkerstexid
->
3448 GlTex.delete_texture checkerstexid
;
3449 state
.checkerstexid
<- None
;
3453 let describe_location () =
3454 let fn = page_of_y state
.y in
3455 let ln = page_of_y
(state
.y + state
.winh
- hscrollh () - 1) in
3456 let maxy = state
.maxy - (if conf
.maxhfit
then state
.winh
else 0) in
3460 else (100. *. (float state
.y /. float maxy))
3464 Printf.sprintf
"page %d of %d [%.2f%%]"
3465 (fn+1) state
.pagecount
percent
3468 "pages %d-%d of %d [%.2f%%]"
3469 (fn+1) (ln+1) state
.pagecount
percent
3472 let setpresentationmode v
=
3473 let n = page_of_y state
.y in
3474 state
.anchor <- (n, 0.0, 1.0);
3475 conf
.presentation
<- v
;
3476 if conf
.fitmodel
= FitPage
3477 then reqlayout conf
.angle conf
.fitmodel
;
3482 let btos b = if b then "@Uradical" else E.s in
3483 let showextended = ref false in
3484 let leave mode
_ = state
.mode
<- mode
in
3487 val mutable m_first_time
= true
3488 val mutable m_l
= []
3489 val mutable m_a
= E.a
3490 val mutable m_prev_uioh
= nouioh
3491 val mutable m_prev_mode
= View
3493 inherit lvsourcebase
3495 method reset prev_mode prev_uioh
=
3496 m_a
<- Array.of_list
(List.rev m_l
);
3498 m_prev_mode
<- prev_mode
;
3499 m_prev_uioh
<- prev_uioh
;
3503 if n >= Array.length m_a
3507 | _, _, _, Action
_ -> m_active
<- n
3508 | _, _, _, Noaction
-> loop (n+1)
3511 m_first_time
<- false;
3514 method int name get
set =
3516 (name
, `
int get
, 1, Action
(
3519 try set (int_of_string
s)
3521 state
.text <- Printf.sprintf
"bad integer `%s': %s"
3525 let te = name ^
": ", E.s, None
, intentry, ondone, true in
3526 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3530 method int_with_suffix name get
set =
3532 (name
, `intws get
, 1, Action
(
3535 try set (int_of_string_with_suffix
s)
3537 state
.text <- Printf.sprintf
"bad integer `%s': %s"
3542 name ^
": ", E.s, None
, intentry_with_suffix, ondone, true
3544 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3548 method bool ?
(offset
=1) ?
(btos=btos) name get
set =
3550 (name
, `
bool (btos, get
), offset
, Action
(
3557 method color name get
set =
3559 (name
, `color get
, 1, Action
(
3561 let invalid = (nan
, nan
, nan
) in
3564 try color_of_string
s
3566 state
.text <- Printf.sprintf
"bad color `%s': %s"
3573 let te = name ^
": ", E.s, None
, textentry, ondone, true in
3574 state
.text <- color_to_string
(get
());
3575 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3579 method string name get
set =
3581 (name
, `
string get
, 1, Action
(
3583 let ondone s = set s in
3584 let te = name ^
": ", E.s, None
, textentry, ondone, true in
3585 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3589 method colorspace name get
set =
3591 (name
, `
string get
, 1, Action
(
3595 inherit lvsourcebase
3598 m_active
<- CSTE.to_int conf
.colorspace
;
3601 method getitemcount
=
3602 Array.length
CSTE.names
3605 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3606 ignore
(uioh
, first, pan
);
3607 if not cancel
then set active;
3609 method hasaction
_ = true
3613 let modehash = findkeyhash conf
"info" in
3614 coe (new listview ~zebra
:false ~helpmode
:false
3615 ~
source ~trusted
:true ~
modehash)
3618 method paxmark name get
set =
3620 (name
, `
string get
, 1, Action
(
3624 inherit lvsourcebase
3627 m_active
<- MTE.to_int conf
.paxmark
;
3630 method getitemcount
= Array.length
MTE.names
3631 method getitem
n = (MTE.names
.(n), 0)
3632 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3633 ignore
(uioh
, first, pan
);
3634 if not cancel
then set active;
3636 method hasaction
_ = true
3640 let modehash = findkeyhash conf
"info" in
3641 coe (new listview ~zebra
:false ~helpmode
:false
3642 ~
source ~trusted
:true ~
modehash)
3645 method fitmodel name get
set =
3647 (name
, `
string get
, 1, Action
(
3651 inherit lvsourcebase
3654 m_active
<- FMTE.to_int conf
.fitmodel
;
3657 method getitemcount
= Array.length
FMTE.names
3658 method getitem
n = (FMTE.names
.(n), 0)
3659 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3660 ignore
(uioh
, first, pan
);
3661 if not cancel
then set active;
3663 method hasaction
_ = true
3667 let modehash = findkeyhash conf
"info" in
3668 coe (new listview ~zebra
:false ~helpmode
:false
3669 ~
source ~trusted
:true ~
modehash)
3672 method caption
s offset
=
3673 m_l
<- (s, `empty
, offset
, Noaction
) :: m_l
3675 method caption2
s f offset
=
3676 m_l
<- (s, `
string f, offset
, Noaction
) :: m_l
3678 method getitemcount
= Array.length m_a
3681 let tostr = function
3682 | `
int f -> string_of_int
(f ())
3683 | `intws
f -> string_with_suffix_of_int
(f ())
3685 | `color
f -> color_to_string
(f ())
3686 | `
bool (btos, f) -> btos (f ())
3689 let name, t
, offset
, _ = m_a
.(n) in
3690 ((let s = tostr t
in
3692 then Printf.sprintf
"%s\t%s" name s
3696 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3701 match m_a
.(active) with
3702 | _, _, _, Action
f -> f uioh
3703 | _, _, _, Noaction
-> uioh
3714 method hasaction
n =
3716 | _, _, _, Action
_ -> true
3717 | _, _, _, Noaction
-> false
3720 let rec fillsrc prevmode prevuioh
=
3721 let sep () = src#caption
E.s 0 in
3722 let colorp name get
set =
3724 (fun () -> color_to_string
(get
()))
3727 let c = color_of_string
v in
3730 state
.text <- Printf.sprintf
"bad color `%s': %s" v (exntos exn
)
3733 let oldmode = state
.mode
in
3734 let birdseye = isbirdseye state
.mode
in
3736 src#caption
(if birdseye then "Setup (Bird's eye)" else "Setup") 0;
3738 src#
bool "presentation mode"
3739 (fun () -> conf
.presentation
)
3740 (fun v -> setpresentationmode v);
3742 src#
bool "ignore case in searches"
3743 (fun () -> conf
.icase
)
3744 (fun v -> conf
.icase
<- v);
3747 (fun () -> conf
.preload)
3748 (fun v -> conf
.preload <- v);
3750 src#
bool "highlight links"
3751 (fun () -> conf
.hlinks
)
3752 (fun v -> conf
.hlinks
<- v);
3754 src#
bool "under info"
3755 (fun () -> conf
.underinfo
)
3756 (fun v -> conf
.underinfo
<- v);
3758 src#
bool "persistent bookmarks"
3759 (fun () -> conf
.savebmarks
)
3760 (fun v -> conf
.savebmarks
<- v);
3762 src#fitmodel
"fit model"
3763 (fun () -> FMTE.to_string conf
.fitmodel
)
3764 (fun v -> reqlayout conf
.angle
(FMTE.of_int
v));
3766 src#
bool "trim margins"
3767 (fun () -> conf
.trimmargins
)
3768 (fun v -> settrim v conf
.trimfuzz
; fillsrc prevmode prevuioh
);
3770 src#
bool "persistent location"
3771 (fun () -> conf
.jumpback
)
3772 (fun v -> conf
.jumpback
<- v);
3775 src#
int "inter-page space"
3776 (fun () -> conf
.interpagespace
)
3778 conf
.interpagespace
<- n;
3779 docolumns conf
.columns
;
3781 match state
.layout with
3786 state
.maxy <- calcheight
();
3787 let y = getpagey
pageno in
3792 (fun () -> conf
.pagebias
)
3793 (fun v -> conf
.pagebias
<- v);
3795 src#
int "scroll step"
3796 (fun () -> conf
.scrollstep
)
3797 (fun n -> conf
.scrollstep
<- n);
3799 src#
int "horizontal scroll step"
3800 (fun () -> conf
.hscrollstep
)
3801 (fun v -> conf
.hscrollstep
<- v);
3803 src#
int "auto scroll step"
3805 match state
.autoscroll
with
3807 | _ -> conf
.autoscrollstep
)
3809 let n = boundastep state
.winh
n in
3810 if state
.autoscroll
<> None
3811 then state
.autoscroll
<- Some
n;
3812 conf
.autoscrollstep
<- n);
3815 (fun () -> truncate
(conf
.zoom *. 100.))
3816 (fun v -> setzoom ((float v) /. 100.));
3819 (fun () -> conf
.angle
)
3820 (fun v -> reqlayout v conf
.fitmodel
);
3822 src#
int "scroll bar width"
3823 (fun () -> conf
.scrollbw
)
3826 reshape state
.winw state
.winh
;
3829 src#
int "scroll handle height"
3830 (fun () -> conf
.scrollh
)
3831 (fun v -> conf
.scrollh
<- v;);
3833 src#
int "thumbnail width"
3834 (fun () -> conf
.thumbw
)
3836 conf
.thumbw
<- min
4096 v;
3839 leavebirdseye beye
false;
3846 let mode = state
.mode in
3847 src#
string "columns"
3849 match conf
.columns
with
3851 | Cmulti
(multi
, _) -> multicolumns_to_string multi
3852 | Csplit
(count
, _) -> "-" ^ string_of_int count
3855 let n, a, b = multicolumns_of_string
v in
3856 setcolumns mode n a b);
3859 src#caption
"Pixmap cache" 0;
3860 src#int_with_suffix
"size (advisory)"
3861 (fun () -> conf
.memlimit
)
3862 (fun v -> conf
.memlimit
<- v);
3865 (fun () -> Printf.sprintf
"%s bytes, %d tiles"
3866 (string_with_suffix_of_int state
.memused
)
3867 (Hashtbl.length state
.tilemap
)) 1;
3870 src#caption
"Layout" 0;
3871 src#caption2
"Dimension"
3873 Printf.sprintf
"%dx%d (virtual %dx%d)"
3874 state
.winw state
.winh
3879 src#caption2
"Position" (fun () ->
3880 Printf.sprintf
"%dx%d" state
.x state
.y
3883 src#caption2
"Position" (fun () -> describe_location ()) 1
3887 src#
bool ~offset
:0 ~
btos:(fun v -> if v then "(on)" else "(off)")
3888 "Save these parameters as global defaults at exit"
3889 (fun () -> conf
.bedefault
)
3890 (fun v -> conf
.bedefault
<- v)
3894 let btos b = if b then "@Ulguillemet" else "@Urguillemet" in
3895 src#
bool ~offset
:0 ~
btos "Extended parameters"
3896 (fun () -> !showextended)
3897 (fun v -> showextended := v; fillsrc prevmode prevuioh
);
3901 (fun () -> conf
.checkers
)
3902 (fun v -> conf
.checkers
<- v; setcheckers v);
3903 src#
bool "update cursor"
3904 (fun () -> conf
.updatecurs
)
3905 (fun v -> conf
.updatecurs
<- v);
3906 src#
bool "scroll-bar on the left"
3907 (fun () -> conf
.leftscroll
)
3908 (fun v -> conf
.leftscroll
<- v);
3910 (fun () -> conf
.verbose
)
3911 (fun v -> conf
.verbose
<- v);
3912 src#
bool "invert colors"
3913 (fun () -> conf
.invert
)
3914 (fun v -> conf
.invert
<- v);
3916 (fun () -> conf
.maxhfit
)
3917 (fun v -> conf
.maxhfit
<- v);
3918 src#
bool "redirect stderr"
3919 (fun () -> conf
.redirectstderr)
3920 (fun v -> conf
.redirectstderr <- v; redirectstderr ());
3922 (fun () -> conf
.pax
!= None
)
3925 then conf
.pax
<- Some
(ref (now
(), 0, 0))
3926 else conf
.pax
<- None
);
3927 src#
string "uri launcher"
3928 (fun () -> conf
.urilauncher
)
3929 (fun v -> conf
.urilauncher
<- v);
3930 src#
string "path launcher"
3931 (fun () -> conf
.pathlauncher
)
3932 (fun v -> conf
.pathlauncher
<- v);
3933 src#
string "tile size"
3934 (fun () -> Printf.sprintf
"%dx%d" conf
.tilew conf
.tileh
)
3937 let w, h = Scanf.sscanf
v "%dx%d" (fun w h -> w, h) in
3938 conf
.tilew
<- max
64 w;
3939 conf
.tileh
<- max
64 h;
3942 state
.text <- Printf.sprintf
"bad tile size `%s': %s"
3945 src#
int "texture count"
3946 (fun () -> conf
.texcount
)
3949 then conf
.texcount
<- v
3950 else showtext '
!'
" Failed to set texture count please retry later"
3952 src#
int "slice height"
3953 (fun () -> conf
.sliceheight
)
3955 conf
.sliceheight
<- v;
3956 wcmd "sliceh %d" conf
.sliceheight
;
3958 src#
int "anti-aliasing level"
3959 (fun () -> conf
.aalevel
)
3961 conf
.aalevel
<- bound
v 0 8;
3962 state
.anchor <- getanchor
();
3963 opendoc state
.path state
.password;
3965 src#
string "page scroll scaling factor"
3966 (fun () -> string_of_float conf
.pgscale)
3969 let s = float_of_string
v in
3972 state
.text <- Printf.sprintf
3973 "bad page scroll scaling factor `%s': %s" v (exntos exn
)
3976 src#
int "ui font size"
3977 (fun () -> fstate
.fontsize
)
3978 (fun v -> setfontsize (bound
v 5 100));
3979 src#
int "hint font size"
3980 (fun () -> conf
.hfsize
)
3981 (fun v -> conf
.hfsize
<- bound
v 5 100);
3982 colorp "background color"
3983 (fun () -> conf
.bgcolor
)
3984 (fun v -> conf
.bgcolor
<- v);
3985 src#
bool "crop hack"
3986 (fun () -> conf
.crophack
)
3987 (fun v -> conf
.crophack
<- v);
3988 src#
string "trim fuzz"
3989 (fun () -> irect_to_string conf
.trimfuzz
)
3992 conf
.trimfuzz
<- irect_of_string
v;
3994 then settrim true conf
.trimfuzz
;
3996 state
.text <- Printf.sprintf
"bad irect `%s': %s" v (exntos exn
)
3998 src#
string "throttle"
4000 match conf
.maxwait
with
4001 | None
-> "show place holder if page is not ready"
4004 then "wait for page to fully render"
4006 "wait " ^ string_of_float
time
4007 ^
" seconds before showing placeholder"
4011 let f = float_of_string
v in
4013 then conf
.maxwait
<- None
4014 else conf
.maxwait
<- Some
f
4016 state
.text <- Printf.sprintf
"bad time `%s': %s" v (exntos exn
)
4018 src#
string "ghyll scroll"
4020 match conf
.ghyllscroll
with
4022 | Some nab
-> ghyllscroll_to_string nab
4025 try conf
.ghyllscroll
<- ghyllscroll_of_string
v
4027 state
.text <- Printf.sprintf
"bad ghyll `%s': %s" v (exntos exn
)
4029 src#
string "selection command"
4030 (fun () -> conf
.selcmd
)
4031 (fun v -> conf
.selcmd
<- v);
4032 src#
string "synctex command"
4033 (fun () -> conf
.stcmd
)
4034 (fun v -> conf
.stcmd
<- v);
4035 src#
string "pax command"
4036 (fun () -> conf
.paxcmd
)
4037 (fun v -> conf
.paxcmd
<- v);
4038 src#
string "ask password command"
4039 (fun () -> conf
.passcmd)
4040 (fun v -> conf
.passcmd <- v);
4041 src#
string "save path command"
4042 (fun () -> conf
.savecmd
)
4043 (fun v -> conf
.savecmd
<- v);
4044 src#colorspace
"color space"
4045 (fun () -> CSTE.to_string conf
.colorspace
)
4047 conf
.colorspace
<- CSTE.of_int
v;
4051 src#paxmark
"pax mark method"
4052 (fun () -> MTE.to_string conf
.paxmark
)
4053 (fun v -> conf
.paxmark
<- MTE.of_int
v);
4057 (fun () -> conf
.usepbo
)
4058 (fun v -> conf
.usepbo
<- v);
4059 src#
bool "mouse wheel scrolls pages"
4060 (fun () -> conf
.wheelbypage
)
4061 (fun v -> conf
.wheelbypage
<- v);
4062 src#
bool "open remote links in a new instance"
4063 (fun () -> conf
.riani
)
4064 (fun v -> conf
.riani
<- v);
4065 src#
bool "edit annotations inline"
4066 (fun () -> conf
.annotinline
)
4067 (fun v -> conf
.annotinline
<- v);
4071 src#caption
"Document" 0;
4072 List.iter
(fun (_, s) -> src#caption
s 1) state
.docinfo
;
4073 src#caption2
"Pages"
4074 (fun () -> string_of_int state
.pagecount
) 1;
4075 src#caption2
"Dimensions"
4076 (fun () -> string_of_int
(List.length state
.pdims
)) 1;
4080 src#caption
"Trimmed margins" 0;
4081 src#caption2
"Dimensions"
4082 (fun () -> string_of_int
(List.length state
.pdims
)) 1;
4086 src#caption
"OpenGL" 0;
4087 src#caption
(Printf.sprintf
"Vendor\t%s" (GlMisc.get_string `vendor
)) 1;
4088 src#caption
(Printf.sprintf
"Renderer\t%s" (GlMisc.get_string `renderer
)) 1;
4091 src#caption
"Location" 0;
4092 if nonemptystr state
.origin
4093 then src#caption
("Orign\t" ^ mbtoutf8 state
.origin
) 1;
4094 src#caption
("Path\t" ^ mbtoutf8 state
.path
) 1;
4096 src#reset prevmode prevuioh
;
4101 let prevmode = state
.mode
4102 and prevuioh
= state
.uioh in
4103 fillsrc prevmode prevuioh
;
4104 let source = (src :> lvsource
) in
4105 let modehash = findkeyhash conf
"info" in
4106 state
.uioh <- coe (object (self)
4107 inherit listview ~zebra
:false ~helpmode
:false
4108 ~
source ~trusted
:true ~
modehash as super
4109 val mutable m_prevmemused
= 0
4110 method! infochanged
= function
4112 if m_prevmemused
!= state
.memused
4114 m_prevmemused
<- state
.memused
;
4115 G.postRedisplay "memusedchanged";
4117 | Pdim
-> G.postRedisplay "pdimchanged"
4118 | Docinfo
-> fillsrc prevmode prevuioh
4120 method! key key mask
=
4121 if not
(Wsi.withctrl mask
)
4124 | @left | @kpleft
-> coe (self#updownlevel ~
-1)
4125 | @right
| @kpright
-> coe (self#updownlevel
1)
4126 | _ -> super#
key key mask
4127 else super#
key key mask
4129 G.postRedisplay "info";
4135 inherit lvsourcebase
4136 method getitemcount
= Array.length state
.help
4138 let s, l, _ = state
.help
.(n) in
4141 method exit ~
uioh ~cancel ~
active ~
first ~pan
=
4145 match state
.help
.(active) with
4146 | _, _, Action
f -> Some
(f uioh)
4147 | _, _, Noaction
-> Some
uioh
4156 method hasaction
n =
4157 match state
.help
.(n) with
4158 | _, _, Action
_ -> true
4159 | _, _, Noaction
-> false
4165 let modehash = findkeyhash conf
"help" in
4167 state
.uioh <- coe (new listview
4168 ~zebra
:false ~helpmode
:true
4169 ~
source ~trusted
:true ~
modehash);
4170 G.postRedisplay "help";
4176 inherit lvsourcebase
4177 val mutable m_items
= E.a
4179 method getitemcount
= 1 + Array.length m_items
4184 else m_items
.(n-1), 0
4186 method exit ~
uioh ~cancel ~
active ~
first ~pan
=
4191 then Buffer.clear state
.errmsgs
;
4198 method hasaction
n =
4202 state
.newerrmsgs
<- false;
4203 let l = Str.split newlinere
(Buffer.contents state
.errmsgs
) in
4204 m_items
<- Array.of_list
l
4213 let source = (msgsource :> lvsource
) in
4214 let modehash = findkeyhash conf
"listview" in
4215 state
.uioh <- coe (object
4216 inherit listview ~zebra
:false ~helpmode
:false
4217 ~
source ~trusted
:false ~
modehash as super
4220 then msgsource#reset
;
4223 G.postRedisplay "msgs";
4227 let editor = getenvwithdef
"EDITOR" E.s in
4231 let tmppath = Filename.temp_file
"llpp" "note" in
4234 let oc = open_out
tmppath in
4238 let execstr = editor ^
" " ^
tmppath in
4240 match popen
execstr [] with
4241 | (exception exn
) ->
4243 Printf.sprintf
"popen(%S) failed: %s" execstr (exntos exn
);
4246 match Unix.waitpid
[] pid with
4247 | (exception exn
) ->
4249 Printf.sprintf
"waitpid(%d) failed: %s" pid (exntos exn
);
4253 | Unix.WEXITED
0 -> filelines
tmppath
4256 Printf.sprintf
"editor process(%s) exited abnormally: %d"
4259 | Unix.WSIGNALED
n ->
4261 Printf.sprintf
"editor process(%s) was killed by signal %d"
4264 | Unix.WSTOPPED
n ->
4266 Printf.sprintf
"editor(%s) process was stopped by signal %d"
4270 match Unix.unlink
tmppath with
4271 | (exception exn
) ->
4272 showtext '
!'
@@ Printf.sprintf
"failed to ulink %S: %s"
4273 tmppath (exntos exn
);
4278 let enterannotmode opaque slinkindex
=
4281 inherit lvsourcebase
4282 val mutable m_text
= E.s
4283 val mutable m_items
= E.a
4285 method getitemcount
= Array.length m_items
4288 let label, _func
= m_items
.(n) in
4291 method exit ~
uioh ~cancel ~
active ~
first ~pan
=
4292 ignore
(uioh, first, pan
);
4295 let _label, func
= m_items
.(active) in
4300 method hasaction
n = nonemptystr
@@ fst m_items
.(n)
4303 let rec split accu b i
=
4305 if p = String.length
s
4306 then (String.sub
s b (p-b), unit) :: accu
4308 if (i
> 70 && s.[p] = ' '
) || s.[p] = '
\r'
|| s.[p] = '
\n'
4310 let ss = if i
= 0 then E.s else String.sub
s b i
in
4311 split ((ss, unit)::accu) (p+1) 0
4316 wcmd "freepage %s" (~
> opaque);
4318 Hashtbl.fold (fun key opaque'
accu ->
4319 if opaque'
= opaque'
4320 then key :: accu else accu) state
.pagemap
[]
4322 List.iter
(Hashtbl.remove state
.pagemap
) keys;
4327 delannot
opaque slinkindex
;
4330 let edit inline
() =
4335 modannot
opaque slinkindex
s;
4341 let mode = state
.mode in
4344 ("annotation: ", m_text
, None
, textentry, update, true),
4345 fun _ -> state
.mode <- mode);
4349 let s = getusertext m_text
in
4354 ( "[Copy]", fun () -> selstring m_text
)
4355 :: ("[Delete]", dele)
4356 :: ("[Edit]", edit conf
.annotinline
)
4358 :: split [] 0 0 |> List.rev
|> Array.of_list
4365 let s = getannotcontents
opaque slinkindex
in
4368 let source = (msgsource :> lvsource
) in
4369 let modehash = findkeyhash conf
"listview" in
4370 state
.uioh <- coe (object
4371 inherit listview ~zebra
:false ~helpmode
:false
4372 ~
source ~trusted
:false ~
modehash
4374 G.postRedisplay "enterannotmode";
4377 let gotounder under =
4378 let getpath filename
=
4380 if nonemptystr filename
4382 if Filename.is_relative filename
4384 let dir = Filename.dirname state
.path in
4386 if Filename.is_implicit
dir
4387 then Filename.concat
(Sys.getcwd
()) dir
4390 Filename.concat
dir filename
4394 if Sys.file_exists
path
4399 | Ulinkgoto
(pageno, top) ->
4403 gotopage1 pageno top;
4409 | Uremote
(filename
, pageno) ->
4410 let path = getpath filename
in
4415 let command = Printf.sprintf
"%s -page %d %S" !selfexec pageno path in
4416 try addpid
@@ popen
command []
4418 Printf.eprintf
"failed to execute `%s': %s\n" command (exntos exn
);
4421 let anchor = getanchor
() in
4422 let ranchor = state
.path, state
.password, anchor, state
.origin
in
4423 state
.origin
<- E.s;
4424 state
.anchor <- (pageno, 0.0, 0.0);
4425 state
.ranchors
<- ranchor :: state
.ranchors
;
4428 else showtext '
!'
("Could not find " ^ filename
)
4430 | Uremotedest
(filename
, destname
) ->
4431 let path = getpath filename
in
4436 let command = !selfexec ^
" " ^
path ^
" -dest " ^ destname
in
4437 try addpid
@@ popen
command []
4440 "failed to execute `%s': %s\n" command (exntos exn
);
4443 let anchor = getanchor
() in
4444 let ranchor = state
.path, state
.password, anchor, state
.origin
in
4445 state
.origin
<- E.s;
4446 state
.nameddest
<- destname
;
4447 state
.ranchors
<- ranchor :: state
.ranchors
;
4450 else showtext '
!'
("Could not find " ^ filename
)
4452 | Uunexpected
_ | Ulaunch
_ | Unamed
_ | Utext
_ | Unone
-> ()
4453 | Uannotation
(opaque, slinkindex
) -> enterannotmode opaque slinkindex
4456 let gotooutline (_, _, kind
) =
4460 let (pageno, y, _) = anchor in
4462 (if conf
.presentation
then (pageno, y, 1.0) else anchor)
4467 | Ouri
uri -> gotounder (Ulinkuri
uri); None
4468 | Olaunch cmd
-> gotounder (Ulaunch cmd
); None
4469 | Oremote remote
-> gotounder (Uremote remote
); None
4470 | Ohistory
hist -> gotohist hist; None
4471 | Oremotedest remotedest
-> gotounder (Uremotedest remotedest
); None
4472 | Oaction
f -> f (); None
4473 | Oreaction
f -> Some
(f ())
4476 let outlinesource sourcetype
=
4478 inherit lvsourcebase
4479 val mutable m_items
= E.a
4480 val mutable m_minfo
= E.a
4481 val mutable m_orig_items
= E.a
4482 val mutable m_orig_minfo
= E.a
4483 val mutable m_narrow_patterns
= []
4484 val mutable m_hadremovals
= false
4485 val mutable m_gen
= -1
4487 method getitemcount
=
4488 Array.length m_items
+ (if m_hadremovals
then 1 else 0)
4491 if n == Array.length m_items
&& m_hadremovals
4493 ("[Confirm removal]", 0)
4495 let s, n, _ = m_items
.(n) in
4498 method exit ~
uioh ~cancel ~
active ~
first ~pan
=
4499 ignore
(uioh, first);
4500 let confrimremoval = m_hadremovals
&& active = Array.length m_items
in
4502 if m_narrow_patterns
= []
4503 then m_orig_items
, m_orig_minfo
4504 else m_items
, m_minfo
4509 if not
confrimremoval
4513 match gotooutline m_items
.(active) with
4516 self#reset emptyanchor outlines
;
4520 state
.bookmarks
<- Array.to_list m_items
;
4521 m_orig_items
<- m_items
;
4522 m_orig_minfo
<- m_minfo
;
4532 method hasaction
_ = true
4535 if Array.length m_items
!= Array.length m_orig_items
4538 match m_narrow_patterns
with
4540 | many
-> String.concat
"@Uellipsis" (List.rev many
)
4542 "Narrowed to " ^
s ^
" (ctrl-u to restore)"
4546 match m_narrow_patterns
with
4549 | head
:: _ -> "@Uellipsis" ^ head
4551 method narrow
pattern =
4552 let reopt = try Some
(Str.regexp_case_fold
pattern) with _ -> None
in
4556 let rec loop accu minfo n =
4559 m_items
<- Array.of_list
accu;
4560 m_minfo
<- Array.of_list
minfo;
4563 let (s, _, t
) as o = m_items
.(n) in
4566 | Oaction
_ | Oreaction
_ -> o :: accu, (0, 0) :: minfo
4567 | Onone
| Oanchor
_ | Ouri
_ | Olaunch
_
4568 | Oremote
_ | Oremotedest
_ | Ohistory
_ ->
4570 try Str.search_forward
re s 0
4571 with Not_found
-> -1
4574 then o :: accu, (first, Str.match_end
()) :: minfo
4577 loop accu minfo (n-1)
4579 loop [] [] (Array.length m_items
- 1)
4581 method! getminfo
= m_minfo
4585 match sourcetype
with
4586 | `bookmarks
-> Array.of_list state
.bookmarks
4587 | `outlines
-> state
.outlines
4588 | `history
-> genhistoutlines ()
4590 m_minfo
<- m_orig_minfo
;
4591 m_items
<- m_orig_items
4594 if sourcetype
= `bookmarks
4596 if m >= 0 && m < Array.length m_items
4598 m_hadremovals
<- true;
4599 m_items
<- Array.init
(Array.length m_items
- 1) (fun n ->
4600 let n = if n >= m then n+1 else n in
4605 method add_narrow_pattern
pattern =
4606 m_narrow_patterns
<- pattern :: m_narrow_patterns
4608 method del_narrow_pattern
=
4609 match m_narrow_patterns
with
4610 | _ :: rest
-> m_narrow_patterns
<- rest
4615 match m_narrow_patterns
with
4616 | pattern :: [] -> self#narrow
pattern; pattern
4618 List.fold_left
(fun accu pattern ->
4619 self#narrow
pattern;
4620 pattern ^
"@Uellipsis" ^
accu) E.s list
4622 method calcactive
anchor =
4623 let rely = getanchory anchor in
4624 let rec loop n best bestd
=
4625 if n = Array.length m_items
4628 let _, _, kind
= m_items
.(n) in
4631 let orely = getanchory anchor in
4632 let d = abs
(orely - rely) in
4635 else loop (n+1) best bestd
4636 | Onone
| Oremote
_ | Olaunch
_
4637 | Oremotedest
_ | Ouri
_ | Ohistory
_ | Oaction
_ | Oreaction
_ ->
4638 loop (n+1) best bestd
4642 method reset
anchor items =
4643 m_hadremovals
<- false;
4644 if state
.gen
!= m_gen
4646 m_orig_items
<- items;
4648 m_narrow_patterns
<- [];
4650 m_orig_minfo
<- E.a;
4654 if items != m_orig_items
4656 m_orig_items
<- items;
4657 if m_narrow_patterns
== []
4658 then m_items
<- items;
4661 let active = self#calcactive
anchor in
4663 m_first
<- firstof m_first
active
4667 let enteroutlinemode, enterbookmarkmode
, enterhistmode
=
4668 let mkselector sourcetype
=
4669 let source = outlinesource sourcetype
in
4672 match sourcetype
with
4673 | `bookmarks
-> Array.of_list state
.bookmarks
4674 | `
outlines -> state
.outlines
4675 | `history
-> genhistoutlines ()
4677 if Array.length
outlines = 0
4679 showtext ' ' errmsg
;
4683 state
.text <- source#greetmsg
;
4684 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
4685 let anchor = getanchor
() in
4686 source#reset
anchor outlines;
4688 coe (new outlinelistview ~zebra
:(sourcetype
=`history
) ~
source);
4689 G.postRedisplay "enter selector";
4692 let mkenter sourcetype errmsg
=
4693 let enter = mkselector sourcetype
in
4694 fun () -> enter errmsg
4696 (**)mkenter `
outlines "Document has no outline"
4697 , mkenter `bookmarks
"Document has no bookmarks (yet)"
4698 , mkenter `history
"History is empty"
4701 let quickbookmark ?title
() =
4702 match state
.layout with
4708 let tm = Unix.localtime
(now
()) in
4710 "Quick (page %d) (bookmarked at %02d/%02d/%d %02d:%02d)"
4714 (tm.Unix.tm_year
+ 1900)
4717 | Some
title -> title
4719 state
.bookmarks
<- (title, 0, Oanchor
(getanchor1
l)) :: state
.bookmarks
4722 let setautoscrollspeed step goingdown
=
4723 let incr = max
1 ((abs step
) / 2) in
4724 let incr = if goingdown
then incr else -incr in
4725 let astep = boundastep state
.winh
(step
+ incr) in
4726 state
.autoscroll
<- Some
astep;
4730 match conf
.columns
with
4732 | Csingle
_ | Cmulti
_ -> state
.x != 0 || conf
.zoom > 1.0
4735 let panbound x = bound
x (-state
.w) (wadjsb () + state
.winw
);;
4737 let existsinrow pageno (columns
, coverA
, coverB
) p =
4738 let last = ((pageno - coverA
) mod columns
) + columns
in
4739 let rec any = function
4742 if l.pageno = coverA
- 1 || l.pageno = state
.pagecount
- coverB
4746 then (if l.pageno = last then false else any rest
)
4754 match state
.layout with
4756 let pageno = page_of_y state
.y in
4757 gotoghyll (getpagey
(pageno+1))
4759 match conf
.columns
with
4761 if conf
.presentation
&& rest
== [] && l.pageh
> l.pagey + l.pagevh
4763 let y = clamp (pgscale state
.winh
) in
4766 let pageno = min
(l.pageno+1) (state
.pagecount
-1) in
4767 gotoghyll (getpagey
pageno)
4768 | Cmulti
((c, _, _) as cl, _) ->
4769 if conf
.presentation
4770 && (existsinrow l.pageno cl
4771 (fun l -> l.pageh
> l.pagey + l.pagevh))
4773 let y = clamp (pgscale state
.winh
) in
4776 let pageno = min
(l.pageno+c) (state
.pagecount
-1) in
4777 gotoghyll (getpagey
pageno)
4779 if l.pageno < state
.pagecount
- 1 || l.pagecol
< n - 1
4781 let pagey, pageh
= getpageyh
l.pageno in
4782 let pagey = pagey + pageh
* l.pagecol
in
4783 let ips = if l.pagecol
= 0 then 0 else conf
.interpagespace
in
4784 gotoghyll (pagey + pageh
+ ips)
4788 match state
.layout with
4790 let pageno = page_of_y state
.y in
4791 gotoghyll (getpagey
(pageno-1))
4793 match conf
.columns
with
4795 if conf
.presentation
&& l.pagey != 0
4797 gotoghyll (clamp (pgscale ~
-(state
.winh
)))
4799 let pageno = max
0 (l.pageno-1) in
4800 gotoghyll (getpagey
pageno)
4801 | Cmulti
((c, _, coverB
) as cl, _) ->
4802 if conf
.presentation
&&
4803 (existsinrow l.pageno cl (fun l -> l.pagey != 0))
4805 gotoghyll (clamp (pgscale ~
-(state
.winh
)))
4808 if l.pageno = state
.pagecount
- coverB
4812 let pageno = max
0 (l.pageno-decr) in
4813 gotoghyll (getpagey
pageno)
4821 let pageno = max
0 (l.pageno-1) in
4822 let pagey, pageh
= getpageyh
pageno in
4825 let pagey, pageh
= getpageyh
l.pageno in
4826 pagey + pageh
* (l.pagecol
-1) - conf
.interpagespace
4832 if emptystr conf
.savecmd
4833 then error
"don't know where to save modified document"
4835 let savecmd = Str.global_replace percentsre state
.path conf
.savecmd in
4838 (fun s -> error
"failed to obtain path to the saved copy: %s" s)
4843 let tmp = path ^
".tmp" in
4845 Unix.rename
tmp path;
4848 let viewkeyboard key mask
=
4850 let mode = state
.mode in
4851 state
.mode <- Textentry
(te, fun _ -> state
.mode <- mode);
4854 G.postRedisplay "view:enttext"
4856 let ctrl = Wsi.withctrl mask
in
4858 if key >= 0xffb0 && key < 0xffb9 then key - 0xffb0 + 48 else key
4864 if hasunsavedchanges
()
4868 if conf
.angle
mod 360 = 0 && not
(isbirdseye state
.mode)
4870 state
.mode <- LinkNav
(Ltgendir
0);
4873 else showtext '
!'
"Keyboard link navigation does not work under rotation"
4876 begin match state
.mstate
with
4879 G.postRedisplay "kill rect";
4882 | Mscrolly
| Mscrollx
4885 begin match state
.mode with
4888 G.postRedisplay "esc leave linknav"
4892 match state
.ranchors
with
4894 | (path, password, anchor, origin
) :: rest
->
4895 state
.ranchors
<- rest
;
4896 state
.anchor <- anchor;
4897 state
.origin
<- origin
;
4898 state
.nameddest
<- E.s;
4899 opendoc path password
4904 gotoghyll (getnav ~
-1)
4915 Hashtbl.iter
(fun _ opaque -> clearmark
opaque) state
.pagemap
;
4916 G.postRedisplay "dehighlight";
4918 | @slash
| @question
->
4919 let ondone isforw
s =
4920 cbput state
.hists
.pat
s;
4921 state
.searchpattern
<- s;
4924 let s = String.make
1 (Char.chr
key) in
4925 enttext (s, E.s, Some
(onhist state
.hists
.pat
),
4926 textentry, ondone (key = @slash
), true)
4928 | @plus
| @kpplus
| @equals
when ctrl ->
4929 let incr = if conf
.zoom +. 0.01 > 0.1 then 0.1 else 0.01 in
4930 setzoom (conf
.zoom +. incr)
4932 | @plus
| @kpplus
->
4935 try int_of_string
s with exc
->
4936 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
);
4942 state
.text <- "page bias is now " ^ string_of_int
n;
4945 enttext ("page bias: ", E.s, None
, intentry, ondone, true)
4947 | @minus
| @kpminus
when ctrl ->
4948 let decr = if conf
.zoom -. 0.1 < 0.1 then 0.01 else 0.1 in
4949 setzoom (max
0.01 (conf
.zoom -. decr))
4951 | @minus
| @kpminus
->
4952 let ondone msg
= state
.text <- msg
in
4954 "option [acfhilpstvxACFPRSZTISM]: ", E.s, None
,
4955 optentry state
.mode, ondone, true
4966 | (@1 | @2) when ctrl && conf
.fitmodel
!= FitPage
-> (* ctrl-1/2 *)
4968 match conf
.columns
with
4969 | Csingle
_ | Cmulti
_ -> 1
4970 | Csplit
(n, _) -> n
4972 let h = state
.winh
-
4973 conf
.interpagespace
lsl (if conf
.presentation
then 1 else 0)
4975 let zoom = zoomforh state
.winw
h (vscrollw ()) cols in
4976 if zoom > 0.0 && (key = 50 || zoom < 1.0)
4981 match conf
.fitmodel
with
4982 | FitWidth
-> FitProportional
4983 | FitProportional
-> FitPage
4984 | FitPage
-> FitWidth
4986 state
.text <- "fit model: " ^
FMTE.to_string
fm;
4987 reqlayout conf
.angle
fm
4995 | (48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57)
4996 when not
ctrl -> (* 0..9 *)
4999 try int_of_string
s with exc
->
5000 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
);
5006 cbput state
.hists
.pag
(string_of_int
n);
5007 gotopage1 (n + conf
.pagebias
- 1) 0;
5010 let pageentry text key =
5011 match Char.unsafe_chr
key with
5012 | '
g'
-> TEdone
text
5013 | _ -> intentry text key
5015 let text = String.make
1 (Char.chr
key) in
5016 enttext (":", text, Some
(onhist state
.hists
.pag
),
5017 pageentry, ondone, true)
5020 conf
.scrollb
<- if conf
.scrollb
= 0 then (scrollbvv
lor scrollbhv
) else 0;
5021 reshape state
.winw state
.winh
;
5024 state
.bzoom
<- not state
.bzoom
;
5026 showtext ' '
("block zoom " ^
if state
.bzoom
then "on" else "off")
5029 conf
.hlinks
<- not conf
.hlinks
;
5030 state
.text <- "highlightlinks " ^
if conf
.hlinks
then "on" else "off";
5031 G.postRedisplay "toggle highlightlinks";
5034 state
.glinks
<- true;
5035 let mode = state
.mode in
5036 state
.mode <- Textentry
(
5037 (":", E.s, None
, linknentry, linknact gotounder, false),
5039 state
.glinks
<- false;
5043 G.postRedisplay "view:linkent(F)"
5046 state
.glinks
<- true;
5047 let mode = state
.mode in
5048 state
.mode <- Textentry
(
5050 ":", E.s, None
, linknentry, linknact (fun under ->
5051 selstring (undertext under);
5055 state
.glinks
<- false;
5059 G.postRedisplay "view:linkent"
5062 begin match state
.autoscroll
with
5064 conf
.autoscrollstep
<- step
;
5065 state
.autoscroll
<- None
5067 if conf
.autoscrollstep
= 0
5068 then state
.autoscroll
<- Some
1
5069 else state
.autoscroll
<- Some conf
.autoscrollstep
5076 setpresentationmode (not conf
.presentation
);
5077 showtext ' '
("presentation mode " ^
5078 if conf
.presentation
then "on" else "off");
5081 if List.mem
Wsi.Fullscreen state
.winstate
5082 then Wsi.reshape conf
.cwinw conf
.cwinh
5083 else Wsi.fullscreen
()
5086 search state
.searchpattern
false
5089 search state
.searchpattern
true
5092 begin match state
.layout with
5095 gotoghyll (getpagey
l.pageno)
5101 | @delete
| @kpdelete
-> (* delete *)
5105 showtext ' '
(describe_location ());
5108 begin match state
.layout with
5111 Wsi.reshape (l.pagew
+ vscrollw ()) l.pageh
;
5116 enterbookmarkmode
()
5124 | @e when Buffer.length state
.errmsgs
> 0 ->
5129 match state
.layout with
5134 (s, 0, Oanchor
(getanchor1
l)) :: state
.bookmarks
5137 enttext ("bookmark: ", E.s, None
, textentry, ondone, true)
5141 showtext ' '
"Quick bookmark added";
5144 begin match state
.layout with
5146 let rect = getpdimrect
l.pagedimno
in
5150 (truncate
(1.8 *. (rect.(1) -. rect.(0))),
5151 truncate
(1.2 *. (rect.(3) -. rect.(0))))
5153 (truncate
(rect.(1) -. rect.(0)),
5154 truncate
(rect.(3) -. rect.(0)))
5156 let w = truncate
((float w)*.conf
.zoom)
5157 and h = truncate
((float h)*.conf
.zoom) in
5160 state
.anchor <- getanchor
();
5161 Wsi.reshape (w + vscrollw ()) (h + conf
.interpagespace
)
5163 G.postRedisplay "z";
5168 | @x -> state
.roam
()
5171 reqlayout (conf
.angle
+
5172 (if key = @Gt
then 30 else -30)) conf
.fitmodel
5176 bound
(conf
.colorscale
+. (if key = 93 then 0.1 else -0.1)) 0.0 1.0
5178 G.postRedisplay "brightness";
5180 | @c when state
.mode = View
->
5185 let m = (wadjsb () + state
.winw
- state
.w) / 2 in
5187 gotoy_and_clear_text state
.y
5191 match state
.prevcolumns
with
5192 | None
-> (1, 0, 0), 1.0
5193 | Some
(columns
, z
) ->
5196 | Csplit
(c, _) -> -c, 0, 0
5197 | Cmulti
((c, a, b), _) -> c, a, b
5198 | Csingle
_ -> 1, 0, 0
5202 setcolumns View
c a b;
5205 | @down
| @up
when ctrl && Wsi.withshift mask
->
5206 let zoom, x = state
.prevzoom
in
5210 | @k
| @up
| @kpup
->
5211 begin match state
.autoscroll
with
5213 begin match state
.mode with
5214 | Birdseye beye
-> upbirdseye 1 beye
5219 then gotoy_and_clear_text (clamp ~
-(state
.winh
/2))
5221 if not
(Wsi.withshift mask
) && conf
.presentation
5223 else gotoghyll1 true (clamp (-conf
.scrollstep
))
5227 setautoscrollspeed n false
5230 | @j
| @down
| @kpdown
->
5231 begin match state
.autoscroll
with
5233 begin match state
.mode with
5234 | Birdseye beye
-> downbirdseye 1 beye
5239 then gotoy_and_clear_text (clamp (state
.winh
/2))
5241 if not
(Wsi.withshift mask
) && conf
.presentation
5243 else gotoghyll1 true (clamp (conf
.scrollstep
))
5247 setautoscrollspeed n true
5250 | @left | @right
| @kpleft
| @kpright
when not
(Wsi.withalt mask
) ->
5256 else conf
.hscrollstep
5258 let dx = if key = @left || key = @kpleft
then dx else -dx in
5259 state
.x <- panbound (state
.x + dx);
5260 gotoy_and_clear_text state
.y
5263 G.postRedisplay "left/right"
5266 | @prior
| @kpprior
->
5270 match state
.layout with
5272 | l :: _ -> state
.y - l.pagey
5274 clamp (pgscale (-state
.winh
))
5278 | @next | @kpnext
->
5282 match List.rev state
.layout with
5284 | l :: _ -> getpagey
l.pageno
5286 clamp (pgscale state
.winh
)
5290 | @g | @home
| @kphome
->
5293 | @G
| @jend
| @kpend
->
5295 gotoghyll (clamp state
.maxy)
5297 | @right
| @kpright
when Wsi.withalt mask
->
5298 gotoghyll (getnav 1)
5299 | @left | @kpleft
when Wsi.withalt mask
->
5300 gotoghyll (getnav ~
-1)
5305 | @v when conf
.debug
->
5308 match getopaque l.pageno with
5311 let x0, y0, x1, y1 = pagebbox
opaque in
5312 let a,b = float x0, float y0 in
5313 let c,d = float x1, float y0 in
5314 let e,f = float x1, float y1 in
5315 let h,j
= float x0, float y1 in
5316 let rect = (a,b,c,d,e,f,h,j
) in
5318 state
.rects
<- (l.pageno, l.pageno mod 3, rect) :: state
.rects
;
5320 G.postRedisplay "v";
5323 let mode = state
.mode in
5324 let cmd = ref E.s in
5325 let onleave = function
5326 | Cancel
-> state
.mode <- mode
5329 match getopaque l.pageno with
5330 | Some
opaque -> pipesel opaque !cmd
5331 | None
-> ()) state
.layout;
5335 cbput state
.hists
.sel
s;
5339 "| ", !cmd, Some
(onhist state
.hists
.sel
), textentry, ondone, true
5341 G.postRedisplay "|";
5342 state
.mode <- Textentry
(te, onleave);
5345 vlog "huh? %s" (Wsi.keyname
key)
5348 let linknavkeyboard key mask
linknav =
5349 let getpage pageno =
5350 let rec loop = function
5352 | l :: _ when l.pageno = pageno -> Some
l
5353 | _ :: rest
-> loop rest
5354 in loop state
.layout
5356 let doexact (pageno, n) =
5357 match getopaque pageno, getpage pageno with
5358 | Some
opaque, Some
l ->
5359 if key = @enter || key = @kpenter
5361 let under = getlink
opaque n in
5362 G.postRedisplay "link gotounder";
5369 Some
(findlink
opaque LDfirst
), -1
5372 Some
(findlink
opaque LDlast
), 1
5375 Some
(findlink
opaque (LDleft
n)), -1
5378 Some
(findlink
opaque (LDright
n)), 1
5381 Some
(findlink
opaque (LDup
n)), -1
5384 Some
(findlink
opaque (LDdown
n)), 1
5389 begin match findpwl
l.pageno dir with
5393 state
.mode <- LinkNav
(Ltgendir
dir);
5394 let y, h = getpageyh
pageno in
5397 then y + h - state
.winh
5402 begin match getopaque pageno, getpage pageno with
5403 | Some
opaque, Some
_ ->
5405 let ld = if dir > 0 then LDfirst
else LDlast
in
5408 begin match link with
5410 showlinktype (getlink
opaque m);
5411 state
.mode <- LinkNav
(Ltexact
(pageno, m));
5412 G.postRedisplay "linknav jpage";
5413 | Lnotfound
-> notfound dir
5419 begin match opt with
5420 | Some Lnotfound
-> pwl l dir;
5421 | Some
(Lfound
m) ->
5425 let _, y0, _, y1 = getlinkrect
opaque m in
5427 then gotopage1 l.pageno y0
5429 let d = fstate
.fontsize
+ 1 in
5430 if y1 - l.pagey > l.pagevh - d
5431 then gotopage1 l.pageno (y1 - state
.winh
- hscrollh () + d)
5432 else G.postRedisplay "linknav";
5434 showlinktype (getlink
opaque m);
5435 state
.mode <- LinkNav
(Ltexact
(l.pageno, m));
5438 | None
-> viewkeyboard key mask
5440 | _ -> viewkeyboard key mask
5445 G.postRedisplay "leave linknav"
5449 | Ltgendir
_ | Ltnotready
_ -> viewkeyboard key mask
5450 | Ltexact exact
-> doexact exact
5453 let keyboard key mask
=
5454 if (key = 103 && Wsi.withctrl mask
) && not
(istextentry state
.mode)
5455 then wcmd "interrupt"
5456 else state
.uioh <- state
.uioh#
key key mask
5459 let birdseyekeyboard key mask
5460 ((oconf
, leftx
, pageno, hooverpageno
, anchor) as beye
) =
5462 match conf
.columns
with
5464 | Cmulti
((c, _, _), _) -> c
5465 | Csplit
_ -> failwith
"bird's eye split mode"
5467 let pgh layout = List.fold_left
5468 (fun m l -> max
l.pageh
m) state
.winh
layout in
5470 | @l when Wsi.withctrl mask
->
5471 let y, h = getpageyh
pageno in
5472 let top = (state
.winh
- h) / 2 in
5473 gotoy (max
0 (y - top))
5474 | @enter | @kpenter
-> leavebirdseye beye
false
5475 | @escape
-> leavebirdseye beye
true
5476 | @up
-> upbirdseye incr beye
5477 | @down
-> downbirdseye incr beye
5478 | @left -> upbirdseye 1 beye
5479 | @right
-> downbirdseye 1 beye
5482 begin match state
.layout with
5486 state
.mode <- Birdseye
(
5487 oconf
, leftx
, l.pageno, hooverpageno
, anchor
5489 gotopage1 l.pageno 0;
5492 let layout = layout (state
.y-state
.winh
) (pgh state
.layout) in
5494 | [] -> gotoy (clamp (-state
.winh
))
5496 state
.mode <- Birdseye
(
5497 oconf
, leftx
, l.pageno, hooverpageno
, anchor
5499 gotopage1 l.pageno 0
5502 | [] -> gotoy (clamp (-state
.winh
))
5506 begin match List.rev state
.layout with
5508 let layout = layout (state
.y + (pgh state
.layout)) state
.winh
in
5509 begin match layout with
5511 let incr = l.pageh
- l.pagevh in
5516 oconf
, leftx
, state
.pagecount
- 1, hooverpageno
, anchor
5518 G.postRedisplay "birdseye pagedown";
5520 else gotoy (clamp (incr + conf
.interpagespace
*2));
5524 Birdseye
(oconf
, leftx
, l.pageno, hooverpageno
, anchor);
5525 gotopage1 l.pageno 0;
5528 | [] -> gotoy (clamp state
.winh
)
5532 state
.mode <- Birdseye
(oconf
, leftx
, 0, hooverpageno
, anchor);
5536 let pageno = state
.pagecount
- 1 in
5537 state
.mode <- Birdseye
(oconf
, leftx
, pageno, hooverpageno
, anchor);
5538 if not
(pagevisible state
.layout pageno)
5541 match List.rev state
.pdims
with
5543 | (_, _, h, _) :: _ -> h
5545 gotoy (max
0 (getpagey
pageno - (state
.winh
- h - conf
.interpagespace
)))
5546 else G.postRedisplay "birdseye end";
5548 | _ -> viewkeyboard key mask
5553 match state
.mode with
5554 | Textentry
_ -> scalecolor 0.4
5556 | View
-> scalecolor 1.0
5557 | Birdseye
(_, _, pageno, hooverpageno
, _) ->
5558 if l.pageno = hooverpageno
5561 if l.pageno = pageno
5563 let c = scalecolor 1.0 in
5565 GlDraw.line_width
3.0;
5566 let dispx = xadjsb () + l.pagedispx in
5568 (float (dispx-1)) (float (l.pagedispy-1))
5569 (float (dispx+l.pagevw+1))
5570 (float (l.pagedispy+l.pagevh+1))
5572 GlDraw.line_width
1.0;
5581 let postdrawpage l linkindexbase
=
5582 match getopaque l.pageno with
5584 if tileready l l.pagex
l.pagey
5586 let x = l.pagedispx - l.pagex
+ xadjsb ()
5587 and y = l.pagedispy - l.pagey in
5589 match conf
.columns
with
5590 | Csingle
_ | Cmulti
_ ->
5591 (if conf
.hlinks
then 1 else 0)
5593 && not
(isbirdseye state
.mode) then 2 else 0)
5597 match state
.mode with
5598 | Textentry
((_, s, _, _, _, _), _) when state
.glinks
-> s
5604 postprocess
opaque hlmask x y (linkindexbase
, s, conf
.hfsize
);
5609 let scrollindicator () =
5610 let sbw, ph
, sh = state
.uioh#
scrollph in
5611 let sbh, pw, sw = state
.uioh#scrollpw
in
5616 else ((state
.winw
- sbw), state
.winw
, 0)
5619 GlDraw.color (0.64, 0.64, 0.64);
5620 filledrect (float x0) 0. (float x1) (float state
.winh
);
5622 (float hx0
) (float (state
.winh
- sbh))
5623 (float (hx0
+ wadjsb () + state
.winw
)) (float state
.winh
)
5625 GlDraw.color (0.0, 0.0, 0.0);
5627 filledrect (float x0) ph
(float x1) (ph
+. sh);
5628 let pw = pw +. float hx0
in
5629 filledrect pw (float (state
.winh
- sbh)) (pw +. sw) (float state
.winh
);
5633 match state
.mstate
with
5634 | Mnone
| Mscrolly
| Mscrollx
| Mpan
_ | Mzoom
_ | Mzoomrect
_ ->
5637 | Msel
((x0, y0), (x1, y1)) ->
5638 let identify opaque l px py = Some
(opaque, l.pageno, px, py) in
5639 let o0,n0
,px0
,py0
= onppundermouse identify x0 y0 (~
< E.s, -1, 0, 0) in
5640 let _o1,n1
,px1
,py1
= onppundermouse identify x1 y1 (~
< E.s, -1, 0, 0) in
5641 if n0
!= -1 && n0
= n1
then seltext
o0 (px0
, py0
, px1
, py1
);
5644 let showrects = function [] -> () | rects
->
5646 GlDraw.color (0.0, 0.0, 1.0) ~
alpha:0.5;
5647 GlFunc.blend_func ~
src:`src_alpha ~dst
:`one_minus_src_alpha
;
5649 (fun (pageno, c, (x0, y0, x1, y1, x2
, y2
, x3
, y3
)) ->
5651 if l.pageno = pageno
5653 let dx = float (l.pagedispx - l.pagex
) in
5654 let dy = float (l.pagedispy - l.pagey) in
5655 GlDraw.color (0.0, 0.0, 1.0 /. float c) ~
alpha:0.5;
5656 Raw.sets_float state
.vraw ~
pos:0
5661 GlArray.vertex `two state
.vraw
;
5662 GlArray.draw_arrays `triangle_strip ~
first:0 ~count
:4;
5671 GlClear.color (scalecolor2 conf
.bgcolor
);
5672 GlClear.clear
[`
color];
5673 List.iter
drawpage state
.layout;
5675 match state
.mode with
5676 | LinkNav
(Ltexact
(pageno, linkno
)) ->
5677 begin match getopaque pageno with
5679 let dx = xadjsb () in
5680 let x0, y0, x1, y1 = getlinkrect
opaque linkno
in
5681 let x0 = x0 + dx and x1 = x1 + dx in
5688 | None
-> state
.rects
5690 | LinkNav
(Ltgendir
_) | LinkNav
(Ltnotready
_)
5693 | View
-> state
.rects
5696 let rec postloop linkindexbase
= function
5698 let linkindexbase = linkindexbase + postdrawpage l linkindexbase in
5699 postloop linkindexbase rest
5703 postloop 0 state
.layout;
5705 begin match state
.mstate
with
5706 | Mzoomrect
((x0, y0), (x1, y1)) ->
5708 GlDraw.color (0.3, 0.3, 0.3) ~
alpha:0.5;
5709 GlFunc.blend_func ~
src:`src_alpha ~dst
:`one_minus_src_alpha
;
5710 filledrect (float x0) (float y0) (float x1) (float y1);
5714 | Mscrolly
| Mscrollx
5723 let zoomrect x y x1 y1 =
5726 and y0 = min
y y1 in
5727 gotoy (state
.y + y0);
5728 state
.anchor <- getanchor
();
5729 let zoom = (float state
.w) /. float (x1 - x0) in
5732 let adjw = wadjsb () + state
.winw
in
5734 then (adjw - state
.w) / 2
5737 match conf
.fitmodel
with
5738 | FitWidth
| FitProportional
-> simple ()
5740 match conf
.columns
with
5742 onppundermouse (fun _ l _ _ -> Some
l.pagedispx) x0 y0 x0
5743 | Cmulti
_ | Csingle
_ -> simple ()
5745 state
.x <- (state
.x + margin) - x0;
5750 let annot inline
x y =
5751 match unproject x y with
5752 | Some
(opaque, n, ux
, uy
) ->
5754 addannot
opaque ux uy
text;
5755 wcmd "freepage %s" (~
> opaque);
5756 Hashtbl.remove state
.pagemap
(n, state
.gen
);
5762 let ondone s = add s in
5763 let mode = state
.mode in
5764 state
.mode <- Textentry
(
5765 ("annotation: ", E.s, None
, textentry, ondone, true),
5766 fun _ -> state
.mode <- mode);
5769 G.postRedisplay "annot"
5771 add @@ getusertext E.s
5776 let g opaque l px py =
5777 match rectofblock
opaque px py with
5779 let x0 = a.(0) -. 20. in
5780 let x1 = a.(1) +. 20. in
5781 let y0 = a.(2) -. 20. in
5782 let zoom = (float state
.w) /. (x1 -. x0) in
5783 let pagey = getpagey
l.pageno in
5784 gotoy_and_clear_text (pagey + truncate
y0);
5785 state
.anchor <- getanchor
();
5786 let margin = (state
.w - l.pagew
)/2 in
5787 state
.x <- -truncate
x0 - margin;
5792 match conf
.columns
with
5794 showtext '
!'
"block zooming does not work properly in split columns mode"
5795 | Cmulti
_ | Csingle
_ -> onppundermouse g x y ()
5799 let winw = wadjsb () + state
.winw - 1 in
5800 let s = float x /. float winw in
5801 let destx = truncate
(float (state
.w + winw) *. s) in
5802 state
.x <- winw - destx;
5803 gotoy_and_clear_text state
.y;
5804 state
.mstate
<- Mscrollx
;
5808 let s = float y /. float state
.winh
in
5809 let desty = truncate
(float (state
.maxy - state
.winh
) *. s) in
5810 gotoy_and_clear_text desty;
5811 state
.mstate
<- Mscrolly
;
5814 let viewmulticlick clicks
x y mask
=
5815 let g opaque l px py =
5823 if markunder
opaque px py mark
5827 match getopaque l.pageno with
5829 | Some
opaque -> pipesel opaque cmd
5831 state
.roam
<- (fun () -> dopipe conf
.paxcmd
);
5832 if not
(Wsi.withctrl mask
) then dopipe conf
.selcmd
;
5837 G.postRedisplay "viewmulticlick";
5838 onppundermouse g x y (fun () -> showtext '
!'
"Nothing to select") ();
5842 match conf
.columns
with
5844 | Csingle
_ | Cmulti
_ -> conf
.angle
mod 360 = 0
5847 let viewmouse button down
x y mask
=
5849 | n when (n == 4 || n == 5) && not down
->
5850 if Wsi.withctrl mask
5852 match state
.mstate
with
5853 | Mzoom
(oldn
, i
) ->
5861 if conf
.zoom +. 0.01 > 0.1 then 0.1 else 0.01
5863 if conf
.zoom -. 0.1 < 0.1 then -0.01 else -0.1
5865 let zoom = conf
.zoom -. incr in
5867 state
.mstate
<- Mzoom
(n, 0);
5869 state
.mstate
<- Mzoom
(n, i
+1);
5871 else state
.mstate
<- Mzoom
(n, 0)
5875 | Mscrolly
| Mscrollx
5877 | Mnone
-> state
.mstate
<- Mzoom
(n, 0)
5880 match state
.autoscroll
with
5881 | Some step
-> setautoscrollspeed step
(n=4)
5883 if conf
.wheelbypage
|| conf
.presentation
5892 then -conf
.scrollstep
5893 else conf
.scrollstep
5895 let incr = incr * 2 in
5896 let y = clamp incr in
5897 gotoy_and_clear_text y
5900 | n when (n = 6 || n = 7) && not down
&& canpan () ->
5902 panbound (state
.x + (if n = 7 then -2 else 2) * conf
.hscrollstep
);
5903 gotoy_and_clear_text state
.y
5905 | 1 when Wsi.withshift mask
->
5906 state
.mstate
<- Mnone
;
5909 match unproject x y with
5910 | Some
(_, pageno, ux
, uy
) ->
5911 let cmd = Printf.sprintf
5913 conf
.stcmd state
.path pageno ux uy
5915 addpid
@@ popen
cmd []
5919 | 1 when Wsi.withctrl mask
->
5922 Wsi.setcursor
Wsi.CURSOR_FLEUR
;
5923 state
.mstate
<- Mpan
(x, y)
5926 state
.mstate
<- Mnone
5931 if Wsi.withshift mask
5933 annot conf
.annotinline
x y;
5934 G.postRedisplay "addannot"
5938 Wsi.setcursor
Wsi.CURSOR_CYCLE
;
5939 state
.mstate
<- Mzoomrect
(p, p)
5942 match state
.mstate
with
5943 | Mzoomrect
((x0, y0), _) ->
5944 if abs
(x-x0) > 10 && abs
(y - y0) > 10
5945 then zoomrect x0 y0 x y
5948 G.postRedisplay "kill accidental zoom rect";
5952 | Mscrolly
| Mscrollx
5958 | 1 when x > state
.winw - vscrollw () ->
5961 let _, position, sh = state
.uioh#
scrollph in
5962 if y > truncate
position && y < truncate
(position +. sh)
5963 then state
.mstate
<- Mscrolly
5966 state
.mstate
<- Mnone
5968 | 1 when y > state
.winh
- hscrollh () ->
5971 let _, position, sw = state
.uioh#scrollpw
in
5972 if x > truncate
position && x < truncate
(position +. sw)
5973 then state
.mstate
<- Mscrollx
5976 state
.mstate
<- Mnone
5978 | 1 when state
.bzoom
-> if not down
then zoomblock x y
5981 let dest = if down
then getunder x y else Unone
in
5982 begin match dest with
5985 | Uremote
_ | Uremotedest
_
5986 | Uunexpected
_ | Ulaunch
_ | Unamed
_ ->
5989 | Unone
when down
->
5990 Wsi.setcursor
Wsi.CURSOR_FLEUR
;
5991 state
.mstate
<- Mpan
(x, y);
5993 | Uannotation
(opaque, slinkindex
) -> enterannotmode opaque slinkindex
5995 | Unone
| Utext
_ ->
6000 state
.mstate
<- Msel
((x, y), (x, y));
6001 G.postRedisplay "mouse select";
6005 match state
.mstate
with
6008 | Mzoom
_ | Mscrollx
| Mscrolly
->
6009 state
.mstate
<- Mnone
6011 | Mzoomrect
((x0, y0), _) ->
6015 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
6016 state
.mstate
<- Mnone
6018 | Msel
((x0, y0), (x1, y1)) ->
6019 let rec loop = function
6023 let a0 = l.pagedispy in
6024 let a1 = a0 + l.pagevh in
6025 let b0 = l.pagedispx in
6026 let b1 = b0 + l.pagevw in
6027 ((y0 >= a0 && y0 <= a1) || (y1 >= a0 && y1 <= a1))
6028 && ((x0 >= b0 && x0 <= b1) || (x1 >= b0 && x1 <= b1))
6032 match getopaque l.pageno with
6035 match Unix.pipe
() with
6039 "can not create sel pipe: %s"
6043 Ne.clo fd
(fun msg
->
6044 dolog
"%s close failed: %s" what msg
)
6047 try popen
cmd [r
, 0; w, -1]
6049 dolog
"can not execute %S: %s"
6056 G.postRedisplay "copysel";
6058 else clo "Msel pipe/w" w;
6059 clo "Msel pipe/r" r
;
6061 dosel conf
.selcmd
();
6062 state
.roam
<- dosel conf
.paxcmd
;
6074 let birdseyemouse button down
x y mask
6075 (conf
, leftx
, _, hooverpageno
, anchor) =
6078 let rec loop = function
6081 if y > l.pagedispy && y < l.pagedispy + l.pagevh
6082 && x > l.pagedispx && x < l.pagedispx + l.pagevw
6084 leavebirdseye (conf
, leftx
, l.pageno, hooverpageno
, anchor) false;
6090 | _ -> viewmouse button down
x y mask
6096 method key key mask
=
6097 begin match state
.mode with
6098 | Textentry
textentry -> textentrykeyboard key mask
textentry
6099 | Birdseye
birdseye -> birdseyekeyboard key mask
birdseye
6100 | View
-> viewkeyboard key mask
6101 | LinkNav
linknav -> linknavkeyboard key mask
linknav
6105 method button button bstate
x y mask
=
6106 begin match state
.mode with
6108 | View
-> viewmouse button bstate
x y mask
6109 | Birdseye beye
-> birdseyemouse button bstate
x y mask beye
6114 method multiclick clicks
x y mask
=
6115 begin match state
.mode with
6117 | View
-> viewmulticlick clicks
x y mask
6124 begin match state
.mode with
6126 | View
| Birdseye
_ | LinkNav
_ ->
6127 match state
.mstate
with
6128 | Mzoom
_ | Mnone
-> ()
6133 state
.mstate
<- Mpan
(x, y);
6135 then state
.x <- panbound (state
.x + dx);
6137 gotoy_and_clear_text y
6140 state
.mstate
<- Msel
(a, (x, y));
6141 G.postRedisplay "motion select";
6144 let y = min state
.winh
(max
0 y) in
6148 let x = min state
.winw (max
0 x) in
6151 | Mzoomrect
(p0
, _) ->
6152 state
.mstate
<- Mzoomrect
(p0
, (x, y));
6153 G.postRedisplay "motion zoomrect";
6157 method pmotion
x y =
6158 begin match state
.mode with
6159 | Birdseye
(conf
, leftx
, pageno, hooverpageno
, anchor) ->
6160 let rec loop = function
6162 if hooverpageno
!= -1
6164 state
.mode <- Birdseye
(conf
, leftx
, pageno, -1, anchor);
6165 G.postRedisplay "pmotion birdseye no hoover";
6168 if y > l.pagedispy && y < l.pagedispy + l.pagevh
6169 && x > l.pagedispx && x < l.pagedispx + l.pagevw
6171 state
.mode <- Birdseye
(conf
, leftx
, pageno, l.pageno, anchor);
6172 G.postRedisplay "pmotion birdseye hoover";
6182 match state
.mstate
with
6183 | Mpan
_ | Msel
_ | Mzoom
_ | Mscrolly
| Mscrollx
| Mzoomrect
_ -> ()
6191 let past, _, _ = !r
in
6193 let delta = now -. past in
6196 else r
:= (now, x, y)
6200 method infochanged
_ = ()
6203 let maxy = state
.maxy - (if conf
.maxhfit
then state
.winh
else 0) in
6206 then 0.0, float state
.winh
6207 else scrollph state
.y maxy
6212 let winw = wadjsb () + state
.winw in
6213 let fwinw = float winw in
6215 let sw = fwinw /. float state
.w in
6216 let sw = fwinw *. sw in
6217 max
sw (float conf
.scrollh
)
6220 let maxx = state
.w + winw in
6221 let x = winw - state
.x in
6222 let percent = float x /. float maxx in
6223 (fwinw -. sw) *. percent
6225 hscrollh (), position, sw
6229 match state
.mode with
6230 | LinkNav
_ -> "links"
6231 | Textentry
_ -> "textentry"
6232 | Birdseye
_ -> "birdseye"
6235 findkeyhash conf
modename
6237 method eformsgs
= true
6238 method alwaysscrolly
= false
6241 let adderrmsg src msg
=
6242 Buffer.add_string state
.errmsgs msg
;
6243 state
.newerrmsgs
<- true;
6247 let adderrfmt src fmt
=
6248 Format.ksprintf
(fun s -> adderrmsg src s) fmt
;
6252 let cl = splitatspace cmds
in
6254 try Scanf.sscanf
s fmt
f
6256 adderrfmt "remote exec"
6257 "error processing '%S': %s\n" cmds
(exntos exn
)
6260 | "reload" :: [] -> reload ()
6261 | "goto" :: args
:: [] ->
6262 scan args
"%u %f %f"
6264 let cmd, _ = state
.geomcmds
in
6266 then gotopagexy pageno x y
6269 gotopagexy pageno x y;
6272 state
.reprf
<- f state
.reprf
6274 | "goto1" :: args
:: [] -> scan args
"%u %f" gotopage
6275 | "gotor" :: args
:: [] ->
6277 (fun filename
pageno -> gotounder (Uremote
(filename
, pageno)))
6278 | "gotord" :: args
:: [] ->
6280 (fun filename
dest -> gotounder (Uremotedest
(filename
, dest)))
6281 | "rect" :: args
:: [] ->
6282 scan args
"%u %u %f %f %f %f"
6283 (fun pageno color x0 y0 x1 y1 ->
6284 onpagerect pageno (fun w h ->
6285 let _,w1,h1
,_ = getpagedim
pageno in
6286 let sw = float w1 /. float w
6287 and sh = float h1
/. float h in
6291 and y1s
= y1 *. sh in
6292 let rect = (x0s,y0s
,x1s
,y0s
,x1s
,y1s
,x0s,y1s
) in
6294 state
.rects <- (pageno, color, rect) :: state
.rects;
6295 G.postRedisplay "rect";
6298 | "activatewin" :: [] -> Wsi.activatewin
()
6299 | "quit" :: [] -> raise Quit
6301 adderrfmt "remote command"
6302 "error processing remote command: %S\n" cmds
;
6306 let scratch = Bytes.create
80 in
6307 let buf = Buffer.create
80 in
6310 try Some
(Unix.read fd
scratch 0 80)
6312 | Unix.Unix_error
(Unix.EAGAIN
, _, _) -> None
6313 | Unix.Unix_error
(Unix.EINTR
, _, _) -> tempfr ()
6316 match tempfr () with
6322 if Buffer.length
buf > 0
6324 let s = Buffer.contents
buf in
6334 let pos = Bytes.index_from
scratch ppos '
\n'
in
6335 if pos >= n then -1 else pos
6336 with Not_found
-> -1
6340 Buffer.add_subbytes
buf scratch ppos
(nlpos-ppos
);
6341 let s = Buffer.contents
buf in
6347 Buffer.add_subbytes
buf scratch ppos
(n-ppos
);
6353 let remoteopen path =
6354 try Some
(Unix.openfile
path [Unix.O_NONBLOCK
; Unix.O_RDONLY
] 0o0)
6356 adderrfmt "remoteopen" "error opening %S: %s" path (exntos exn
);
6361 let gcconfig = ref E.s in
6362 let trimcachepath = ref E.s in
6363 let rcmdpath = ref E.s in
6364 let pageno = ref None
in
6365 let rootwid = ref 0 in
6366 let openlast = ref false in
6367 let nofc = ref false in
6368 let doreap = ref false in
6369 selfexec := Sys.executable_name
;
6372 [("-p", Arg.String
(fun s -> state
.password <- s),
6373 "<password> Set password");
6377 Config.fontpath
:= s;
6378 selfexec := !selfexec ^
" -f " ^
Filename.quote
s;
6380 "<path> Set path to the user interface font");
6384 selfexec := !selfexec ^
" -c " ^
Filename.quote
s;
6385 Config.confpath
:= s),
6386 "<path> Set path to the configuration file");
6388 ("-last", Arg.Set
openlast, " Open last document");
6390 ("-page", Arg.Int
(fun pageno1
-> pageno := Some
(pageno1
-1)),
6391 "<page-number> Jump to page");
6393 ("-tcf", Arg.String
(fun s -> trimcachepath := s),
6394 "<path> Set path to the trim cache file");
6396 ("-dest", Arg.String
(fun s -> state
.nameddest
<- s),
6397 "<named-destination> Set named destination");
6399 ("-wtmode", Arg.Set
wtmode, " Operate in wt mode");
6400 ("-cxack", Arg.Set
cxack, " Cut corners");
6402 ("-remote", Arg.String
(fun s -> rcmdpath := s),
6403 "<path> Set path to the remote commands source");
6405 ("-origin", Arg.String
(fun s -> state
.origin
<- s),
6406 "<original-path> Set original path");
6408 ("-gc", Arg.Set_string
gcconfig,
6409 "<script-path> Collect garbage with the help of a script");
6411 ("-nofc", Arg.Set
nofc, " Do not use fontconfig");
6413 ("-v", Arg.Unit
(fun () ->
6415 "%s\nconfiguration path: %s\n"
6419 exit
0), " Print version and exit");
6421 ("-embed", Arg.Set_int
rootwid,
6422 "<window-id> Embed into window")
6425 (fun s -> state
.path <- s)
6426 ("Usage: " ^
Sys.argv
.(0) ^
" [options] some.pdf\nOptions:")
6429 then selfexec := !selfexec ^
" -wtmode";
6431 let histmode = emptystr state
.path && not
!openlast in
6433 if not
(Config.load !openlast)
6434 then prerr_endline
"failed to load configuration";
6435 begin match !pageno with
6436 | Some
pageno -> state
.anchor <- (pageno, 0.0, 0.0)
6440 if nonemptystr
!gcconfig
6443 match Unix.socketpair
Unix.PF_UNIX
Unix.SOCK_STREAM
0 with
6445 error
"gc socketpair failed: %s" (exntos exn
)
6448 match addpid
@@ popen
!gcconfig [(c, 0); (c, 1)] with
6450 error
"failed to popen gc script: %s" (exntos exn
);
6456 let wsfd, winw, winh
= Wsi.init
(object (self)
6457 val mutable m_clicks
= 0
6458 val mutable m_click_x
= 0
6459 val mutable m_click_y
= 0
6460 val mutable m_lastclicktime
= infinity
6462 method private cleanup =
6463 state
.roam
<- noroam
;
6464 Hashtbl.iter
(fun _ opaque -> clearmark
opaque) state
.pagemap
6465 method expose
= G.postRedisplay"expose"
6469 | Wsi.Unobscured
-> "unobscured"
6470 | Wsi.PartiallyObscured
-> "partiallyobscured"
6471 | Wsi.FullyObscured
-> "fullyobscured"
6473 vlog "visibility change %s" name
6474 method display = display ()
6475 method map mapped
= vlog "mappped %b" mapped
6476 method reshape w h =
6479 method mouse
b d x y m =
6480 if d && canselect ()
6482 (* http://blogs.msdn.com/b/oldnewthing/archive/2004/10/18/243925.aspx *)
6488 if abs
x - m_click_x
> 10
6489 || abs
y - m_click_y
> 10
6490 || abs_float
(t -. m_lastclicktime
) > 0.3
6492 m_clicks
<- m_clicks
+ 1;
6493 m_lastclicktime
<- t;
6497 G.postRedisplay "cleanup";
6498 state
.uioh <- state
.uioh#button
b d x y m;
6500 else state
.uioh <- state
.uioh#multiclick m_clicks
x y m
6505 m_lastclicktime
<- infinity
;
6506 state
.uioh <- state
.uioh#button
b d x y m
6510 state
.uioh <- state
.uioh#button
b d x y m
6513 state
.mpos
<- (x, y);
6514 state
.uioh <- state
.uioh#motion
x y
6515 method pmotion
x y =
6516 state
.mpos
<- (x, y);
6517 state
.uioh <- state
.uioh#pmotion
x y
6519 let mascm = m land (
6520 Wsi.altmask
+ Wsi.shiftmask
+ Wsi.ctrlmask
+ Wsi.metamask
6523 let x = state
.x and y = state
.y in
6525 if x != state
.x || y != state
.y then self#
cleanup
6527 match state
.keystate
with
6529 let km = k
, mascm in
6532 let modehash = state
.uioh#
modehash in
6533 try Hashtbl.find modehash km
6535 try Hashtbl.find (findkeyhash conf
"global") km
6536 with Not_found
-> KMinsrt
(k
, m)
6538 | KMinsrt
(k
, m) -> keyboard k
m
6539 | KMinsrl
l -> List.iter
(fun (k
, m) -> keyboard k
m) l
6540 | KMmulti
(l, r
) -> state
.keystate
<- KSinto
(l, r
)
6542 | KSinto
((k'
, m'
) :: [], insrt
) when k'
=k
&& m'
land mascm = m'
->
6543 List.iter
(fun (k
, m) -> keyboard k
m) insrt
;
6544 state
.keystate
<- KSnone
6545 | KSinto
((k'
, m'
) :: keys, insrt
) when k'
=k
&& m'
land mascm = m'
->
6546 state
.keystate
<- KSinto
(keys, insrt
)
6547 | KSinto
_ -> state
.keystate
<- KSnone
6550 state
.mpos
<- (x, y);
6551 state
.uioh <- state
.uioh#pmotion
x y
6552 method leave = state
.mpos
<- (-1, -1)
6553 method winstate wsl
= state
.winstate
<- wsl
6554 method quit
= raise Quit
6555 end) !rootwid conf
.cwinw conf
.cwinh platform
in
6560 List.exists
GlMisc.check_extension
6561 [ "GL_ARB_texture_rectangle"
6562 ; "GL_EXT_texture_recangle"
6563 ; "GL_NV_texture_rectangle" ]
6565 then (prerr_endline
"OpenGL does not suppport rectangular textures"; exit
1);
6568 let r = GlMisc.get_string `renderer
in
6569 let p = "Mesa DRI Intel(" in
6570 let l = String.length
p in
6571 String.length
r > l && String.sub
r 0 l = p
6574 defconf
.sliceheight
<- 1024;
6575 defconf
.texcount
<- 32;
6576 defconf
.usepbo
<- true;
6580 match Unix.socketpair
Unix.PF_UNIX
Unix.SOCK_STREAM
0 with
6582 Printf.eprintf
"socketpair failed: %s" (exntos exn
);
6590 setcheckers conf
.checkers
;
6592 if conf
.redirectstderr
6596 (Buffer.to_bytes state
.errmsgs
)
6597 (match state
.errfd
with
6599 let s = Bytes.create
(80*24) in
6602 let r, _, _ = Unix.select
[fd
] [] [] 0.0 in
6604 then Unix.read fd
s 0 (Bytes.length
s)
6610 else Bytes.sub
s 0 n
6614 try ignore
(Unix.write state
.stderr
s 0 (Bytes.length
s))
6615 with exn
-> print_endline
(exntos exn
)
6620 conf
.angle
, conf
.fitmodel
, (conf
.trimmargins
, conf
.trimfuzz
),
6621 conf
.texcount
, conf
.sliceheight
, conf
.mustoresize
, conf
.colorspace
,
6622 !Config.fontpath
, !trimcachepath,
6623 GlMisc.check_extension
"GL_ARB_pixel_buffer_object",
6626 List.iter
GlArray.enable
[`texture_coord
; `vertex
];
6628 reshape ~firsttime
:true winw winh
;
6632 Wsi.settitle
"llpp (history)";
6636 state
.text <- "Opening " ^
(mbtoutf8 state
.path);
6637 opendoc state
.path state
.password;
6641 Sys.set_signal
Sys.sighup
(Sys.Signal_handle
(fun _ -> reload ()));
6644 match Unix.waitpid
[Unix.WNOHANG
] ~
-1 with
6645 | (exception (Unix.Unix_error
(Unix.ECHILD
, _, _))) -> ()
6646 | (exception exn
) -> dolog
"Unix.waitpid: %s" @@ exntos exn
6648 | _pid
, _status
-> reap ()
6650 Sys.set_signal
Sys.sigchld
(Sys.Signal_handle
(fun _ -> doreap := true));
6654 if nonemptystr
!rcmdpath
6655 then remoteopen !rcmdpath
6660 let rec loop deadline
=
6667 match state
.errfd
with
6668 | None
-> [state
.ss; state
.wsfd]
6669 | Some fd
-> [state
.ss; state
.wsfd; fd
]
6674 | Some fd
-> fd
:: r
6678 state
.redisplay
<- false;
6685 if deadline
= infinity
6687 else max
0.0 (deadline
-. now)
6692 try Unix.select
r [] [] timeout
6693 with Unix.Unix_error
(Unix.EINTR
, _, _) -> [], [], []
6699 if state
.ghyll
== noghyll
6701 match state
.autoscroll
with
6702 | Some step
when step
!= 0 ->
6703 let y = state
.y + step
in
6707 else if y >= state
.maxy then 0 else y
6710 if state
.mode = View
6711 then state
.text <- E.s;
6714 else deadline
+. 0.01
6719 let rec checkfds = function
6721 | fd
:: rest
when fd
= state
.ss ->
6722 let cmd = readcmd state
.ss in
6726 | fd
:: rest
when fd
= state
.wsfd ->
6730 | fd
:: rest
when Some fd
= !optrfd ->
6731 begin match remote fd
with
6732 | None
-> optrfd := remoteopen !rcmdpath;
6733 | opt -> optrfd := opt
6738 let s = Bytes.create
80 in
6739 let n = tempfailureretry
(Unix.read fd
s 0) 80 in
6740 if conf
.redirectstderr
6742 Buffer.add_substring state
.errmsgs
(Bytes.to_string
s) 0 n;
6743 state
.newerrmsgs
<- true;
6744 state
.redisplay
<- true;
6747 prerr_string
(String.sub
(Bytes.to_string
s) 0 n);
6755 if deadline
= infinity
6759 match state
.autoscroll
with
6760 | Some step
when step
!= 0 -> deadline1
6761 | _ -> if state
.ghyll
== noghyll
then infinity
else deadline1
6769 Config.save leavebirdseye;
6770 if hasunsavedchanges
()