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
4248 | (exception exn
) ->
4250 Printf.sprintf
"waitpid(%d) failed: %s" pid (exntos exn
);
4254 | Unix.WEXITED
0 -> filelines
tmppath
4257 Printf.sprintf
"editor process(%s) exited abnormally: %d"
4260 | Unix.WSIGNALED
n ->
4262 Printf.sprintf
"editor process(%s) was killed by signal %d"
4265 | Unix.WSTOPPED
n ->
4267 Printf.sprintf
"editor(%s) process was stopped by signal %d"
4271 match Unix.unlink
tmppath with
4272 | (exception exn
) ->
4273 showtext '
!'
@@ Printf.sprintf
"failed to ulink %S: %s"
4274 tmppath (exntos exn
);
4279 let enterannotmode opaque slinkindex
=
4282 inherit lvsourcebase
4283 val mutable m_text
= E.s
4284 val mutable m_items
= E.a
4286 method getitemcount
= Array.length m_items
4289 let label, _func
= m_items
.(n) in
4292 method exit ~
uioh ~cancel ~
active ~
first ~pan
=
4293 ignore
(uioh, first, pan
);
4296 let _label, func
= m_items
.(active) in
4301 method hasaction
n = nonemptystr
@@ fst m_items
.(n)
4304 let rec split accu b i
=
4306 if p = String.length
s
4307 then (String.sub
s b (p-b), unit) :: accu
4309 if (i
> 70 && s.[p] = ' '
) || s.[p] = '
\r'
|| s.[p] = '
\n'
4311 let ss = if i
= 0 then E.s else String.sub
s b i
in
4312 split ((ss, unit)::accu) (p+1) 0
4317 wcmd "freepage %s" (~
> opaque);
4319 Hashtbl.fold (fun key opaque'
accu ->
4320 if opaque'
= opaque'
4321 then key :: accu else accu) state
.pagemap
[]
4323 List.iter
(Hashtbl.remove state
.pagemap
) keys;
4328 delannot
opaque slinkindex
;
4331 let edit inline
() =
4336 modannot
opaque slinkindex
s;
4342 let mode = state
.mode in
4345 ("annotation: ", m_text
, None
, textentry, update, true),
4346 fun _ -> state
.mode <- mode);
4350 let s = getusertext m_text
in
4355 ( "[Copy]", fun () -> selstring m_text
)
4356 :: ("[Delete]", dele)
4357 :: ("[Edit]", edit conf
.annotinline
)
4359 :: split [] 0 0 |> List.rev
|> Array.of_list
4366 let s = getannotcontents
opaque slinkindex
in
4369 let source = (msgsource :> lvsource
) in
4370 let modehash = findkeyhash conf
"listview" in
4371 state
.uioh <- coe (object
4372 inherit listview ~zebra
:false ~helpmode
:false
4373 ~
source ~trusted
:false ~
modehash
4375 G.postRedisplay "enterannotmode";
4378 let gotounder under =
4379 let getpath filename
=
4381 if nonemptystr filename
4383 if Filename.is_relative filename
4385 let dir = Filename.dirname state
.path in
4387 if Filename.is_implicit
dir
4388 then Filename.concat
(Sys.getcwd
()) dir
4391 Filename.concat
dir filename
4395 if Sys.file_exists
path
4400 | Ulinkgoto
(pageno, top) ->
4404 gotopage1 pageno top;
4410 | Uremote
(filename
, pageno) ->
4411 let path = getpath filename
in
4416 let command = Printf.sprintf
"%s -page %d %S" !selfexec pageno path in
4417 try addpid
@@ popen
command []
4419 Printf.eprintf
"failed to execute `%s': %s\n" command (exntos exn
);
4422 let anchor = getanchor
() in
4423 let ranchor = state
.path, state
.password, anchor, state
.origin
in
4424 state
.origin
<- E.s;
4425 state
.anchor <- (pageno, 0.0, 0.0);
4426 state
.ranchors
<- ranchor :: state
.ranchors
;
4429 else showtext '
!'
("Could not find " ^ filename
)
4431 | Uremotedest
(filename
, destname
) ->
4432 let path = getpath filename
in
4437 let command = !selfexec ^
" " ^
path ^
" -dest " ^ destname
in
4438 try addpid
@@ popen
command []
4441 "failed to execute `%s': %s\n" command (exntos exn
);
4444 let anchor = getanchor
() in
4445 let ranchor = state
.path, state
.password, anchor, state
.origin
in
4446 state
.origin
<- E.s;
4447 state
.nameddest
<- destname
;
4448 state
.ranchors
<- ranchor :: state
.ranchors
;
4451 else showtext '
!'
("Could not find " ^ filename
)
4453 | Uunexpected
_ | Ulaunch
_ | Unamed
_ | Utext
_ | Unone
-> ()
4454 | Uannotation
(opaque, slinkindex
) -> enterannotmode opaque slinkindex
4457 let gotooutline (_, _, kind
) =
4461 let (pageno, y, _) = anchor in
4463 (if conf
.presentation
then (pageno, y, 1.0) else anchor)
4468 | Ouri
uri -> gotounder (Ulinkuri
uri); None
4469 | Olaunch cmd
-> gotounder (Ulaunch cmd
); None
4470 | Oremote remote
-> gotounder (Uremote remote
); None
4471 | Ohistory
hist -> gotohist hist; None
4472 | Oremotedest remotedest
-> gotounder (Uremotedest remotedest
); None
4473 | Oaction
f -> f (); None
4474 | Oreaction
f -> Some
(f ())
4477 let outlinesource sourcetype
=
4479 inherit lvsourcebase
4480 val mutable m_items
= E.a
4481 val mutable m_minfo
= E.a
4482 val mutable m_orig_items
= E.a
4483 val mutable m_orig_minfo
= E.a
4484 val mutable m_narrow_patterns
= []
4485 val mutable m_hadremovals
= false
4486 val mutable m_gen
= -1
4488 method getitemcount
=
4489 Array.length m_items
+ (if m_hadremovals
then 1 else 0)
4492 if n == Array.length m_items
&& m_hadremovals
4494 ("[Confirm removal]", 0)
4496 let s, n, _ = m_items
.(n) in
4499 method exit ~
uioh ~cancel ~
active ~
first ~pan
=
4500 ignore
(uioh, first);
4501 let confrimremoval = m_hadremovals
&& active = Array.length m_items
in
4503 if m_narrow_patterns
= []
4504 then m_orig_items
, m_orig_minfo
4505 else m_items
, m_minfo
4510 if not
confrimremoval
4514 match gotooutline m_items
.(active) with
4517 self#reset emptyanchor outlines
;
4521 state
.bookmarks
<- Array.to_list m_items
;
4522 m_orig_items
<- m_items
;
4523 m_orig_minfo
<- m_minfo
;
4533 method hasaction
_ = true
4536 if Array.length m_items
!= Array.length m_orig_items
4539 match m_narrow_patterns
with
4541 | many
-> String.concat
"@Uellipsis" (List.rev many
)
4543 "Narrowed to " ^
s ^
" (ctrl-u to restore)"
4547 match m_narrow_patterns
with
4550 | head
:: _ -> "@Uellipsis" ^ head
4552 method narrow
pattern =
4553 let reopt = try Some
(Str.regexp_case_fold
pattern) with _ -> None
in
4557 let rec loop accu minfo n =
4560 m_items
<- Array.of_list
accu;
4561 m_minfo
<- Array.of_list
minfo;
4564 let (s, _, t
) as o = m_items
.(n) in
4567 | Oaction
_ | Oreaction
_ -> o :: accu, (0, 0) :: minfo
4568 | Onone
| Oanchor
_ | Ouri
_ | Olaunch
_
4569 | Oremote
_ | Oremotedest
_ | Ohistory
_ ->
4571 try Str.search_forward
re s 0
4572 with Not_found
-> -1
4575 then o :: accu, (first, Str.match_end
()) :: minfo
4578 loop accu minfo (n-1)
4580 loop [] [] (Array.length m_items
- 1)
4582 method! getminfo
= m_minfo
4586 match sourcetype
with
4587 | `bookmarks
-> Array.of_list state
.bookmarks
4588 | `outlines
-> state
.outlines
4589 | `history
-> genhistoutlines ()
4591 m_minfo
<- m_orig_minfo
;
4592 m_items
<- m_orig_items
4595 if sourcetype
= `bookmarks
4597 if m >= 0 && m < Array.length m_items
4599 m_hadremovals
<- true;
4600 m_items
<- Array.init
(Array.length m_items
- 1) (fun n ->
4601 let n = if n >= m then n+1 else n in
4606 method add_narrow_pattern
pattern =
4607 m_narrow_patterns
<- pattern :: m_narrow_patterns
4609 method del_narrow_pattern
=
4610 match m_narrow_patterns
with
4611 | _ :: rest
-> m_narrow_patterns
<- rest
4616 match m_narrow_patterns
with
4617 | pattern :: [] -> self#narrow
pattern; pattern
4619 List.fold_left
(fun accu pattern ->
4620 self#narrow
pattern;
4621 pattern ^
"@Uellipsis" ^
accu) E.s list
4623 method calcactive
anchor =
4624 let rely = getanchory anchor in
4625 let rec loop n best bestd
=
4626 if n = Array.length m_items
4629 let _, _, kind
= m_items
.(n) in
4632 let orely = getanchory anchor in
4633 let d = abs
(orely - rely) in
4636 else loop (n+1) best bestd
4637 | Onone
| Oremote
_ | Olaunch
_
4638 | Oremotedest
_ | Ouri
_ | Ohistory
_ | Oaction
_ | Oreaction
_ ->
4639 loop (n+1) best bestd
4643 method reset
anchor items =
4644 m_hadremovals
<- false;
4645 if state
.gen
!= m_gen
4647 m_orig_items
<- items;
4649 m_narrow_patterns
<- [];
4651 m_orig_minfo
<- E.a;
4655 if items != m_orig_items
4657 m_orig_items
<- items;
4658 if m_narrow_patterns
== []
4659 then m_items
<- items;
4662 let active = self#calcactive
anchor in
4664 m_first
<- firstof m_first
active
4668 let enterselector sourcetype
=
4670 let source = outlinesource sourcetype
in
4673 match sourcetype
with
4674 | `bookmarks
-> Array.of_list state
.bookmarks
4675 | `
outlines -> state
.outlines
4676 | `history
-> genhistoutlines ()
4678 if Array.length
outlines = 0
4680 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";
4693 let enteroutlinemode () = enterselector `
outlines "Document has no outline";;
4694 let enterbookmarkmode () =
4695 enterselector `bookmarks
"Document has no bookmarks (yet)"
4697 let enterhistmode () = enterselector `history
"No history (yet)";;
4699 let quickbookmark ?title
() =
4700 match state
.layout with
4706 let tm = Unix.localtime
(now
()) in
4708 "Quick (page %d) (bookmarked at %02d/%02d/%d %02d:%02d)"
4712 (tm.Unix.tm_year
+ 1900)
4715 | Some
title -> title
4717 state
.bookmarks
<- (title, 0, Oanchor
(getanchor1
l)) :: state
.bookmarks
4720 let setautoscrollspeed step goingdown
=
4721 let incr = max
1 ((abs step
) / 2) in
4722 let incr = if goingdown
then incr else -incr in
4723 let astep = boundastep state
.winh
(step
+ incr) in
4724 state
.autoscroll
<- Some
astep;
4728 match conf
.columns
with
4730 | Csingle
_ | Cmulti
_ -> state
.x != 0 || conf
.zoom > 1.0
4733 let panbound x = bound
x (-state
.w) (wadjsb () + state
.winw
);;
4735 let existsinrow pageno (columns
, coverA
, coverB
) p =
4736 let last = ((pageno - coverA
) mod columns
) + columns
in
4737 let rec any = function
4740 if l.pageno = coverA
- 1 || l.pageno = state
.pagecount
- coverB
4744 then (if l.pageno = last then false else any rest
)
4752 match state
.layout with
4754 let pageno = page_of_y state
.y in
4755 gotoghyll (getpagey
(pageno+1))
4757 match conf
.columns
with
4759 if conf
.presentation
&& rest
== [] && l.pageh
> l.pagey + l.pagevh
4761 let y = clamp (pgscale state
.winh
) in
4764 let pageno = min
(l.pageno+1) (state
.pagecount
-1) in
4765 gotoghyll (getpagey
pageno)
4766 | Cmulti
((c, _, _) as cl, _) ->
4767 if conf
.presentation
4768 && (existsinrow l.pageno cl
4769 (fun l -> l.pageh
> l.pagey + l.pagevh))
4771 let y = clamp (pgscale state
.winh
) in
4774 let pageno = min
(l.pageno+c) (state
.pagecount
-1) in
4775 gotoghyll (getpagey
pageno)
4777 if l.pageno < state
.pagecount
- 1 || l.pagecol
< n - 1
4779 let pagey, pageh
= getpageyh
l.pageno in
4780 let pagey = pagey + pageh
* l.pagecol
in
4781 let ips = if l.pagecol
= 0 then 0 else conf
.interpagespace
in
4782 gotoghyll (pagey + pageh
+ ips)
4786 match state
.layout with
4788 let pageno = page_of_y state
.y in
4789 gotoghyll (getpagey
(pageno-1))
4791 match conf
.columns
with
4793 if conf
.presentation
&& l.pagey != 0
4795 gotoghyll (clamp (pgscale ~
-(state
.winh
)))
4797 let pageno = max
0 (l.pageno-1) in
4798 gotoghyll (getpagey
pageno)
4799 | Cmulti
((c, _, coverB
) as cl, _) ->
4800 if conf
.presentation
&&
4801 (existsinrow l.pageno cl (fun l -> l.pagey != 0))
4803 gotoghyll (clamp (pgscale ~
-(state
.winh
)))
4806 if l.pageno = state
.pagecount
- coverB
4810 let pageno = max
0 (l.pageno-decr) in
4811 gotoghyll (getpagey
pageno)
4819 let pageno = max
0 (l.pageno-1) in
4820 let pagey, pageh
= getpageyh
pageno in
4823 let pagey, pageh
= getpageyh
l.pageno in
4824 pagey + pageh
* (l.pagecol
-1) - conf
.interpagespace
4830 if emptystr conf
.savecmd
4831 then error
"don't know where to save modified document"
4833 let savecmd = Str.global_replace percentsre state
.path conf
.savecmd in
4836 (fun s -> error
"failed to obtain path to the saved copy: %s" s)
4841 let tmp = path ^
".tmp" in
4843 Unix.rename
tmp path;
4846 let viewkeyboard key mask
=
4848 let mode = state
.mode in
4849 state
.mode <- Textentry
(te, fun _ -> state
.mode <- mode);
4852 G.postRedisplay "view:enttext"
4854 let ctrl = Wsi.withctrl mask
in
4856 if key >= 0xffb0 && key < 0xffb9 then key - 0xffb0 + 48 else key
4862 if hasunsavedchanges
()
4866 if conf
.angle
mod 360 = 0 && not
(isbirdseye state
.mode)
4868 state
.mode <- LinkNav
(Ltgendir
0);
4871 else showtext '
!'
"Keyboard link navigation does not work under rotation"
4874 begin match state
.mstate
with
4877 G.postRedisplay "kill rect";
4880 | Mscrolly
| Mscrollx
4883 begin match state
.mode with
4886 G.postRedisplay "esc leave linknav"
4890 match state
.ranchors
with
4892 | (path, password, anchor, origin
) :: rest
->
4893 state
.ranchors
<- rest
;
4894 state
.anchor <- anchor;
4895 state
.origin
<- origin
;
4896 state
.nameddest
<- E.s;
4897 opendoc path password
4902 gotoghyll (getnav ~
-1)
4913 Hashtbl.iter
(fun _ opaque -> clearmark
opaque) state
.pagemap
;
4914 G.postRedisplay "dehighlight";
4916 | @slash
| @question
->
4917 let ondone isforw
s =
4918 cbput state
.hists
.pat
s;
4919 state
.searchpattern
<- s;
4922 let s = String.make
1 (Char.chr
key) in
4923 enttext (s, E.s, Some
(onhist state
.hists
.pat
),
4924 textentry, ondone (key = @slash
), true)
4926 | @plus
| @kpplus
| @equals
when ctrl ->
4927 let incr = if conf
.zoom +. 0.01 > 0.1 then 0.1 else 0.01 in
4928 setzoom (conf
.zoom +. incr)
4930 | @plus
| @kpplus
->
4933 try int_of_string
s with exc
->
4934 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
);
4940 state
.text <- "page bias is now " ^ string_of_int
n;
4943 enttext ("page bias: ", E.s, None
, intentry, ondone, true)
4945 | @minus
| @kpminus
when ctrl ->
4946 let decr = if conf
.zoom -. 0.1 < 0.1 then 0.01 else 0.1 in
4947 setzoom (max
0.01 (conf
.zoom -. decr))
4949 | @minus
| @kpminus
->
4950 let ondone msg
= state
.text <- msg
in
4952 "option [acfhilpstvxACFPRSZTISM]: ", E.s, None
,
4953 optentry state
.mode, ondone, true
4964 | (@1 | @2) when ctrl && conf
.fitmodel
!= FitPage
-> (* ctrl-1/2 *)
4966 match conf
.columns
with
4967 | Csingle
_ | Cmulti
_ -> 1
4968 | Csplit
(n, _) -> n
4970 let h = state
.winh
-
4971 conf
.interpagespace
lsl (if conf
.presentation
then 1 else 0)
4973 let zoom = zoomforh state
.winw
h (vscrollw ()) cols in
4974 if zoom > 0.0 && (key = 50 || zoom < 1.0)
4979 match conf
.fitmodel
with
4980 | FitWidth
-> FitProportional
4981 | FitProportional
-> FitPage
4982 | FitPage
-> FitWidth
4984 state
.text <- "fit model: " ^
FMTE.to_string
fm;
4985 reqlayout conf
.angle
fm
4993 | (48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57)
4994 when not
ctrl -> (* 0..9 *)
4997 try int_of_string
s with exc
->
4998 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
);
5004 cbput state
.hists
.pag
(string_of_int
n);
5005 gotopage1 (n + conf
.pagebias
- 1) 0;
5008 let pageentry text key =
5009 match Char.unsafe_chr
key with
5010 | '
g'
-> TEdone
text
5011 | _ -> intentry text key
5013 let text = String.make
1 (Char.chr
key) in
5014 enttext (":", text, Some
(onhist state
.hists
.pag
),
5015 pageentry, ondone, true)
5018 conf
.scrollb
<- if conf
.scrollb
= 0 then (scrollbvv
lor scrollbhv
) else 0;
5019 reshape state
.winw state
.winh
;
5022 state
.bzoom
<- not state
.bzoom
;
5024 showtext ' '
("block zoom " ^
if state
.bzoom
then "on" else "off")
5027 conf
.hlinks
<- not conf
.hlinks
;
5028 state
.text <- "highlightlinks " ^
if conf
.hlinks
then "on" else "off";
5029 G.postRedisplay "toggle highlightlinks";
5032 state
.glinks
<- true;
5033 let mode = state
.mode in
5034 state
.mode <- Textentry
(
5035 (":", E.s, None
, linknentry, linknact gotounder, false),
5037 state
.glinks
<- false;
5041 G.postRedisplay "view:linkent(F)"
5044 state
.glinks
<- true;
5045 let mode = state
.mode in
5046 state
.mode <- Textentry
(
5048 ":", E.s, None
, linknentry, linknact (fun under ->
5049 selstring (undertext under);
5053 state
.glinks
<- false;
5057 G.postRedisplay "view:linkent"
5060 begin match state
.autoscroll
with
5062 conf
.autoscrollstep
<- step
;
5063 state
.autoscroll
<- None
5065 if conf
.autoscrollstep
= 0
5066 then state
.autoscroll
<- Some
1
5067 else state
.autoscroll
<- Some conf
.autoscrollstep
5074 setpresentationmode (not conf
.presentation
);
5075 showtext ' '
("presentation mode " ^
5076 if conf
.presentation
then "on" else "off");
5079 if List.mem
Wsi.Fullscreen state
.winstate
5080 then Wsi.reshape conf
.cwinw conf
.cwinh
5081 else Wsi.fullscreen
()
5084 search state
.searchpattern
false
5087 search state
.searchpattern
true
5090 begin match state
.layout with
5093 gotoghyll (getpagey
l.pageno)
5099 | @delete
| @kpdelete
-> (* delete *)
5103 showtext ' '
(describe_location ());
5106 begin match state
.layout with
5109 Wsi.reshape (l.pagew
+ vscrollw ()) l.pageh
;
5114 enterbookmarkmode ()
5122 | @e when Buffer.length state
.errmsgs
> 0 ->
5127 match state
.layout with
5132 (s, 0, Oanchor
(getanchor1
l)) :: state
.bookmarks
5135 enttext ("bookmark: ", E.s, None
, textentry, ondone, true)
5139 showtext ' '
"Quick bookmark added";
5142 begin match state
.layout with
5144 let rect = getpdimrect
l.pagedimno
in
5148 (truncate
(1.8 *. (rect.(1) -. rect.(0))),
5149 truncate
(1.2 *. (rect.(3) -. rect.(0))))
5151 (truncate
(rect.(1) -. rect.(0)),
5152 truncate
(rect.(3) -. rect.(0)))
5154 let w = truncate
((float w)*.conf
.zoom)
5155 and h = truncate
((float h)*.conf
.zoom) in
5158 state
.anchor <- getanchor
();
5159 Wsi.reshape (w + vscrollw ()) (h + conf
.interpagespace
)
5161 G.postRedisplay "z";
5166 | @x -> state
.roam
()
5169 reqlayout (conf
.angle
+
5170 (if key = @Gt
then 30 else -30)) conf
.fitmodel
5174 bound
(conf
.colorscale
+. (if key = 93 then 0.1 else -0.1)) 0.0 1.0
5176 G.postRedisplay "brightness";
5178 | @c when state
.mode = View
->
5183 let m = (wadjsb () + state
.winw
- state
.w) / 2 in
5185 gotoy_and_clear_text state
.y
5189 match state
.prevcolumns
with
5190 | None
-> (1, 0, 0), 1.0
5191 | Some
(columns
, z
) ->
5194 | Csplit
(c, _) -> -c, 0, 0
5195 | Cmulti
((c, a, b), _) -> c, a, b
5196 | Csingle
_ -> 1, 0, 0
5200 setcolumns View
c a b;
5203 | @down
| @up
when ctrl && Wsi.withshift mask
->
5204 let zoom, x = state
.prevzoom
in
5208 | @k
| @up
| @kpup
->
5209 begin match state
.autoscroll
with
5211 begin match state
.mode with
5212 | Birdseye beye
-> upbirdseye 1 beye
5217 then gotoy_and_clear_text (clamp ~
-(state
.winh
/2))
5219 if not
(Wsi.withshift mask
) && conf
.presentation
5221 else gotoghyll1 true (clamp (-conf
.scrollstep
))
5225 setautoscrollspeed n false
5228 | @j
| @down
| @kpdown
->
5229 begin match state
.autoscroll
with
5231 begin match state
.mode with
5232 | Birdseye beye
-> downbirdseye 1 beye
5237 then gotoy_and_clear_text (clamp (state
.winh
/2))
5239 if not
(Wsi.withshift mask
) && conf
.presentation
5241 else gotoghyll1 true (clamp (conf
.scrollstep
))
5245 setautoscrollspeed n true
5248 | @left | @right
| @kpleft
| @kpright
when not
(Wsi.withalt mask
) ->
5254 else conf
.hscrollstep
5256 let dx = if key = @left || key = @kpleft
then dx else -dx in
5257 state
.x <- panbound (state
.x + dx);
5258 gotoy_and_clear_text state
.y
5261 G.postRedisplay "left/right"
5264 | @prior
| @kpprior
->
5268 match state
.layout with
5270 | l :: _ -> state
.y - l.pagey
5272 clamp (pgscale (-state
.winh
))
5276 | @next | @kpnext
->
5280 match List.rev state
.layout with
5282 | l :: _ -> getpagey
l.pageno
5284 clamp (pgscale state
.winh
)
5288 | @g | @home
| @kphome
->
5291 | @G
| @jend
| @kpend
->
5293 gotoghyll (clamp state
.maxy)
5295 | @right
| @kpright
when Wsi.withalt mask
->
5296 gotoghyll (getnav 1)
5297 | @left | @kpleft
when Wsi.withalt mask
->
5298 gotoghyll (getnav ~
-1)
5303 | @v when conf
.debug
->
5306 match getopaque l.pageno with
5309 let x0, y0, x1, y1 = pagebbox
opaque in
5310 let a,b = float x0, float y0 in
5311 let c,d = float x1, float y0 in
5312 let e,f = float x1, float y1 in
5313 let h,j
= float x0, float y1 in
5314 let rect = (a,b,c,d,e,f,h,j
) in
5316 state
.rects
<- (l.pageno, l.pageno mod 3, rect) :: state
.rects
;
5318 G.postRedisplay "v";
5321 let mode = state
.mode in
5322 let cmd = ref E.s in
5323 let onleave = function
5324 | Cancel
-> state
.mode <- mode
5327 match getopaque l.pageno with
5328 | Some
opaque -> pipesel opaque !cmd
5329 | None
-> ()) state
.layout;
5333 cbput state
.hists
.sel
s;
5337 "| ", !cmd, Some
(onhist state
.hists
.sel
), textentry, ondone, true
5339 G.postRedisplay "|";
5340 state
.mode <- Textentry
(te, onleave);
5343 vlog "huh? %s" (Wsi.keyname
key)
5346 let linknavkeyboard key mask
linknav =
5347 let getpage pageno =
5348 let rec loop = function
5350 | l :: _ when l.pageno = pageno -> Some
l
5351 | _ :: rest
-> loop rest
5352 in loop state
.layout
5354 let doexact (pageno, n) =
5355 match getopaque pageno, getpage pageno with
5356 | Some
opaque, Some
l ->
5357 if key = @enter
|| key = @kpenter
5359 let under = getlink
opaque n in
5360 G.postRedisplay "link gotounder";
5367 Some
(findlink
opaque LDfirst
), -1
5370 Some
(findlink
opaque LDlast
), 1
5373 Some
(findlink
opaque (LDleft
n)), -1
5376 Some
(findlink
opaque (LDright
n)), 1
5379 Some
(findlink
opaque (LDup
n)), -1
5382 Some
(findlink
opaque (LDdown
n)), 1
5387 begin match findpwl
l.pageno dir with
5391 state
.mode <- LinkNav
(Ltgendir
dir);
5392 let y, h = getpageyh
pageno in
5395 then y + h - state
.winh
5400 begin match getopaque pageno, getpage pageno with
5401 | Some
opaque, Some
_ ->
5403 let ld = if dir > 0 then LDfirst
else LDlast
in
5406 begin match link with
5408 showlinktype (getlink
opaque m);
5409 state
.mode <- LinkNav
(Ltexact
(pageno, m));
5410 G.postRedisplay "linknav jpage";
5411 | Lnotfound
-> notfound dir
5417 begin match opt with
5418 | Some Lnotfound
-> pwl l dir;
5419 | Some
(Lfound
m) ->
5423 let _, y0, _, y1 = getlinkrect
opaque m in
5425 then gotopage1 l.pageno y0
5427 let d = fstate
.fontsize
+ 1 in
5428 if y1 - l.pagey > l.pagevh - d
5429 then gotopage1 l.pageno (y1 - state
.winh
- hscrollh () + d)
5430 else G.postRedisplay "linknav";
5432 showlinktype (getlink
opaque m);
5433 state
.mode <- LinkNav
(Ltexact
(l.pageno, m));
5436 | None
-> viewkeyboard key mask
5438 | _ -> viewkeyboard key mask
5443 G.postRedisplay "leave linknav"
5447 | Ltgendir
_ | Ltnotready
_ -> viewkeyboard key mask
5448 | Ltexact exact
-> doexact exact
5451 let keyboard key mask
=
5452 if (key = 103 && Wsi.withctrl mask
) && not
(istextentry state
.mode)
5453 then wcmd "interrupt"
5454 else state
.uioh <- state
.uioh#
key key mask
5457 let birdseyekeyboard key mask
5458 ((oconf
, leftx
, pageno, hooverpageno
, anchor) as beye
) =
5460 match conf
.columns
with
5462 | Cmulti
((c, _, _), _) -> c
5463 | Csplit
_ -> failwith
"bird's eye split mode"
5465 let pgh layout = List.fold_left
5466 (fun m l -> max
l.pageh
m) state
.winh
layout in
5468 | @l when Wsi.withctrl mask
->
5469 let y, h = getpageyh
pageno in
5470 let top = (state
.winh
- h) / 2 in
5471 gotoy (max
0 (y - top))
5472 | @enter
| @kpenter
-> leavebirdseye beye
false
5473 | @escape
-> leavebirdseye beye
true
5474 | @up
-> upbirdseye incr beye
5475 | @down
-> downbirdseye incr beye
5476 | @left -> upbirdseye 1 beye
5477 | @right
-> downbirdseye 1 beye
5480 begin match state
.layout with
5484 state
.mode <- Birdseye
(
5485 oconf
, leftx
, l.pageno, hooverpageno
, anchor
5487 gotopage1 l.pageno 0;
5490 let layout = layout (state
.y-state
.winh
) (pgh state
.layout) in
5492 | [] -> gotoy (clamp (-state
.winh
))
5494 state
.mode <- Birdseye
(
5495 oconf
, leftx
, l.pageno, hooverpageno
, anchor
5497 gotopage1 l.pageno 0
5500 | [] -> gotoy (clamp (-state
.winh
))
5504 begin match List.rev state
.layout with
5506 let layout = layout (state
.y + (pgh state
.layout)) state
.winh
in
5507 begin match layout with
5509 let incr = l.pageh
- l.pagevh in
5514 oconf
, leftx
, state
.pagecount
- 1, hooverpageno
, anchor
5516 G.postRedisplay "birdseye pagedown";
5518 else gotoy (clamp (incr + conf
.interpagespace
*2));
5522 Birdseye
(oconf
, leftx
, l.pageno, hooverpageno
, anchor);
5523 gotopage1 l.pageno 0;
5526 | [] -> gotoy (clamp state
.winh
)
5530 state
.mode <- Birdseye
(oconf
, leftx
, 0, hooverpageno
, anchor);
5534 let pageno = state
.pagecount
- 1 in
5535 state
.mode <- Birdseye
(oconf
, leftx
, pageno, hooverpageno
, anchor);
5536 if not
(pagevisible state
.layout pageno)
5539 match List.rev state
.pdims
with
5541 | (_, _, h, _) :: _ -> h
5543 gotoy (max
0 (getpagey
pageno - (state
.winh
- h - conf
.interpagespace
)))
5544 else G.postRedisplay "birdseye end";
5546 | _ -> viewkeyboard key mask
5551 match state
.mode with
5552 | Textentry
_ -> scalecolor 0.4
5554 | View
-> scalecolor 1.0
5555 | Birdseye
(_, _, pageno, hooverpageno
, _) ->
5556 if l.pageno = hooverpageno
5559 if l.pageno = pageno
5561 let c = scalecolor 1.0 in
5563 GlDraw.line_width
3.0;
5564 let dispx = xadjsb () + l.pagedispx in
5566 (float (dispx-1)) (float (l.pagedispy-1))
5567 (float (dispx+l.pagevw+1))
5568 (float (l.pagedispy+l.pagevh+1))
5570 GlDraw.line_width
1.0;
5579 let postdrawpage l linkindexbase
=
5580 match getopaque l.pageno with
5582 if tileready l l.pagex
l.pagey
5584 let x = l.pagedispx - l.pagex
+ xadjsb ()
5585 and y = l.pagedispy - l.pagey in
5587 match conf
.columns
with
5588 | Csingle
_ | Cmulti
_ ->
5589 (if conf
.hlinks
then 1 else 0)
5591 && not
(isbirdseye state
.mode) then 2 else 0)
5595 match state
.mode with
5596 | Textentry
((_, s, _, _, _, _), _) when state
.glinks
-> s
5602 postprocess
opaque hlmask x y (linkindexbase
, s, conf
.hfsize
);
5607 let scrollindicator () =
5608 let sbw, ph
, sh = state
.uioh#
scrollph in
5609 let sbh, pw, sw = state
.uioh#scrollpw
in
5614 else ((state
.winw
- sbw), state
.winw
, 0)
5617 GlDraw.color (0.64, 0.64, 0.64);
5618 filledrect (float x0) 0. (float x1) (float state
.winh
);
5620 (float hx0
) (float (state
.winh
- sbh))
5621 (float (hx0
+ wadjsb () + state
.winw
)) (float state
.winh
)
5623 GlDraw.color (0.0, 0.0, 0.0);
5625 filledrect (float x0) ph
(float x1) (ph
+. sh);
5626 let pw = pw +. float hx0
in
5627 filledrect pw (float (state
.winh
- sbh)) (pw +. sw) (float state
.winh
);
5631 match state
.mstate
with
5632 | Mnone
| Mscrolly
| Mscrollx
| Mpan
_ | Mzoom
_ | Mzoomrect
_ ->
5635 | Msel
((x0, y0), (x1, y1)) ->
5636 let identify opaque l px py = Some
(opaque, l.pageno, px, py) in
5637 let o0,n0
,px0
,py0
= onppundermouse identify x0 y0 (~
< E.s, -1, 0, 0) in
5638 let _o1,n1
,px1
,py1
= onppundermouse identify x1 y1 (~
< E.s, -1, 0, 0) in
5639 if n0
!= -1 && n0
= n1
then seltext
o0 (px0
, py0
, px1
, py1
);
5642 let showrects = function [] -> () | rects
->
5644 GlDraw.color (0.0, 0.0, 1.0) ~
alpha:0.5;
5645 GlFunc.blend_func ~
src:`src_alpha ~dst
:`one_minus_src_alpha
;
5647 (fun (pageno, c, (x0, y0, x1, y1, x2
, y2
, x3
, y3
)) ->
5649 if l.pageno = pageno
5651 let dx = float (l.pagedispx - l.pagex
) in
5652 let dy = float (l.pagedispy - l.pagey) in
5653 GlDraw.color (0.0, 0.0, 1.0 /. float c) ~
alpha:0.5;
5654 Raw.sets_float state
.vraw ~
pos:0
5659 GlArray.vertex `two state
.vraw
;
5660 GlArray.draw_arrays `triangle_strip ~
first:0 ~count
:4;
5669 GlClear.color (scalecolor2 conf
.bgcolor
);
5670 GlClear.clear
[`
color];
5671 List.iter
drawpage state
.layout;
5673 match state
.mode with
5674 | LinkNav
(Ltexact
(pageno, linkno
)) ->
5675 begin match getopaque pageno with
5677 let dx = xadjsb () in
5678 let x0, y0, x1, y1 = getlinkrect
opaque linkno
in
5679 let x0 = x0 + dx and x1 = x1 + dx in
5686 | None
-> state
.rects
5688 | LinkNav
(Ltgendir
_) | LinkNav
(Ltnotready
_)
5691 | View
-> state
.rects
5694 let rec postloop linkindexbase
= function
5696 let linkindexbase = linkindexbase + postdrawpage l linkindexbase in
5697 postloop linkindexbase rest
5701 postloop 0 state
.layout;
5703 begin match state
.mstate
with
5704 | Mzoomrect
((x0, y0), (x1, y1)) ->
5706 GlDraw.color (0.3, 0.3, 0.3) ~
alpha:0.5;
5707 GlFunc.blend_func ~
src:`src_alpha ~dst
:`one_minus_src_alpha
;
5708 filledrect (float x0) (float y0) (float x1) (float y1);
5712 | Mscrolly
| Mscrollx
5721 let zoomrect x y x1 y1 =
5724 and y0 = min
y y1 in
5725 gotoy (state
.y + y0);
5726 state
.anchor <- getanchor
();
5727 let zoom = (float state
.w) /. float (x1 - x0) in
5730 let adjw = wadjsb () + state
.winw
in
5732 then (adjw - state
.w) / 2
5735 match conf
.fitmodel
with
5736 | FitWidth
| FitProportional
-> simple ()
5738 match conf
.columns
with
5740 onppundermouse (fun _ l _ _ -> Some
l.pagedispx) x0 y0 x0
5741 | Cmulti
_ | Csingle
_ -> simple ()
5743 state
.x <- (state
.x + margin) - x0;
5748 let annot inline
x y =
5749 match unproject x y with
5750 | Some
(opaque, n, ux
, uy
) ->
5752 addannot
opaque ux uy
text;
5753 wcmd "freepage %s" (~
> opaque);
5754 Hashtbl.remove state
.pagemap
(n, state
.gen
);
5760 let ondone s = add s in
5761 let mode = state
.mode in
5762 state
.mode <- Textentry
(
5763 ("annotation: ", E.s, None
, textentry, ondone, true),
5764 fun _ -> state
.mode <- mode);
5767 G.postRedisplay "annot"
5770 let s = getusertext E.s in
5771 let l = Str.split newlinere
s in
5779 let g opaque l px py =
5780 match rectofblock
opaque px py with
5782 let x0 = a.(0) -. 20. in
5783 let x1 = a.(1) +. 20. in
5784 let y0 = a.(2) -. 20. in
5785 let zoom = (float state
.w) /. (x1 -. x0) in
5786 let pagey = getpagey
l.pageno in
5787 gotoy_and_clear_text (pagey + truncate
y0);
5788 state
.anchor <- getanchor
();
5789 let margin = (state
.w - l.pagew
)/2 in
5790 state
.x <- -truncate
x0 - margin;
5795 match conf
.columns
with
5797 showtext '
!'
"block zooming does not work properly in split columns mode"
5798 | Cmulti
_ | Csingle
_ -> onppundermouse g x y ()
5802 let winw = wadjsb () + state
.winw - 1 in
5803 let s = float x /. float winw in
5804 let destx = truncate
(float (state
.w + winw) *. s) in
5805 state
.x <- winw - destx;
5806 gotoy_and_clear_text state
.y;
5807 state
.mstate
<- Mscrollx
;
5811 let s = float y /. float state
.winh
in
5812 let desty = truncate
(float (state
.maxy - state
.winh
) *. s) in
5813 gotoy_and_clear_text desty;
5814 state
.mstate
<- Mscrolly
;
5817 let viewmulticlick clicks
x y mask
=
5818 let g opaque l px py =
5826 if markunder
opaque px py mark
5830 match getopaque l.pageno with
5832 | Some
opaque -> pipesel opaque cmd
5834 state
.roam
<- (fun () -> dopipe conf
.paxcmd
);
5835 if not
(Wsi.withctrl mask
) then dopipe conf
.selcmd
;
5840 G.postRedisplay "viewmulticlick";
5841 onppundermouse g x y (fun () -> showtext '
!'
"Nothing to select") ();
5845 match conf
.columns
with
5847 | Csingle
_ | Cmulti
_ -> conf
.angle
mod 360 = 0
5850 let viewmouse button down
x y mask
=
5852 | n when (n == 4 || n == 5) && not down
->
5853 if Wsi.withctrl mask
5855 match state
.mstate
with
5856 | Mzoom
(oldn
, i
) ->
5864 if conf
.zoom +. 0.01 > 0.1 then 0.1 else 0.01
5866 if conf
.zoom -. 0.1 < 0.1 then -0.01 else -0.1
5868 let zoom = conf
.zoom -. incr in
5870 state
.mstate
<- Mzoom
(n, 0);
5872 state
.mstate
<- Mzoom
(n, i
+1);
5874 else state
.mstate
<- Mzoom
(n, 0)
5878 | Mscrolly
| Mscrollx
5880 | Mnone
-> state
.mstate
<- Mzoom
(n, 0)
5883 match state
.autoscroll
with
5884 | Some step
-> setautoscrollspeed step
(n=4)
5886 if conf
.wheelbypage
|| conf
.presentation
5895 then -conf
.scrollstep
5896 else conf
.scrollstep
5898 let incr = incr * 2 in
5899 let y = clamp incr in
5900 gotoy_and_clear_text y
5903 | n when (n = 6 || n = 7) && not down
&& canpan () ->
5905 panbound (state
.x + (if n = 7 then -2 else 2) * conf
.hscrollstep
);
5906 gotoy_and_clear_text state
.y
5908 | 1 when Wsi.withshift mask
->
5909 state
.mstate
<- Mnone
;
5912 match unproject x y with
5913 | Some
(_, pageno, ux
, uy
) ->
5914 let cmd = Printf.sprintf
5916 conf
.stcmd state
.path pageno ux uy
5918 addpid
@@ popen
cmd []
5922 | 1 when Wsi.withctrl mask
->
5925 Wsi.setcursor
Wsi.CURSOR_CROSSHAIR
;
5926 state
.mstate
<- Mpan
(x, y)
5929 state
.mstate
<- Mnone
5934 if Wsi.withshift mask
5936 annot conf
.annotinline
x y;
5937 G.postRedisplay "addannot"
5941 Wsi.setcursor
Wsi.CURSOR_CYCLE
;
5942 state
.mstate
<- Mzoomrect
(p, p)
5945 match state
.mstate
with
5946 | Mzoomrect
((x0, y0), _) ->
5947 if abs
(x-x0) > 10 && abs
(y - y0) > 10
5948 then zoomrect x0 y0 x y
5951 G.postRedisplay "kill accidental zoom rect";
5955 | Mscrolly
| Mscrollx
5961 | 1 when x > state
.winw - vscrollw () ->
5964 let _, position, sh = state
.uioh#
scrollph in
5965 if y > truncate
position && y < truncate
(position +. sh)
5966 then state
.mstate
<- Mscrolly
5969 state
.mstate
<- Mnone
5971 | 1 when y > state
.winh
- hscrollh () ->
5974 let _, position, sw = state
.uioh#scrollpw
in
5975 if x > truncate
position && x < truncate
(position +. sw)
5976 then state
.mstate
<- Mscrollx
5979 state
.mstate
<- Mnone
5981 | 1 when state
.bzoom
-> if not down
then zoomblock x y
5984 let dest = if down
then getunder x y else Unone
in
5985 begin match dest with
5988 | Uremote
_ | Uremotedest
_
5989 | Uunexpected
_ | Ulaunch
_ | Unamed
_ ->
5992 | Unone
when down
->
5993 Wsi.setcursor
Wsi.CURSOR_CROSSHAIR
;
5994 state
.mstate
<- Mpan
(x, y);
5996 | Uannotation
(opaque, slinkindex
) -> enterannotmode opaque slinkindex
5998 | Unone
| Utext
_ ->
6003 state
.mstate
<- Msel
((x, y), (x, y));
6004 G.postRedisplay "mouse select";
6008 match state
.mstate
with
6011 | Mzoom
_ | Mscrollx
| Mscrolly
->
6012 state
.mstate
<- Mnone
6014 | Mzoomrect
((x0, y0), _) ->
6018 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
6019 state
.mstate
<- Mnone
6021 | Msel
((x0, y0), (x1, y1)) ->
6022 let rec loop = function
6026 let a0 = l.pagedispy in
6027 let a1 = a0 + l.pagevh in
6028 let b0 = l.pagedispx in
6029 let b1 = b0 + l.pagevw in
6030 ((y0 >= a0 && y0 <= a1) || (y1 >= a0 && y1 <= a1))
6031 && ((x0 >= b0 && x0 <= b1) || (x1 >= b0 && x1 <= b1))
6035 match getopaque l.pageno with
6038 match Unix.pipe
() with
6042 "can not create sel pipe: %s"
6046 Ne.clo fd
(fun msg
->
6047 dolog
"%s close failed: %s" what msg
)
6050 try popen
cmd [r
, 0; w, -1]
6052 dolog
"can not execute %S: %s"
6059 G.postRedisplay "copysel";
6061 else clo "Msel pipe/w" w;
6062 clo "Msel pipe/r" r
;
6064 dosel conf
.selcmd
();
6065 state
.roam
<- dosel conf
.paxcmd
;
6077 let birdseyemouse button down
x y mask
6078 (conf
, leftx
, _, hooverpageno
, anchor) =
6081 let rec loop = function
6084 if y > l.pagedispy && y < l.pagedispy + l.pagevh
6085 && x > l.pagedispx && x < l.pagedispx + l.pagevw
6087 leavebirdseye (conf
, leftx
, l.pageno, hooverpageno
, anchor) false;
6093 | _ -> viewmouse button down
x y mask
6099 method key key mask
=
6100 begin match state
.mode with
6101 | Textentry
textentry -> textentrykeyboard key mask
textentry
6102 | Birdseye
birdseye -> birdseyekeyboard key mask
birdseye
6103 | View
-> viewkeyboard key mask
6104 | LinkNav
linknav -> linknavkeyboard key mask
linknav
6108 method button button bstate
x y mask
=
6109 begin match state
.mode with
6111 | View
-> viewmouse button bstate
x y mask
6112 | Birdseye beye
-> birdseyemouse button bstate
x y mask beye
6117 method multiclick clicks
x y mask
=
6118 begin match state
.mode with
6120 | View
-> viewmulticlick clicks
x y mask
6127 begin match state
.mode with
6129 | View
| Birdseye
_ | LinkNav
_ ->
6130 match state
.mstate
with
6131 | Mzoom
_ | Mnone
-> ()
6136 state
.mstate
<- Mpan
(x, y);
6138 then state
.x <- panbound (state
.x + dx);
6140 gotoy_and_clear_text y
6143 state
.mstate
<- Msel
(a, (x, y));
6144 G.postRedisplay "motion select";
6147 let y = min state
.winh
(max
0 y) in
6151 let x = min state
.winw (max
0 x) in
6154 | Mzoomrect
(p0
, _) ->
6155 state
.mstate
<- Mzoomrect
(p0
, (x, y));
6156 G.postRedisplay "motion zoomrect";
6160 method pmotion
x y =
6161 begin match state
.mode with
6162 | Birdseye
(conf
, leftx
, pageno, hooverpageno
, anchor) ->
6163 let rec loop = function
6165 if hooverpageno
!= -1
6167 state
.mode <- Birdseye
(conf
, leftx
, pageno, -1, anchor);
6168 G.postRedisplay "pmotion birdseye no hoover";
6171 if y > l.pagedispy && y < l.pagedispy + l.pagevh
6172 && x > l.pagedispx && x < l.pagedispx + l.pagevw
6174 state
.mode <- Birdseye
(conf
, leftx
, pageno, l.pageno, anchor);
6175 G.postRedisplay "pmotion birdseye hoover";
6185 match state
.mstate
with
6186 | Mpan
_ | Msel
_ | Mzoom
_ | Mscrolly
| Mscrollx
| Mzoomrect
_ -> ()
6194 let past, _, _ = !r
in
6196 let delta = now -. past in
6199 else r
:= (now, x, y)
6203 method infochanged
_ = ()
6206 let maxy = state
.maxy - (if conf
.maxhfit
then state
.winh
else 0) in
6209 then 0.0, float state
.winh
6210 else scrollph state
.y maxy
6215 let winw = wadjsb () + state
.winw in
6216 let fwinw = float winw in
6218 let sw = fwinw /. float state
.w in
6219 let sw = fwinw *. sw in
6220 max
sw (float conf
.scrollh
)
6223 let maxx = state
.w + winw in
6224 let x = winw - state
.x in
6225 let percent = float x /. float maxx in
6226 (fwinw -. sw) *. percent
6228 hscrollh (), position, sw
6232 match state
.mode with
6233 | LinkNav
_ -> "links"
6234 | Textentry
_ -> "textentry"
6235 | Birdseye
_ -> "birdseye"
6238 findkeyhash conf
modename
6240 method eformsgs
= true
6241 method alwaysscrolly
= false
6244 let adderrmsg src msg
=
6245 Buffer.add_string state
.errmsgs msg
;
6246 state
.newerrmsgs
<- true;
6250 let adderrfmt src fmt
=
6251 Format.ksprintf
(fun s -> adderrmsg src s) fmt
;
6255 let cl = splitatspace cmds
in
6257 try Scanf.sscanf
s fmt
f
6259 adderrfmt "remote exec"
6260 "error processing '%S': %s\n" cmds
(exntos exn
)
6263 | "reload" :: [] -> reload ()
6264 | "goto" :: args
:: [] ->
6265 scan args
"%u %f %f"
6267 let cmd, _ = state
.geomcmds
in
6269 then gotopagexy pageno x y
6272 gotopagexy pageno x y;
6275 state
.reprf
<- f state
.reprf
6277 | "goto1" :: args
:: [] -> scan args
"%u %f" gotopage
6278 | "gotor" :: args
:: [] ->
6280 (fun filename
pageno -> gotounder (Uremote
(filename
, pageno)))
6281 | "gotord" :: args
:: [] ->
6283 (fun filename
dest -> gotounder (Uremotedest
(filename
, dest)))
6284 | "rect" :: args
:: [] ->
6285 scan args
"%u %u %f %f %f %f"
6286 (fun pageno color x0 y0 x1 y1 ->
6287 onpagerect pageno (fun w h ->
6288 let _,w1,h1
,_ = getpagedim
pageno in
6289 let sw = float w1 /. float w
6290 and sh = float h1
/. float h in
6294 and y1s
= y1 *. sh in
6295 let rect = (x0s,y0s
,x1s
,y0s
,x1s
,y1s
,x0s,y1s
) in
6297 state
.rects <- (pageno, color, rect) :: state
.rects;
6298 G.postRedisplay "rect";
6301 | "activatewin" :: [] -> Wsi.activatewin
()
6302 | "quit" :: [] -> raise Quit
6304 adderrfmt "remote command"
6305 "error processing remote command: %S\n" cmds
;
6309 let scratch = Bytes.create
80 in
6310 let buf = Buffer.create
80 in
6313 try Some
(Unix.read fd
scratch 0 80)
6315 | Unix.Unix_error
(Unix.EAGAIN
, _, _) -> None
6316 | Unix.Unix_error
(Unix.EINTR
, _, _) -> tempfr ()
6319 match tempfr () with
6325 if Buffer.length
buf > 0
6327 let s = Buffer.contents
buf in
6337 let pos = Bytes.index_from
scratch ppos '
\n'
in
6338 if pos >= n then -1 else pos
6339 with Not_found
-> -1
6343 Buffer.add_subbytes
buf scratch ppos
(nlpos-ppos
);
6344 let s = Buffer.contents
buf in
6350 Buffer.add_subbytes
buf scratch ppos
(n-ppos
);
6356 let remoteopen path =
6357 try Some
(Unix.openfile
path [Unix.O_NONBLOCK
; Unix.O_RDONLY
] 0o0)
6359 adderrfmt "remoteopen" "error opening %S: %s" path (exntos exn
);
6364 let gcconfig = ref E.s in
6365 let trimcachepath = ref E.s in
6366 let rcmdpath = ref E.s in
6367 let pageno = ref None
in
6368 let rootwid = ref 0 in
6369 let openlast = ref false in
6370 let nofc = ref false in
6371 let doreap = ref false in
6372 selfexec := Sys.executable_name
;
6375 [("-p", Arg.String
(fun s -> state
.password <- s),
6376 "<password> Set password");
6380 Config.fontpath
:= s;
6381 selfexec := !selfexec ^
" -f " ^
Filename.quote
s;
6383 "<path> Set path to the user interface font");
6387 selfexec := !selfexec ^
" -c " ^
Filename.quote
s;
6388 Config.confpath
:= s),
6389 "<path> Set path to the configuration file");
6391 ("-last", Arg.Set
openlast, " Open last document");
6393 ("-page", Arg.Int
(fun pageno1
-> pageno := Some
(pageno1
-1)),
6394 "<page-number> Jump to page");
6396 ("-tcf", Arg.String
(fun s -> trimcachepath := s),
6397 "<path> Set path to the trim cache file");
6399 ("-dest", Arg.String
(fun s -> state
.nameddest
<- s),
6400 "<named-destination> Set named destination");
6402 ("-wtmode", Arg.Set
wtmode, " Operate in wt mode");
6403 ("-cxack", Arg.Set
cxack, " Cut corners");
6405 ("-remote", Arg.String
(fun s -> rcmdpath := s),
6406 "<path> Set path to the remote commands source");
6408 ("-origin", Arg.String
(fun s -> state
.origin
<- s),
6409 "<original-path> Set original path");
6411 ("-gc", Arg.Set_string
gcconfig,
6412 "<script-path> Collect garbage with the help of a script");
6414 ("-nofc", Arg.Set
nofc, " Do not use fontconfig");
6416 ("-v", Arg.Unit
(fun () ->
6418 "%s\nconfiguration path: %s\n"
6422 exit
0), " Print version and exit");
6424 ("-embed", Arg.Set_int
rootwid,
6425 "<window-id> Embed into window")
6428 (fun s -> state
.path <- s)
6429 ("Usage: " ^
Sys.argv
.(0) ^
" [options] some.pdf\nOptions:")
6432 then selfexec := !selfexec ^
" -wtmode";
6434 let histmode = emptystr state
.path && not
!openlast in
6436 if not
(Config.load !openlast)
6437 then prerr_endline
"failed to load configuration";
6438 begin match !pageno with
6439 | Some
pageno -> state
.anchor <- (pageno, 0.0, 0.0)
6443 if nonemptystr
!gcconfig
6446 match Unix.socketpair
Unix.PF_UNIX
Unix.SOCK_STREAM
0 with
6448 error
"gc socketpair failed: %s" (exntos exn
)
6451 match addpid
@@ popen
!gcconfig [(c, 0); (c, 1)] with
6453 error
"failed to popen gc script: %s" (exntos exn
);
6459 let wsfd, winw, winh
= Wsi.init
(object (self)
6460 val mutable m_clicks
= 0
6461 val mutable m_click_x
= 0
6462 val mutable m_click_y
= 0
6463 val mutable m_lastclicktime
= infinity
6465 method private cleanup =
6466 state
.roam
<- noroam
;
6467 Hashtbl.iter
(fun _ opaque -> clearmark
opaque) state
.pagemap
6468 method expose
= G.postRedisplay"expose"
6472 | Wsi.Unobscured
-> "unobscured"
6473 | Wsi.PartiallyObscured
-> "partiallyobscured"
6474 | Wsi.FullyObscured
-> "fullyobscured"
6476 vlog "visibility change %s" name
6477 method display = display ()
6478 method map mapped
= vlog "mappped %b" mapped
6479 method reshape w h =
6482 method mouse
b d x y m =
6483 if d && canselect ()
6485 (* http://blogs.msdn.com/b/oldnewthing/archive/2004/10/18/243925.aspx *)
6491 if abs
x - m_click_x
> 10
6492 || abs
y - m_click_y
> 10
6493 || abs_float
(t -. m_lastclicktime
) > 0.3
6495 m_clicks
<- m_clicks
+ 1;
6496 m_lastclicktime
<- t;
6500 G.postRedisplay "cleanup";
6501 state
.uioh <- state
.uioh#button
b d x y m;
6503 else state
.uioh <- state
.uioh#multiclick m_clicks
x y m
6508 m_lastclicktime
<- infinity
;
6509 state
.uioh <- state
.uioh#button
b d x y m
6513 state
.uioh <- state
.uioh#button
b d x y m
6516 state
.mpos
<- (x, y);
6517 state
.uioh <- state
.uioh#motion
x y
6518 method pmotion
x y =
6519 state
.mpos
<- (x, y);
6520 state
.uioh <- state
.uioh#pmotion
x y
6522 let mascm = m land (
6523 Wsi.altmask
+ Wsi.shiftmask
+ Wsi.ctrlmask
+ Wsi.metamask
6526 let x = state
.x and y = state
.y in
6528 if x != state
.x || y != state
.y then self#
cleanup
6530 match state
.keystate
with
6532 let km = k
, mascm in
6535 let modehash = state
.uioh#
modehash in
6536 try Hashtbl.find modehash km
6538 try Hashtbl.find (findkeyhash conf
"global") km
6539 with Not_found
-> KMinsrt
(k
, m)
6541 | KMinsrt
(k
, m) -> keyboard k
m
6542 | KMinsrl
l -> List.iter
(fun (k
, m) -> keyboard k
m) l
6543 | KMmulti
(l, r
) -> state
.keystate
<- KSinto
(l, r
)
6545 | KSinto
((k'
, m'
) :: [], insrt
) when k'
=k
&& m'
land mascm = m'
->
6546 List.iter
(fun (k
, m) -> keyboard k
m) insrt
;
6547 state
.keystate
<- KSnone
6548 | KSinto
((k'
, m'
) :: keys, insrt
) when k'
=k
&& m'
land mascm = m'
->
6549 state
.keystate
<- KSinto
(keys, insrt
)
6550 | KSinto
_ -> state
.keystate
<- KSnone
6553 state
.mpos
<- (x, y);
6554 state
.uioh <- state
.uioh#pmotion
x y
6555 method leave = state
.mpos
<- (-1, -1)
6556 method winstate wsl
= state
.winstate
<- wsl
6557 method quit
= raise Quit
6558 end) !rootwid conf
.cwinw conf
.cwinh platform
in
6563 List.exists
GlMisc.check_extension
6564 [ "GL_ARB_texture_rectangle"
6565 ; "GL_EXT_texture_recangle"
6566 ; "GL_NV_texture_rectangle" ]
6568 then (prerr_endline
"OpenGL does not suppport rectangular textures"; exit
1);
6571 let r = GlMisc.get_string `renderer
in
6572 let p = "Mesa DRI Intel(" in
6573 let l = String.length
p in
6574 String.length
r > l && String.sub
r 0 l = p
6577 defconf
.sliceheight
<- 1024;
6578 defconf
.texcount
<- 32;
6579 defconf
.usepbo
<- true;
6583 match Unix.socketpair
Unix.PF_UNIX
Unix.SOCK_STREAM
0 with
6585 Printf.eprintf
"socketpair failed: %s" (exntos exn
);
6593 setcheckers conf
.checkers
;
6595 if conf
.redirectstderr
6599 (Buffer.to_bytes state
.errmsgs
)
6600 (match state
.errfd
with
6602 let s = Bytes.create
(80*24) in
6605 let r, _, _ = Unix.select
[fd
] [] [] 0.0 in
6607 then Unix.read fd
s 0 (Bytes.length
s)
6613 else Bytes.sub
s 0 n
6617 try ignore
(Unix.write state
.stderr
s 0 (Bytes.length
s))
6618 with exn
-> print_endline
(exntos exn
)
6623 conf
.angle
, conf
.fitmodel
, (conf
.trimmargins
, conf
.trimfuzz
),
6624 conf
.texcount
, conf
.sliceheight
, conf
.mustoresize
, conf
.colorspace
,
6625 !Config.fontpath
, !trimcachepath,
6626 GlMisc.check_extension
"GL_ARB_pixel_buffer_object",
6629 List.iter
GlArray.enable
[`texture_coord
; `vertex
];
6631 reshape ~firsttime
:true winw winh
;
6635 Wsi.settitle
"llpp (history)";
6639 state
.text <- "Opening " ^
(mbtoutf8 state
.path);
6640 opendoc state
.path state
.password;
6644 Sys.set_signal
Sys.sighup
(Sys.Signal_handle
(fun _ -> reload ()));
6647 match Unix.waitpid
[Unix.WNOHANG
] ~
-1 with
6648 | (exception (Unix.Unix_error
(Unix.ECHILD
, _, _))) -> ()
6649 | (exception exn
) -> dolog
"Unix.waitpid: %s" @@ exntos exn
6651 | _pid
, _status
-> reap ()
6653 Sys.set_signal
Sys.sigchld
(Sys.Signal_handle
(fun _ -> doreap := true));
6657 if nonemptystr
!rcmdpath
6658 then remoteopen !rcmdpath
6663 let rec loop deadline
=
6670 match state
.errfd
with
6671 | None
-> [state
.ss; state
.wsfd]
6672 | Some fd
-> [state
.ss; state
.wsfd; fd
]
6677 | Some fd
-> fd
:: r
6681 state
.redisplay
<- false;
6688 if deadline
= infinity
6690 else max
0.0 (deadline
-. now)
6695 try Unix.select
r [] [] timeout
6696 with Unix.Unix_error
(Unix.EINTR
, _, _) -> [], [], []
6702 if state
.ghyll
== noghyll
6704 match state
.autoscroll
with
6705 | Some step
when step
!= 0 ->
6706 let y = state
.y + step
in
6710 else if y >= state
.maxy then 0 else y
6713 if state
.mode = View
6714 then state
.text <- E.s;
6717 else deadline
+. 0.01
6722 let rec checkfds = function
6724 | fd
:: rest
when fd
= state
.ss ->
6725 let cmd = readcmd state
.ss in
6729 | fd
:: rest
when fd
= state
.wsfd ->
6733 | fd
:: rest
when Some fd
= !optrfd ->
6734 begin match remote fd
with
6735 | None
-> optrfd := remoteopen !rcmdpath;
6736 | opt -> optrfd := opt
6741 let s = Bytes.create
80 in
6742 let n = tempfailureretry
(Unix.read fd
s 0) 80 in
6743 if conf
.redirectstderr
6745 Buffer.add_substring state
.errmsgs
(Bytes.to_string
s) 0 n;
6746 state
.newerrmsgs
<- true;
6747 state
.redisplay
<- true;
6750 prerr_string
(String.sub
(Bytes.to_string
s) 0 n);
6758 if deadline
= infinity
6762 match state
.autoscroll
with
6763 | Some step
when step
!= 0 -> deadline1
6764 | _ -> if state
.ghyll
== noghyll
then infinity
else deadline1
6772 Config.save leavebirdseye;
6773 if hasunsavedchanges
()