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 delannot
: opaque
-> slinkindex
-> unit = "ml_delannot";;
41 external hasunsavedchanges
: unit -> bool = "ml_hasunsavedchanges";;
42 external savedoc
: string -> unit = "ml_savedoc";;
43 external getannotcontents
: opaque
-> slinkindex
-> string
44 = "ml_getannotcontents";;
46 let reeenterhist = ref false;;
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
134 let addpid pid
= if pid
> 0 then incr pidcount
;;
137 let re = Str.regexp
"%s" in
139 if emptystr conf
.pathlauncher
140 then print_endline state
.path
142 let command = Str.global_replace
re state
.path conf
.pathlauncher
in
143 try addpid @@ popen
command []
145 Printf.eprintf
"failed to execute `%s': %s\n" command (exntos exn
);
150 let redirectstderr () =
151 let clofail what errmsg
= dolog
"failed to close %s: %s" what errmsg
in
152 if conf
.redirectstderr
154 match Unix.pipe
() with
156 dolog
"failed to create stderr redirection pipes: %s" (exntos exn
)
159 begin match Unix.dup
Unix.stderr
with
161 dolog
"failed to dup stderr: %s" (exntos exn
);
162 Ne.clo r
(clofail "pipe/r");
163 Ne.clo w
(clofail "pipe/w");
166 begin match Unix.dup2 w
Unix.stderr
with
168 dolog
"failed to dup2 to stderr: %s" (exntos exn
);
169 Ne.clo dupstderr
(clofail "stderr duplicate");
170 Ne.clo r
(clofail "redir pipe/r");
171 Ne.clo w
(clofail "redir pipe/w");
174 state
.stderr
<- dupstderr
;
175 state
.errfd
<- Some r
;
179 state
.newerrmsgs
<- false;
180 begin match state
.errfd
with
182 begin match Unix.dup2 state
.stderr
Unix.stderr
with
184 dolog
"failed to dup2 original stderr: %s" (exntos exn
)
186 Ne.clo fd
(clofail "dup of stderr");
191 prerr_string
(Buffer.contents state
.errmsgs
);
193 Buffer.clear state
.errmsgs
;
199 let postRedisplay who
=
201 then prerr_endline
("redisplay for " ^ who
);
202 state
.redisplay
<- true;
206 let getopaque pageno
=
207 try Some
(Hashtbl.find state
.pagemap
(pageno
, state
.gen
))
208 with Not_found
-> None
211 let putopaque pageno opaque
=
212 Hashtbl.replace state
.pagemap
(pageno
, state
.gen
) opaque
215 let pagetranslatepoint l x y
=
216 let dy = y
- l
.pagedispy
in
217 let y = dy + l
.pagey
in
218 let dx = x
- l
.pagedispx
in
219 let x = dx + l
.pagex
in
223 let onppundermouse g
x y d
=
226 begin match getopaque l
.pageno
with
228 let x0 = l
.pagedispx
in
229 let x1 = x0 + l
.pagevw
in
230 let y0 = l
.pagedispy
in
231 let y1 = y0 + l
.pagevh
in
232 if y >= y0 && y <= y1 && x >= x0 && x <= x1
234 let px, py
= pagetranslatepoint l
x y in
235 match g opaque l
px py
with
248 let g opaque l
px py
=
251 match rectofblock opaque
px py
with
253 let rect = (a
.(0),a
.(2),a
.(1),a
.(2),a
.(1),a
.(3),a
.(0),a
.(3)) in
254 state
.rects
<- [l
.pageno
, l
.pageno
mod 3, rect];
255 G.postRedisplay "getunder";
258 let under = whatsunder opaque
px py
in
269 | Uannotation _
-> Some
under
271 onppundermouse g x y Unone
276 match unproject opaque
x y with
277 | Some
(x, y) -> Some
(Some
(opaque
, l
.pageno
, x, y))
280 onppundermouse g x y None
;
284 state
.text
<- Printf.sprintf
"%c%s" c s
;
285 G.postRedisplay "showtext";
288 let pipesel opaque cmd
=
291 match Unix.pipe
() with
294 (Printf.sprintf
"pipesel can not create pipe: %s" (exntos exn
));
296 let doclose what fd
=
297 Ne.clo fd
(fun msg
-> dolog
"%s close failed: %s" what msg
)
300 try popen cmd
[r
, 0; w
, -1]
302 dolog
"can not execute %S: %s" cmd
(exntos exn
);
309 G.postRedisplay "pipesel";
311 else doclose "pipesel pipe/w" w
;
312 doclose "pipesel pipe/r" r
;
316 let g opaque l
px py
=
317 if markunder opaque
px py conf
.paxmark
320 match getopaque l
.pageno
with
322 | Some opaque
-> pipesel opaque conf
.paxcmd
327 G.postRedisplay "paxunder";
328 if conf
.paxmark
= Mark_page
331 match getopaque l
.pageno
with
333 | Some opaque
-> clearmark opaque
) state
.layout
;
335 onppundermouse g x y (fun () -> showtext '
!'
"Whoopsie daisy");
339 match Unix.pipe
() with
341 showtext '
!'
(Printf.sprintf
"pipe failed: %s" (exntos exn
))
344 Ne.clo fd
(fun msg
->
345 showtext '
!'
(Printf.sprintf
"failed to close %s: %s" cap msg
)
349 try popen conf
.selcmd
[r
, 0; w
, -1]
352 (Printf.sprintf
"failed to execute %s: %s"
353 conf
.selcmd
(exntos exn
));
360 let l = String.length s
in
361 let bytes = Bytes.unsafe_of_string s
in
362 let n = tempfailureretry
(Unix.write w
bytes 0) l in
367 "failed to write %d characters to sel pipe, wrote %d"
372 (Printf.sprintf
"failed to write to sel pipe: %s"
377 clo "selstring pipe/r" r
;
378 clo "selstring pipe/w" w
;
381 let undertext = function
384 | Ulinkgoto
(pageno
, _
) -> Printf.sprintf
"%s: page %d" state
.path
(pageno
+1)
385 | Utext s
-> "font: " ^ s
386 | Uunexpected s
-> "unexpected: " ^ s
387 | Ulaunch s
-> "launch: " ^ s
388 | Unamed s
-> "named: " ^ s
389 | Uremote
(filename
, pageno
) ->
390 Printf.sprintf
"%s: page %d" filename
(pageno
+1)
391 | Uremotedest
(filename
, destname
) ->
392 Printf.sprintf
"%s: destination %S" filename destname
393 | Uannotation
(opaque
, slinkindex
) ->
394 "annotation: " ^ getannotcontents opaque slinkindex
397 let updateunder x y =
398 match getunder x y with
399 | Unone
-> Wsi.setcursor
Wsi.CURSOR_INHERIT
401 if conf
.underinfo
then showtext 'u'
("ri: " ^ uri
);
402 Wsi.setcursor
Wsi.CURSOR_INFO
403 | Ulinkgoto
(pageno
, _
) ->
405 then showtext 'p'
("age: " ^ string_of_int
(pageno
+1));
406 Wsi.setcursor
Wsi.CURSOR_INFO
408 if conf
.underinfo
then showtext '
f'
("ont: " ^ s
);
409 Wsi.setcursor
Wsi.CURSOR_TEXT
411 if conf
.underinfo
then showtext 'u'
("nexpected: " ^ s
);
412 Wsi.setcursor
Wsi.CURSOR_INHERIT
414 if conf
.underinfo
then showtext '
l'
("aunch: " ^ s
);
415 Wsi.setcursor
Wsi.CURSOR_INHERIT
417 if conf
.underinfo
then showtext '
n'
("amed: " ^ s
);
418 Wsi.setcursor
Wsi.CURSOR_INHERIT
419 | Uremote
(filename
, pageno
) ->
420 if conf
.underinfo
then showtext 'r'
421 (Printf.sprintf
"emote: %s (%d)" filename
(pageno
+1));
422 Wsi.setcursor
Wsi.CURSOR_INFO
423 | Uremotedest
(filename
, destname
) ->
424 if conf
.underinfo
then showtext 'r'
425 (Printf.sprintf
"emote destination: %s (%S)" filename destname
);
426 Wsi.setcursor
Wsi.CURSOR_INFO
428 if conf
.underinfo
then showtext 'a'
"nnotation";
429 Wsi.setcursor
Wsi.CURSOR_INFO
432 let showlinktype under =
446 let s = undertext under in
451 let b = Buffer.create
(String.length
s + 1) in
452 Buffer.add_string
b s;
457 let intentry_with_suffix text key
=
459 if key
>= 32 && key
< 127
463 match Char.lowercase
c with
465 let text = addchar text c in
469 let text = addchar text c in
473 state
.text <- Printf.sprintf
"invalid char (%d, `%c')" key
c;
478 let s = Bytes.create
4 in
479 let n = tempfailureretry
(Unix.read fd
s 0) 4 in
480 if n != 4 then error
"incomplete read(len) = %d" n;
481 let len = (Char.code
(Bytes.get
s 0) lsl 24)
482 lor (Char.code
(Bytes.get
s 1) lsl 16)
483 lor (Char.code
(Bytes.get
s 2) lsl 8)
484 lor (Char.code
(Bytes.get
s 3))
486 let s = Bytes.create
len in
487 let n = tempfailureretry
(Unix.read fd
s 0) len in
488 if n != len then error
"incomplete read(data) %d vs %d" n len;
492 let btod b = if b then 1 else 0;;
495 let b = Buffer.create
16 in
496 Buffer.add_string
b "llll";
499 let s = Buffer.to_bytes
b in
500 let n = Bytes.length
s in
502 (* dolog "wcmd %S" (String.sub s 4 len); *)
503 Bytes.set
s 0 (Char.chr
((len lsr 24) land 0xff));
504 Bytes.set
s 1 (Char.chr
((len lsr 16) land 0xff));
505 Bytes.set
s 2 (Char.chr
((len lsr 8) land 0xff));
506 Bytes.set
s 3 (Char.chr
(len land 0xff));
507 let n'
= tempfailureretry
(Unix.write state
.ss
s 0) n in
508 if n'
!= n then error
"write failed %d vs %d" n'
n;
512 let nogeomcmds cmds
=
514 | s, [] -> emptystr
s
518 let layoutN ((columns
, coverA
, coverB
), b) y sh
=
519 let sh = sh - (hscrollh ()) in
520 let wadj = wadjsb () in
521 let rec fold accu
n =
522 if n = Array.length
b
525 let pdimno, dx, vy
, (_
, w
, h
, xoff
) = b.(n) in
528 || n = state
.pagecount
- coverB
529 || (n - coverA
) mod columns
= columns
- 1)
535 let pagey = max
0 (y - vy
) in
536 let pagedispy = if pagey > 0 then 0 else vy
- y in
537 let pagedispx, pagex
=
539 if n = coverA
- 1 || n = state
.pagecount
- coverB
540 then state
.x + (wadj + state
.winw
- w
) / 2
541 else dx + xoff
+ state
.x
548 let vw = wadj + state
.winw
- pagedispx in
549 let pw = w
- pagex
in
552 let pagevh = min
(h
- pagey) (sh - pagedispy) in
553 if pagevw > 0 && pagevh > 0
564 ; pagedispx = pagedispx
565 ; pagedispy = pagedispy
577 if Array.length
b = 0
579 else List.rev
(fold [] (page_of_y
y))
582 let layoutS (columns
, b) y sh =
583 let sh = sh - hscrollh () in
584 let wadj = wadjsb () in
585 let rec fold accu n =
586 if n = Array.length
b
589 let pdimno, px, vy
, (_
, pagew
, pageh
, xoff
) = b.(n) in
596 let x = xoff
+ state
.x in
597 let pagey = max
0 (y - vy
) in
598 let pagedispy = if pagey > 0 then 0 else vy
- y in
599 let pagedispx, pagex
=
613 let pagecolw = pagew
/columns
in
615 if pagecolw < state
.winw
616 then pagedispx + ((wadj + state
.winw
- pagecolw) / 2)
620 let vw = wadj + state
.winw
- pagedispx in
621 let pw = pagew
- pagex
in
624 let pagevw = min
pagevw pagecolw in
625 let pagevh = min
(pageh
- pagey) (sh - pagedispy) in
626 if pagevw > 0 && pagevh > 0
637 ; pagedispx = pagedispx
638 ; pagedispy = pagedispy
639 ; pagecol
= n mod columns
654 if nogeomcmds state
.geomcmds
656 match conf
.columns
with
657 | Csingle
b -> layoutN ((1, 0, 0), b) y sh
658 | Cmulti
c -> layoutN c y sh
659 | Csplit
s -> layoutS s y sh
664 let y = state
.y + incr
in
666 let y = min
y (state
.maxy
- (if conf
.maxhfit
then state
.winh
else 0)) in
671 let tilex = l.pagex
mod conf
.tilew
in
672 let tiley = l.pagey mod conf
.tileh
in
674 let col = l.pagex
/ conf
.tilew
in
675 let row = l.pagey / conf
.tileh
in
677 let xadj = xadjsb () in
678 let rec rowloop row y0 dispy h
=
682 let dh = conf
.tileh
- y0 in
684 let rec colloop col x0 dispx w
=
688 let dw = conf
.tilew
- x0 in
690 let dispx'
= xadj + dispx in
691 f col row dispx' dispy
x0 y0 dw dh;
692 colloop (col+1) 0 (dispx+dw) (w
-dw)
695 colloop col tilex l.pagedispx l.pagevw;
696 rowloop (row+1) 0 (dispy
+dh) (h
-dh)
699 if l.pagevw > 0 && l.pagevh > 0
700 then rowloop row tiley l.pagedispy l.pagevh;
703 let gettileopaque l col row =
705 l.pageno
, state
.gen
, conf
.colorspace
, conf
.angle
, l.pagew
, l.pageh
, col, row
707 try Some
(Hashtbl.find state
.tilemap
key)
708 with Not_found
-> None
711 let puttileopaque l col row gen colorspace angle opaque size elapsed
=
712 let key = l.pageno
, gen
, colorspace
, angle
, l.pagew
, l.pageh
, col, row in
713 Hashtbl.add state
.tilemap
key (opaque
, size
, elapsed
)
716 let filledrect x0 y0 x1 y1 =
717 GlArray.disable `texture_coord
;
718 Raw.sets_float state
.vraw ~pos
:0 [| x0; y0; x0; y1; x1; y0; x1; y1 |];
719 GlArray.vertex `two state
.vraw
;
720 GlArray.draw_arrays `triangle_strip ~first
:0 ~count
:4;
721 GlArray.enable `texture_coord
;
724 let linerect x0 y0 x1 y1 =
725 GlArray.disable `texture_coord
;
726 Raw.sets_float state
.vraw ~pos
:0 [| x0; y0; x0; y1; x1; y1; x1; y0 |];
727 GlArray.vertex `two state
.vraw
;
728 GlArray.draw_arrays `line_loop ~first
:0 ~count
:4;
729 GlArray.enable `texture_coord
;
732 let drawtiles l color
=
734 let wadj = wadjsb () in
736 let f col row x y tilex tiley w h
=
737 match gettileopaque l col row with
738 | Some
(opaque
, _
, t
) ->
739 let params = x, y, w
, h
, tilex, tiley in
741 then GlTex.env
(`mode `blend
);
742 drawtile
params opaque
;
744 then GlTex.env
(`mode `modulate
);
748 let s = Printf.sprintf
752 let w = measurestr fstate
.fontsize
s in
753 GlDraw.color
(0.0, 0.0, 0.0);
754 filledrect (float (x-2))
757 (float (y + fstate
.fontsize
+ 2));
758 GlDraw.color
(1.0, 1.0, 1.0);
759 drawstring fstate
.fontsize
x (y + fstate
.fontsize
- 1) s;
769 let lw = wadj + state
.winw
- x in
772 let lh = state
.winh
- y in
776 then GlTex.env
(`mode `blend
);
777 begin match state
.checkerstexid
with
779 Gl.enable `texture_2d
;
780 GlTex.bind_texture ~target
:`texture_2d id
;
784 and y1 = float (y+h
) in
786 let tw = float w /. 16.0
787 and th
= float h
/. 16.0 in
788 let tx0 = float tilex /. 16.0
789 and ty0
= float tiley /. 16.0 in
791 and ty1
= ty0
+. th
in
792 Raw.sets_float state
.vraw ~pos
:0
793 [| x0; y0; x0; y1; x1; y0; x1; y1 |];
794 Raw.sets_float state
.traw ~pos
:0
795 [| tx0; ty0
; tx0; ty1
; tx1; ty0
; tx1; ty1
|];
796 GlArray.vertex `two state
.vraw
;
797 GlArray.tex_coord `two state
.traw
;
798 GlArray.draw_arrays `triangle_strip ~first
:0 ~count
:4;
799 Gl.disable `texture_2d
;
802 GlDraw.color
(1.0, 1.0, 1.0);
803 filledrect (float x) (float y) (float (x+w)) (float (y+h
));
806 then GlTex.env
(`mode `modulate
);
807 if w > 128 && h
> fstate
.fontsize
+ 10
809 let c = if conf
.invert
then 1.0 else 0.0 in
810 GlDraw.color
(c, c, c);
813 then (col*conf
.tilew
, row*conf
.tileh
)
816 drawstring2 fstate
.fontsize
x y "Loading %d [%d,%d]" l.pageno
c r
;
825 let pagevisible layout n = List.exists
(fun l -> l.pageno
= n) layout;;
827 let tilevisible1 l x y =
829 and ax1
= l.pagex
+ l.pagevw
831 and ay1
= l.pagey + l.pagevh in
835 let bx1 = min
(bx0 + conf
.tilew
) l.pagew
836 and by1
= min
(by0
+ conf
.tileh
) l.pageh
in
838 let rx0 = max
ax0 bx0
839 and ry0
= max ay0 by0
840 and rx1
= min ax1
bx1
841 and ry1
= min ay1 by1
in
843 let nonemptyintersection = rx1
> rx0 && ry1
> ry0
in
847 let tilevisible layout n x y =
848 let rec findpageinlayout m
= function
849 | l :: rest
when l.pageno
= n ->
850 tilevisible1 l x y || (
851 match conf
.columns
with
852 | Csplit
(c, _
) when c > m
-> findpageinlayout (m
+1) rest
857 | _
:: rest
-> findpageinlayout 0 rest
860 findpageinlayout 0 layout;
863 let tileready l x y =
864 tilevisible1 l x y &&
865 gettileopaque l (x/conf
.tilew
) (y/conf
.tileh
) != None
868 let tilepage n p
layout =
869 let rec loop = function
873 let f col row _ _ _ _ _ _
=
874 if state
.currently
= Idle
876 match gettileopaque l col row with
879 let x = col*conf
.tilew
880 and y = row*conf
.tileh
in
882 let w = l.pagew
- x in
886 let h = l.pageh
- y in
891 then getpbo
w h conf
.colorspace
894 wcmd "tile %s %d %d %d %d %s"
895 (~
> p
) x y w h (~
> pbo);
898 l, p
, conf
.colorspace
, conf
.angle
,
899 state
.gen
, col, row, conf
.tilew
, conf
.tileh
908 if nogeomcmds state
.geomcmds
912 let preloadlayout y =
913 let y = if y < state
.winh
then 0 else y - state
.winh
in
914 let h = state
.winh
*3 in
920 if state
.currently
!= Idle
925 begin match getopaque l.pageno
with
927 wcmd "page %d %d" l.pageno
l.pagedimno
;
928 state
.currently
<- Loading
(l, state
.gen
);
930 tilepage l.pageno opaque pages
;
935 if nogeomcmds state
.geomcmds
941 if conf
.preload && state
.currently
= Idle
942 then load (preloadlayout state
.y);
945 let layoutready layout =
946 let rec fold all ls
=
949 let seen = ref false in
950 let allvisible = ref true in
951 let foo col row _ _ _ _ _ _
=
953 allvisible := !allvisible &&
954 begin match gettileopaque l col row with
960 fold (!seen && !allvisible) rest
963 let alltilesvisible = fold true layout in
968 let y = bound
y 0 state
.maxy
in
969 let y, layout, proceed
=
970 match conf
.maxwait
with
971 | Some time
when state
.ghyll
== noghyll
->
972 begin match state
.throttle
with
974 let layout = layout y state
.winh
in
975 let ready = layoutready layout in
979 state
.throttle
<- Some
(layout, y, now
());
981 else G.postRedisplay "gotoy showall (None)";
983 | Some
(_
, _
, started
) ->
984 let dt = now
() -. started
in
987 state
.throttle
<- None
;
988 let layout = layout y state
.winh
in
990 G.postRedisplay "maxwait";
997 let layout = layout y state
.winh
in
998 if not
!wtmode || layoutready layout
999 then G.postRedisplay "gotoy ready";
1005 state
.layout <- layout;
1006 begin match state
.mode
with
1009 | Ltexact
(pageno
, linkno
) ->
1010 let rec loop = function
1012 state
.mode
<- LinkNav
(Ltgendir
0)
1013 | l :: _
when l.pageno
= pageno
->
1014 begin match getopaque pageno
with
1015 | None
-> state
.mode
<- LinkNav
(Ltnotready
(pageno
, 0))
1017 let x0, y0, x1, y1 = getlinkrect opaque linkno
in
1018 if not
(x0 >= l.pagex
&& x1 <= l.pagex
+ l.pagevw
1019 && y0 >= l.pagey && y1 <= l.pagey + l.pagevh)
1020 then state
.mode
<- LinkNav
(Ltgendir
0)
1022 | _
:: rest
-> loop rest
1025 | Ltnotready _
| Ltgendir _
-> ()
1031 begin match state
.mode
with
1032 | Birdseye
(conf
, leftx
, pageno
, hooverpageno
, anchor
) ->
1033 if not
(pagevisible layout pageno
)
1035 match state
.layout with
1038 state
.mode
<- Birdseye
(
1039 conf
, leftx
, l.pageno
, hooverpageno
, anchor
1044 | Ltnotready
(_
, dir
)
1047 let rec loop = function
1050 match getopaque l.pageno
with
1051 | None
-> Ltnotready
(l.pageno
, dir
)
1056 then LDfirstvisible
(l.pagex
, l.pagey, dir
)
1058 if dir
> 0 then LDfirst
else LDlast
1064 | Lnotfound
-> loop rest
1066 showlinktype (getlink opaque
n);
1067 Ltexact
(l.pageno
, n)
1071 state
.mode
<- LinkNav
linknav
1079 state
.ghyll
<- noghyll
;
1082 let mx, my
= state
.mpos
in
1087 let conttiling pageno opaque
=
1088 tilepage pageno opaque
1089 (if conf
.preload then preloadlayout state
.y else state
.layout)
1092 let gotoy_and_clear_text y =
1093 if not conf
.verbose
then state
.text <- E.s;
1097 let getanchory (n, top
, dtop
) =
1098 let y, h = getpageyh
n in
1099 if conf
.presentation
1101 let ips = calcips
h in
1102 y + truncate
(top
*.float h -. dtop
*.float ips) + ips;
1104 y + truncate
(top
*.float h -. dtop
*.float conf
.interpagespace
)
1107 let gotoanchor anchor
=
1108 gotoy (getanchory anchor
);
1112 cbput state
.hists
.nav
(getanchor
());
1116 let anchor = cbgetc state
.hists
.nav dir
in
1120 let gotoghyll1 single
y =
1121 let scroll f n a
b =
1122 (* http://devmaster.net/forums/topic/9796-ease-in-ease-out-algorithm/ *)
1124 let s x = 3.0*.x**2.0 -. 2.0*.x**3.0 in
1126 then s (float f /. float a
)
1129 then 1.0 -. s ((float (f-b) /. float (n-b)))
1135 let ins = float a
*. 0.5
1136 and outs
= float (n-b) *. 0.5 in
1138 ins +. outs
+. float ones
1140 let rec set nab
y sy
=
1141 let (_N
, _A
, _B
), y =
1144 let scl = if y > sy
then 2 else -2 in
1145 let _N, _
, _
= nab
in
1146 (_N,0,_N), y+conf
.scrollstep
*scl
1148 let sum = summa
_N _A _B
in
1149 let dy = float (y - sy
) in
1153 then state
.ghyll
<- noghyll
1156 let s = scroll n _N _A _B
in
1157 let y1 = y1 +. ((s *. dy) /. sum) in
1158 gotoy_and_clear_text (truncate
y1);
1159 state
.ghyll
<- gf (n+1) y1;
1163 | Some
y'
when single
-> set nab
y' state
.y
1164 | Some
y'
-> set (_N/2, 1, 1) y' state
.y
1166 gf 0 (float state
.y)
1169 match conf
.ghyllscroll
with
1170 | Some nab
when not conf
.presentation
->
1171 if state
.ghyll
== noghyll
1172 then set nab
y state
.y
1173 else state
.ghyll
(Some
y)
1175 gotoy_and_clear_text y
1178 let gotoghyll = gotoghyll1 false;;
1180 let gotopage n top
=
1181 let y, h = getpageyh
n in
1182 let y = y + (truncate
(top
*. float h)) in
1186 let gotopage1 n top
=
1187 let y = getpagey
n in
1192 let invalidate s f =
1197 match state
.geomcmds
with
1198 | ps
, [] when emptystr ps
->
1200 state
.geomcmds
<- s, [];
1203 state
.geomcmds
<- ps
, [s, f];
1205 | ps
, (s'
, _
) :: rest
when s'
= s ->
1206 state
.geomcmds
<- ps
, ((s, f) :: rest
);
1209 state
.geomcmds
<- ps
, ((s, f) :: cmds
);
1213 Hashtbl.iter
(fun _ opaque
->
1214 wcmd "freepage %s" (~
> opaque
);
1216 Hashtbl.clear state
.pagemap
;
1220 if not
(Queue.is_empty state
.tilelru
)
1222 Queue.iter
(fun (k
, p
, s) ->
1223 wcmd "freetile %s" (~
> p
);
1224 state
.memused
<- state
.memused
- s;
1225 Hashtbl.remove state
.tilemap k
;
1227 state
.uioh#infochanged Memused
;
1228 Queue.clear state
.tilelru
;
1234 let h = truncate
(float h*.conf
.zoom
) in
1235 let d = conf
.interpagespace
lsl (if conf
.presentation
then 1 else 0) in
1239 let opendoc path password
=
1241 state
.password
<- password
;
1242 state
.gen
<- state
.gen
+ 1;
1243 state
.docinfo
<- [];
1244 state
.outlines
<- [||];
1247 setaalevel conf
.aalevel
;
1249 if emptystr state
.origin
1253 Wsi.settitle
("llpp " ^
(mbtoutf8
(Filename.basename
titlepath)));
1254 wcmd "open %d %d %s\000%s\000" (btod !wtmode) (btod !cxack) path password
;
1255 invalidate "reqlayout"
1257 wcmd "reqlayout %d %d %d %s\000"
1258 conf
.angle
(FMTE.to_int conf
.fitmodel
)
1259 (stateh state
.winh
) state
.nameddest
1264 state
.anchor <- getanchor
();
1265 opendoc state
.path state
.password
;
1269 let c = c *. conf
.colorscale
in
1273 let scalecolor2 (r
, g, b) =
1274 (r
*. conf
.colorscale
, g *. conf
.colorscale
, b *. conf
.colorscale
);
1277 let docolumns columns
=
1278 let wadj = wadjsb () in
1281 let a = Array.make state
.pagecount
(-1, -1, -1, (-1, -1, -1, -1)) in
1282 let wadj = wadjsb () in
1283 let rec loop pageno
pdimno pdim
y ph pdims
=
1284 if pageno
= state
.pagecount
1287 let pdimno, ((_
, w, h, xoff
) as pdim
), pdims
=
1289 | ((pageno'
, _
, _
, _
) as pdim
) :: rest
when pageno'
= pageno
->
1290 pdimno+1, pdim
, rest
1294 let x = max
0 (((wadj + state
.winw
- w) / 2) - xoff
) in
1296 (if conf
.presentation
1297 then (if pageno
= 0 then calcips
h else calcips ph
+ calcips
h)
1298 else (if pageno
= 0 then 0 else conf
.interpagespace
)
1301 a.(pageno
) <- (pdimno, x, y, pdim
);
1302 loop (pageno
+1) pdimno pdim
(y + h) h pdims
1304 loop 0 ~
-1 (-1,-1,-1,-1) 0 0 state
.pdims
;
1305 conf
.columns
<- Csingle
a;
1307 | Cmulti
((columns
, coverA
, coverB
), _
) ->
1308 let a = Array.make state
.pagecount
(-1, -1, -1, (-1, -1, -1, -1)) in
1309 let rec loop pageno
pdimno pdim
x y rowh pdims
=
1310 let rec fixrow m
= if m
= pageno
then () else
1311 let (pdimno, x, y, ((_
, _
, h, _
) as pdim
)) = a.(m
) in
1314 let y = y + (rowh
- h) / 2 in
1315 a.(m
) <- (pdimno, x, y, pdim
);
1319 if pageno
= state
.pagecount
1320 then fixrow (((pageno
- 1) / columns
) * columns
)
1322 let pdimno, ((_
, w, h, xoff
) as pdim
), pdims
=
1324 | ((pageno'
, _
, _
, _
) as pdim
) :: rest
when pageno'
= pageno
->
1325 pdimno+1, pdim
, rest
1330 if pageno
= coverA
- 1 || pageno
= state
.pagecount
- coverB
1332 let x = (wadj + state
.winw
- w) / 2 in
1334 if conf
.presentation
then calcips
h else conf
.interpagespace
in
1335 x, y + ips + rowh
, h
1338 if (pageno
- coverA
) mod columns
= 0
1340 let x = max
0 (wadj + state
.winw
- state
.w) / 2 in
1342 if conf
.presentation
1344 let ips = calcips
h in
1345 y + (if pageno
= 0 then 0 else calcips rowh
+ ips)
1347 y + (if pageno
= 0 then 0 else conf
.interpagespace
)
1351 else x, y, max rowh
h
1355 if pageno
> 1 && (pageno
- coverA
) mod columns
= 0
1358 if pageno
= columns
&& conf
.presentation
1360 let ips = calcips rowh
in
1361 for i
= 0 to pred columns
1363 let (pdimno, x, y, pdim
) = a.(i
) in
1364 a.(i
) <- (pdimno, x, y+ips, pdim
)
1370 fixrow (pageno
- columns
);
1375 a.(pageno
) <- (pdimno, x, y, pdim
);
1376 let x = x + w + xoff
*2 + conf
.interpagespace
in
1377 loop (pageno
+1) pdimno pdim
x y rowh' pdims
1379 loop 0 ~
-1 (-1,-1,-1,-1) 0 0 0 state
.pdims
;
1380 conf
.columns
<- Cmulti
((columns
, coverA
, coverB
), a);
1383 let a = Array.make
(state
.pagecount
*c) (-1, -1, -1, (-1, -1, -1, -1)) in
1384 let rec loop pageno
pdimno pdim
y pdims
=
1385 if pageno
= state
.pagecount
1388 let pdimno, ((_
, w, h, _
) as pdim
), pdims
=
1390 | ((pageno'
, _
, _
, _
) as pdim
) :: rest
when pageno'
= pageno
->
1391 pdimno+1, pdim
, rest
1396 let rec loop1 n x y =
1397 if n = c then y else (
1398 a.(pageno
*c + n) <- (pdimno, x, y, pdim
);
1399 loop1 (n+1) (x+cw) (y + h + conf
.interpagespace
)
1402 let y = loop1 0 0 y in
1403 loop (pageno
+1) pdimno pdim
y pdims
1405 loop 0 ~
-1 (-1,-1,-1,-1) 0 state
.pdims
;
1406 conf
.columns
<- Csplit
(c, a);
1410 docolumns conf
.columns
;
1411 state
.maxy
<- calcheight
();
1412 if state
.reprf
== noreprf
1414 match state
.mode
with
1415 | Birdseye
(_
, _
, pageno
, _
, _
) ->
1416 let y, h = getpageyh pageno
in
1417 let top = (state
.winh
- h) / 2 in
1418 gotoy (max
0 (y - top))
1421 | LinkNav _
-> gotoanchor state
.anchor
1425 state
.reprf
<- noreprf
;
1430 GlDraw.viewport ~
x:0 ~
y:0 ~
w:w ~
h:h;
1431 let firsttime = state
.geomcmds
== firstgeomcmds
in
1432 if not
firsttime && nogeomcmds state
.geomcmds
1433 then state
.anchor <- getanchor
();
1436 let w = wadjsb () + (truncate
(float w *. conf
.zoom
)) in
1439 setfontsize fstate
.fontsize
;
1440 GlMat.mode `modelview
;
1441 GlMat.load_identity
();
1443 GlMat.mode `projection
;
1444 GlMat.load_identity
();
1445 GlMat.rotate ~
x:1.0 ~angle
:180.0 ();
1446 GlMat.translate ~
x:~
-.1.0 ~
y:~
-.1.0 ();
1447 GlMat.scale3
(2.0 /. float state
.winw
, 2.0 /. float state
.winh
, 1.0);
1452 else float state
.x /. float state
.w
1454 invalidate "geometry"
1458 then state
.x <- truncate
(relx *. float w);
1460 match conf
.columns
with
1462 | Cmulti
((c, _
, _
), _
) -> (w - (c-1)*conf
.interpagespace
) / c
1463 | Csplit
(c, _
) -> w * c
1465 wcmd "geometry %d %d %d"
1466 w (stateh h) (FMTE.to_int conf
.fitmodel
)
1471 let len = String.length state
.text in
1472 let x0 = xadjsb () in
1475 match state
.mode
with
1476 | Textentry _
| View
| LinkNav _
->
1477 let h, _
, _
= state
.uioh#scrollpw
in
1482 filledrect x (float (state
.winh
- (fstate
.fontsize
+ 4) - hscrollh))
1483 (x+.w) (float (state
.winh
- hscrollh))
1486 let w = float (wadjsb () + state
.winw
- 1) in
1487 if state
.progress
>= 0.0 && state
.progress
< 1.0
1489 GlDraw.color
(0.3, 0.3, 0.3);
1490 let w1 = w *. state
.progress
in
1492 GlDraw.color
(0.0, 0.0, 0.0);
1493 rect (float x0+.w1) (float x0+.w-.w1)
1496 GlDraw.color
(0.0, 0.0, 0.0);
1500 GlDraw.color
(1.0, 1.0, 1.0);
1501 drawstring fstate
.fontsize
1502 (if conf
.leftscroll
then x0 + 2 else x0 + if len > 0 then 8 else 2)
1503 (state
.winh
- hscrollh - 5) s;
1506 match state
.mode
with
1507 | Textentry
((prefix
, text, _
, _
, _
, _
), _
) ->
1511 Printf.sprintf
"%s%s_ [%s]" prefix
text state
.text
1513 Printf.sprintf
"%s%s_" prefix
text
1519 | LinkNav _
-> state
.text
1524 if not
(istextentry state
.mode
) && state
.uioh#eformsgs
1526 let s1 = "(press 'e' to review error messasges)" in
1527 if nonemptystr
s then s ^
" " ^
s1 else s1
1537 let len = Queue.length state
.tilelru
in
1539 match state
.throttle
with
1542 then preloadlayout state
.y
1544 | Some
(layout, _
, _
) ->
1548 if state
.memused
<= conf
.memlimit
1553 let (k
, p
, s) as lruitem
= Queue.pop state
.tilelru
in
1554 let n, gen
, colorspace
, angle
, pagew
, pageh
, col, row = k
in
1555 let (_
, pw, ph
, _
) = getpagedim
n in
1558 && colorspace
= conf
.colorspace
1559 && angle
= conf
.angle
1563 let x = col*conf
.tilew
1564 and y = row*conf
.tileh
in
1565 tilevisible (Lazy.force_val
layout) n x y
1567 then Queue.push lruitem state
.tilelru
1570 wcmd "freetile %s" (~
> p
);
1571 state
.memused
<- state
.memused
- s;
1572 state
.uioh#infochanged Memused
;
1573 Hashtbl.remove state
.tilemap k
;
1581 let logcurrently = function
1582 | Idle
-> dolog
"Idle"
1583 | Loading
(l, gen
) ->
1584 dolog
"Loading %d gen=%d curgen=%d" l.pageno gen state
.gen
1585 | Tiling
(l, pageopaque
, colorspace
, angle
, gen
, col, row, tilew
, tileh
) ->
1587 "Tiling %d[%d,%d] page=%s cs=%s angle"
1588 l.pageno
col row (~
> pageopaque
)
1589 (CSTE.to_string colorspace
)
1591 dolog
"gen=(%d,%d) (%d,%d) tile=(%d,%d) (%d,%d)"
1592 angle gen conf
.angle state
.gen
1594 conf
.tilew conf
.tileh
1601 let r = Str.regexp
" " in
1602 fun s -> Str.bounded_split
r s 2;
1605 let onpagerect pageno
f =
1607 match conf
.columns
with
1608 | Cmulti
(_
, b) -> b
1610 | Csplit
(_
, b) -> b
1612 if pageno
>= 0 && pageno
< Array.length
b
1614 let (_
, _
, _
, (w, h, _
, _
)) = b.(pageno
) in
1618 let gotopagexy1 pageno
x y =
1619 let _,w1,h1
,leftx
= getpagedim pageno
in
1620 let top = y /. (float h1
) in
1621 let left = x /. (float w1) in
1622 let py, w, h = getpageywh pageno
in
1623 let wh = state
.winh
- hscrollh () in
1624 let x = left *. (float w) in
1625 let x = leftx
+ state
.x + truncate
x in
1626 let wadj = wadjsb () in
1628 if x < 0 || x >= wadj + state
.winw
1632 let pdy = truncate
(top *. float h) in
1633 let y'
= py + pdy in
1634 let dy = y'
- state
.y in
1636 if x != state
.x || not
(dy > 0 && dy < wh)
1638 if conf
.presentation
1640 if abs
(py - y'
) > wh
1647 if state
.x != sx || state
.y != sy
1652 let ww = wadj + state
.winw
in
1654 and qy
= pdy / wh in
1656 and y = py + qy
* wh in
1657 let x = if -x + ww > w1 then -(w1-ww) else x
1658 and y'
= if y + wh > state
.maxy
then state
.maxy
- wh else y in
1660 if conf
.presentation
1662 if abs
(py - y'
) > wh
1672 gotoy_and_clear_text y;
1674 else gotoy_and_clear_text state
.y;
1677 let gotopagexy pageno
x y =
1678 match state
.mode
with
1679 | Birdseye
_ -> gotopage pageno
0.0
1682 | LinkNav
_ -> gotopagexy1 pageno
x y
1685 let getpassword () =
1686 let passcmd = getenvwithdef
"LLPP_ASKPASS" conf
.passcmd in
1690 match Unix.open_process_in
passcmd with
1691 | (exception exn
) ->
1694 "getpassword: open_process_in failed: %s" (exntos exn
));
1697 let s = try input_line ic
with End_of_file
-> E.s in
1699 match Unix.close_process_in ic
with
1700 | (exception exn
) ->
1702 (Printf.sprintf
"getpassword: close_process_in failed: %s"
1711 (* dolog "%S" cmds; *)
1712 let cl = splitatspace cmds
in
1714 try Scanf.sscanf
s fmt
f
1716 dolog
"error processing '%S': %s" cmds
(exntos exn
);
1719 let addoutline outline
=
1720 match state
.currently
with
1721 | Outlining outlines
->
1722 state
.currently
<- Outlining
(outline
:: outlines
)
1723 | Idle
-> state
.currently
<- Outlining
[outline
]
1726 dolog
"invalid outlining state";
1727 logcurrently state
.currently
1731 state
.uioh#infochanged Pdim
;
1734 | "clearrects" :: [] ->
1735 state
.rects
<- state
.rects1
;
1736 G.postRedisplay "clearrects";
1738 | "continue" :: args
:: [] ->
1739 let n = scan args
"%u" (fun n -> n) in
1740 state
.pagecount
<- n;
1741 begin match state
.currently
with
1743 state
.currently
<- Idle
;
1744 state
.outlines
<- Array.of_list
(List.rev
l)
1750 let cur, cmds
= state
.geomcmds
in
1752 then failwith
"umpossible";
1754 begin match List.rev cmds
with
1756 state
.geomcmds
<- E.s, [];
1757 state
.throttle
<- None
;
1761 state
.geomcmds
<- s, List.rev rest
;
1763 if conf
.maxwait
= None
&& not
!wtmode
1764 then G.postRedisplay "continue";
1766 | "msg" :: args
:: [] ->
1769 | "vmsg" :: args
:: [] ->
1771 then showtext ' ' args
1773 | "emsg" :: args
:: [] ->
1774 Buffer.add_string state
.errmsgs args
;
1775 state
.newerrmsgs
<- true;
1776 G.postRedisplay "error message"
1778 | "progress" :: args
:: [] ->
1779 let progress, text =
1782 f, String.sub args pos
(String.length args
- pos
))
1785 state
.progress <- progress;
1786 G.postRedisplay "progress"
1788 | "firstmatch" :: args
:: [] ->
1789 let pageno, c, x0, y0, x1, y1, x2
, y2
, x3
, y3
=
1790 scan args
"%u %d %f %f %f %f %f %f %f %f"
1791 (fun p
c x0 y0 x1 y1 x2 y2 x3 y3
->
1792 (p
, c, x0, y0, x1, y1, x2
, y2
, x3
, y3
))
1794 let xoff = float (xadjsb ()) in
1798 and x3
= x3
+. xoff in
1799 let y = (getpagey
pageno) + truncate
y0 in
1802 state
.rects1
<- [pageno, c, (x0, y0, x1, y1, x2
, y2
, x3
, y3
)]
1804 | "match" :: args
:: [] ->
1805 let pageno, c, x0, y0, x1, y1, x2
, y2
, x3
, y3
=
1806 scan args
"%u %d %f %f %f %f %f %f %f %f"
1807 (fun p
c x0 y0 x1 y1 x2 y2 x3 y3
->
1808 (p
, c, x0, y0, x1, y1, x2
, y2
, x3
, y3
))
1810 let xoff = float (xadjsb ()) in
1814 and x3
= x3
+. xoff in
1816 (pageno, c, (x0, y0, x1, y1, x2
, y2
, x3
, y3
)) :: state
.rects1
1818 | "page" :: args
:: [] ->
1819 let pageopaques, t
= scan args
"%s %f" (fun p t
-> p
, t
) in
1820 let pageopaque = ~
< pageopaques in
1821 begin match state
.currently
with
1822 | Loading
(l, gen
) ->
1823 vlog "page %d took %f sec" l.pageno t
;
1824 Hashtbl.replace state
.pagemap
(l.pageno, gen
) pageopaque;
1825 begin match state
.throttle
with
1827 let preloadedpages =
1829 then preloadlayout state
.y
1834 List.fold_left
(fun s l -> IntSet.add
l.pageno s)
1835 IntSet.empty
preloadedpages
1838 Hashtbl.fold (fun ((pageno, _) as key) opaque
accu ->
1839 if not
(IntSet.mem
pageno set)
1841 wcmd "freepage %s" (~
> opaque
);
1847 List.iter
(Hashtbl.remove state
.pagemap
) evictedpages;
1850 state
.currently
<- Idle
;
1853 tilepage l.pageno pageopaque state
.layout;
1855 load preloadedpages;
1856 let visible = pagevisible state
.layout l.pageno in
1859 match state
.mode
with
1860 | LinkNav
(Ltnotready
(pageno, dir
)) ->
1861 if pageno = l.pageno
1866 then LDfirstvisible
(l.pagex
, l.pagey, dir
)
1868 if dir
> 0 then LDfirst
else LDlast
1871 findlink
pageopaque ld
1876 showlinktype (getlink
pageopaque n);
1877 state
.mode
<- LinkNav
(Ltexact
(l.pageno, n))
1879 | LinkNav
(Ltgendir
_)
1880 | LinkNav
(Ltexact
_)
1886 if visible && layoutready state
.layout
1888 G.postRedisplay "page";
1892 | Some
(layout, _, _) ->
1893 state
.currently
<- Idle
;
1894 tilepage l.pageno pageopaque layout;
1901 dolog
"Inconsistent loading state";
1902 logcurrently state
.currently
;
1906 | "tile" :: args
:: [] ->
1907 let (x, y, opaques
, size
, t
) =
1908 scan args
"%u %u %s %u %f"
1909 (fun x y p size t
-> (x, y, p
, size
, t
))
1911 let opaque = ~
< opaques
in
1912 begin match state
.currently
with
1913 | Tiling
(l, pageopaque, cs
, angle
, gen
, col, row, tilew
, tileh
) ->
1914 vlog "tile %d [%d,%d] took %f sec" l.pageno col row t
;
1917 if tilew
!= conf
.tilew
|| tileh
!= conf
.tileh
1919 wcmd "freetile %s" (~
> opaque);
1920 state
.currently
<- Idle
;
1924 puttileopaque l col row gen cs angle
opaque size t
;
1925 state
.memused
<- state
.memused
+ size
;
1926 state
.uioh#infochanged Memused
;
1928 Queue.push
((l.pageno, gen
, cs
, angle
, l.pagew
, l.pageh
, col, row),
1929 opaque, size
) state
.tilelru
;
1932 match state
.throttle
with
1933 | None
-> state
.layout
1934 | Some
(layout, _, _) -> layout
1937 state
.currently
<- Idle
;
1939 && conf
.colorspace
= cs
1940 && conf
.angle
= angle
1941 && tilevisible layout l.pageno x y
1942 then conttiling l.pageno pageopaque;
1944 begin match state
.throttle
with
1946 preload state
.layout;
1948 && conf
.colorspace
= cs
1949 && conf
.angle
= angle
1950 && tilevisible state
.layout l.pageno x y
1951 && (not
!wtmode || layoutready state
.layout)
1952 then G.postRedisplay "tile nothrottle";
1954 | Some
(layout, y, _) ->
1955 let ready = layoutready layout in
1959 state
.layout <- layout;
1960 state
.throttle
<- None
;
1961 G.postRedisplay "throttle";
1970 dolog
"Inconsistent tiling state";
1971 logcurrently state
.currently
;
1975 | "pdim" :: args
:: [] ->
1976 let (n, w, h, _) as pdim
=
1977 scan args
"%u %u %u %u" (fun n w h x -> n, w, h, x)
1980 match conf
.fitmodel
with
1982 | FitPage
| FitProportional
->
1983 match conf
.columns
with
1984 | Csplit
_ -> (n, w, h, 0)
1985 | Csingle
_ | Cmulti
_ -> pdim
1987 state
.uioh#infochanged Pdim
;
1988 state
.pdims
<- pdim :: state
.pdims
1990 | "o" :: args
:: [] ->
1991 let (l, n, t
, h, pos
) =
1992 scan args
"%u %u %d %u %n"
1993 (fun l n t
h pos
-> l, n, t
, h, pos
)
1995 let s = String.sub args pos
(String.length args
- pos
) in
1996 addoutline (s, l, Oanchor
(n, float t
/. float h, 0.0))
1998 | "ou" :: args
:: [] ->
1999 let (l, len, pos
) = scan args
"%u %u %n" (fun l len pos
-> l, len, pos
) in
2000 let s = String.sub args pos
len in
2001 let pos2 = pos
+ len + 1 in
2002 let uri = String.sub args
pos2 (String.length args
- pos2) in
2003 addoutline (s, l, Ouri
uri)
2005 | "on" :: args
:: [] ->
2006 let (l, pos
) = scan args
"%u %n" (fun l pos
-> l, pos
) in
2007 let s = String.sub args pos
(String.length args
- pos
) in
2008 addoutline (s, l, Onone
)
2010 | "a" :: args
:: [] ->
2012 scan args
"%u %d %d" (fun n l t
-> n, l, t
)
2014 state
.reprf
<- (fun () -> gotopagexy n (float l) (float t
))
2016 | "info" :: args
:: [] ->
2017 let pos = nindex args '
\t'
in
2018 if pos >= 0 && String.sub args
0 pos = "Title"
2020 let s = String.sub args
(pos+1) @@ String.length args
- pos - 1 in
2023 state
.docinfo
<- (1, args
) :: state
.docinfo
2025 | "infoend" :: [] ->
2026 state
.uioh#infochanged Docinfo
;
2027 state
.docinfo
<- List.rev state
.docinfo
2031 then Wsi.settitle
"Wrong password";
2032 let password = getpassword () in
2034 then error
"document is password protected"
2035 else opendoc state
.path
password
2038 error
"unknown cmd `%S'" cmds
2043 let action = function
2044 | HCprev
-> cbget cb ~
-1
2045 | HCnext
-> cbget cb
1
2046 | HCfirst
-> cbget cb ~
-(cb
.rc)
2047 | HClast
-> cbget cb
(cb
.len - 1 - cb
.rc)
2048 and cancel
() = cb
.rc <- rc
2052 let search pattern forward
=
2053 match conf
.columns
with
2055 showtext '
!'
"searching does not work properly in split columns mode"
2058 if nonemptystr pattern
2061 match state
.layout with
2064 l.pageno, (l.pagey + if forward
then 0 else 0*l.pagevh)
2066 wcmd "search %d %d %d %d,%s\000"
2067 (btod conf
.icase
) pn py (btod forward
) pattern
;
2070 let intentry text key =
2072 if key >= 32 && key < 127
2078 let text = addchar text c in
2082 state
.text <- Printf.sprintf
"invalid char (%d, `%c')" key c;
2086 let linknentry text key =
2088 if key >= 32 && key < 127
2094 let text = addchar text c in
2098 state
.text <- Printf.sprintf
"invalid char (%d, `%c')" key c;
2106 let l = String.length
s in
2107 let rec loop pos n = if pos = l then n else
2108 let m = Char.code
s.[pos] - (if pos = 0 && l > 1 then 96 else 97) in
2109 loop (pos+1) (n*26 + m)
2112 let rec loop n = function
2115 match getopaque l.pageno with
2116 | None
-> loop n rest
2118 let m = getlinkcount
opaque in
2121 let under = getlink
opaque n in
2124 else loop (n-m) rest
2126 loop n state
.layout;
2130 let textentry text key =
2131 if key land 0xff00 = 0xff00
2133 else TEcont
(text ^ toutf8
key)
2136 let reqlayout angle fitmodel
=
2137 match state
.throttle
with
2139 if nogeomcmds state
.geomcmds
2140 then state
.anchor <- getanchor
();
2141 conf
.angle
<- angle
mod 360;
2144 match state
.mode
with
2145 | LinkNav
_ -> state
.mode
<- View
2150 conf
.fitmodel
<- fitmodel
;
2151 invalidate "reqlayout"
2153 wcmd "reqlayout %d %d %d"
2154 conf
.angle
(FMTE.to_int conf
.fitmodel
) (stateh state
.winh
)
2159 let settrim trimmargins trimfuzz
=
2160 if nogeomcmds state
.geomcmds
2161 then state
.anchor <- getanchor
();
2162 conf
.trimmargins
<- trimmargins
;
2163 conf
.trimfuzz
<- trimfuzz
;
2164 let x0, y0, x1, y1 = trimfuzz
in
2165 invalidate "settrim"
2167 wcmd "settrim %d %d %d %d %d" (btod conf
.trimmargins
) x0 y0 x1 y1);
2172 match state
.throttle
with
2174 let zoom = max
0.0001 zoom in
2175 if zoom <> conf
.zoom
2177 state
.prevzoom
<- (conf
.zoom, state
.x);
2179 reshape state
.winw state
.winh
;
2180 state
.text <- Printf.sprintf
"zoom is now %-5.2f" (zoom *. 100.0);
2183 | Some
(layout, y, started
) ->
2185 match conf
.maxwait
with
2189 let dt = now
() -. started
in
2197 let setcolumns mode columns coverA coverB
=
2198 state
.prevcolumns
<- Some
(conf
.columns
, conf
.zoom);
2202 then showtext '
!'
"split mode doesn't work in bird's eye"
2204 conf
.columns
<- Csplit
(-columns
, E.a);
2212 conf
.columns
<- Csingle
E.a;
2217 conf
.columns
<- Cmulti
((columns
, coverA
, coverB
), E.a);
2221 reshape state
.winw state
.winh
;
2224 let resetmstate () =
2225 state
.mstate
<- Mnone
;
2226 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
2229 let enterbirdseye () =
2230 let zoom = float conf
.thumbw
/. float state
.winw
in
2231 let birdseyepageno =
2232 let cy = state
.winh
/ 2 in
2236 let rec fold best
= function
2239 let d = cy - (l.pagedispy + l.pagevh/2)
2240 and dbest
= cy - (best
.pagedispy + best
.pagevh/2) in
2241 if abs
d < abs dbest
2248 state
.mode
<- Birdseye
(
2249 { conf
with zoom = conf
.zoom }, state
.x, birdseyepageno, -1, getanchor
()
2253 conf
.presentation
<- false;
2254 conf
.interpagespace
<- 10;
2255 conf
.hlinks
<- false;
2256 conf
.fitmodel
<- FitPage
;
2258 conf
.maxwait
<- None
;
2260 match conf
.beyecolumns
with
2263 Cmulti
((c, 0, 0), E.a)
2264 | None
-> Csingle
E.a
2268 state
.text <- Printf.sprintf
"birds eye mode on (zoom %3.1f%%)"
2273 reshape state
.winw state
.winh
;
2276 let leavebirdseye (c, leftx
, pageno, _, anchor) goback
=
2278 conf
.zoom <- c.zoom;
2279 conf
.presentation
<- c.presentation
;
2280 conf
.interpagespace
<- c.interpagespace
;
2281 conf
.maxwait
<- c.maxwait
;
2282 conf
.hlinks
<- c.hlinks
;
2283 conf
.fitmodel
<- c.fitmodel
;
2284 conf
.beyecolumns
<- (
2285 match conf
.columns
with
2286 | Cmulti
((c, _, _), _) -> Some
c
2288 | Csplit
_ -> failwith
"leaving bird's eye split mode"
2291 match c.columns
with
2292 | Cmulti
(c, _) -> Cmulti
(c, E.a)
2293 | Csingle
_ -> Csingle
E.a
2294 | Csplit
(c, _) -> Csplit
(c, E.a)
2298 state
.text <- Printf.sprintf
"birds eye mode off (zoom %3.1f%%)"
2301 reshape state
.winw state
.winh
;
2302 state
.anchor <- if goback
then anchor else (pageno, 0.0, 1.0);
2306 let togglebirdseye () =
2307 match state
.mode
with
2308 | Birdseye vals
-> leavebirdseye vals
true
2309 | View
-> enterbirdseye ()
2314 let upbirdseye incr
(conf
, leftx
, pageno, hooverpageno
, anchor) =
2315 let pageno = max
0 (pageno - incr
) in
2316 let rec loop = function
2317 | [] -> gotopage1 pageno 0
2318 | l :: _ when l.pageno = pageno ->
2319 if l.pagedispy >= 0 && l.pagey = 0
2320 then G.postRedisplay "upbirdseye"
2321 else gotopage1 pageno 0
2322 | _ :: rest
-> loop rest
2326 state
.mode
<- Birdseye
(conf
, leftx
, pageno, hooverpageno
, anchor)
2329 let downbirdseye incr
(conf
, leftx
, pageno, hooverpageno
, anchor) =
2330 let pageno = min
(state
.pagecount
- 1) (pageno + incr
) in
2331 state
.mode
<- Birdseye
(conf
, leftx
, pageno, hooverpageno
, anchor);
2332 let rec loop = function
2334 let y, h = getpageyh
pageno in
2335 let dy = (y - state
.y) - (state
.winh
- h - conf
.interpagespace
) in
2337 | l :: _ when l.pageno = pageno ->
2338 if l.pagevh != l.pageh
2339 then gotoy (clamp (l.pageh
- l.pagevh + conf
.interpagespace
))
2340 else G.postRedisplay "downbirdseye"
2341 | _ :: rest
-> loop rest
2347 let boundastep h step
=
2349 then bound step ~
-h 0
2353 let optentry mode
_ key =
2354 let btos b = if b then "on" else "off" in
2355 if key >= 32 && key < 127
2357 let c = Char.chr
key in
2361 try conf
.scrollstep
<- int_of_string
s with exc
->
2362 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2364 TEswitch
("scroll step: ", E.s, None
, intentry, ondone, true)
2369 conf
.autoscrollstep
<- boundastep state
.winh
(int_of_string
s);
2370 if state
.autoscroll
<> None
2371 then state
.autoscroll
<- Some conf
.autoscrollstep
2373 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2375 TEswitch
("auto scroll step: ", E.s, None
, intentry, ondone, true)
2380 let n, a, b = multicolumns_of_string
s in
2381 setcolumns mode
n a b;
2383 state
.text <- Printf.sprintf
"bad columns `%s': %s" s (exntos exc
)
2385 TEswitch
("columns: ", E.s, None
, textentry, ondone, true)
2390 let zoom = float (int_of_string
s) /. 100.0 in
2393 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2395 TEswitch
("zoom: ", E.s, None
, intentry, ondone, true)
2400 conf
.thumbw
<- bound
(int_of_string
s) 2 4096;
2402 Printf.sprintf
"thumbnail width is set to %d" conf
.thumbw
;
2403 begin match mode
with
2405 leavebirdseye beye
false;
2412 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2414 TEswitch
("thumbnail width: ", E.s, None
, intentry, ondone, true)
2419 Some
(int_of_string
s)
2421 state
.text <- Printf.sprintf
"bad integer `%s': %s"
2425 | Some angle
-> reqlayout angle conf
.fitmodel
2428 TEswitch
("rotation: ", E.s, None
, intentry, ondone, true)
2431 conf
.icase
<- not conf
.icase
;
2432 TEdone
("case insensitive search " ^
(btos conf
.icase
))
2435 conf
.preload <- not conf
.preload;
2437 TEdone
("preload " ^
(btos conf
.preload))
2440 conf
.verbose
<- not conf
.verbose
;
2441 TEdone
("verbose " ^
(btos conf
.verbose
))
2444 conf
.debug
<- not conf
.debug
;
2445 TEdone
("debug " ^
(btos conf
.debug
))
2448 conf
.maxhfit
<- not conf
.maxhfit
;
2449 state
.maxy
<- calcheight
();
2450 TEdone
("maxhfit " ^
(btos conf
.maxhfit
))
2453 conf
.crophack
<- not conf
.crophack
;
2454 TEdone
("crophack " ^
btos conf
.crophack
)
2458 match conf
.maxwait
with
2460 conf
.maxwait
<- Some infinity
;
2461 "always wait for page to complete"
2463 conf
.maxwait
<- None
;
2464 "show placeholder if page is not ready"
2469 conf
.underinfo
<- not conf
.underinfo
;
2470 TEdone
("underinfo " ^
btos conf
.underinfo
)
2473 conf
.savebmarks
<- not conf
.savebmarks
;
2474 TEdone
("persistent bookmarks " ^
btos conf
.savebmarks
)
2480 match state
.layout with
2485 conf
.interpagespace
<- int_of_string
s;
2486 docolumns conf
.columns
;
2487 state
.maxy
<- calcheight
();
2488 let y = getpagey
pageno in
2491 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2493 TEswitch
("vertical margin: ", E.s, None
, intentry, ondone, true)
2497 match conf
.fitmodel
with
2498 | FitProportional
-> FitWidth
2499 | FitWidth
| FitPage
-> FitProportional
2501 reqlayout conf
.angle
fm;
2502 TEdone
("proportional display " ^
btos (fm == FitProportional
))
2505 settrim (not conf
.trimmargins
) conf
.trimfuzz
;
2506 TEdone
("trim margins " ^
btos conf
.trimmargins
)
2509 conf
.invert
<- not conf
.invert
;
2510 TEdone
("invert colors " ^
btos conf
.invert
)
2514 cbput state
.hists
.sel
s;
2517 TEswitch
("selection command: ", E.s, Some
(onhist state
.hists
.sel
),
2518 textentry, ondone, true)
2522 then conf
.pax
<- Some
(ref (0.0, 0, 0))
2523 else conf
.pax
<- None
;
2524 TEdone
("PAX " ^
btos (conf
.pax
!= None
))
2527 state
.text <- Printf.sprintf
"bad option %d `%c'" key c;
2533 class type lvsource
= object
2534 method getitemcount
: int
2535 method getitem
: int -> (string * int)
2536 method hasaction
: int -> bool
2544 method getactive
: int
2545 method getfirst
: int
2547 method getminfo
: (int * int) array
2550 class virtual lvsourcebase
= object
2551 val mutable m_active
= 0
2552 val mutable m_first
= 0
2553 val mutable m_pan
= 0
2554 method getactive
= m_active
2555 method getfirst
= m_first
2556 method getpan
= m_pan
2557 method getminfo
: (int * int) array
= E.a
2560 let withoutlastutf8 s =
2561 let len = String.length
s in
2569 let b = Char.code
s.[pos] in
2570 if b land 0b11000000 = 0b11000000
2575 if Char.code
s.[len-1] land 0x80 = 0
2579 String.sub
s 0 first;
2582 let textentrykeyboard
2583 key _mask
((c, text, opthist
, onkey
, ondone, cancelonempty
), onleave
) =
2585 if key >= 0xffb0 && key <= 0xffb9
2586 then key - 0xffb0 + 48 else key
2589 state
.mode
<- Textentry
(te
, onleave
);
2592 G.postRedisplay "textentrykeyboard enttext";
2594 let histaction cmd
=
2597 | Some
(action, _) ->
2598 state
.mode
<- Textentry
(
2599 (c, action cmd
, opthist
, onkey
, ondone, cancelonempty
), onleave
2601 G.postRedisplay "textentry histaction"
2605 if emptystr
text && cancelonempty
2608 G.postRedisplay "textentrykeyboard after cancel";
2611 let s = withoutlastutf8 text in
2612 enttext (c, s, opthist
, onkey
, ondone, cancelonempty
)
2614 | @enter
| @kpenter
->
2617 G.postRedisplay "textentrykeyboard after confirm"
2619 | @up
| @kpup
-> histaction HCprev
2620 | @down
| @kpdown
-> histaction HCnext
2621 | @home
| @kphome
-> histaction HCfirst
2622 | @jend
| @kpend
-> histaction HClast
2627 begin match opthist
with
2629 | Some
(_, onhistcancel
) -> onhistcancel
()
2633 G.postRedisplay "textentrykeyboard after cancel2"
2636 enttext (c, E.s, opthist
, onkey
, ondone, cancelonempty
)
2639 | @delete
| @kpdelete
-> ()
2642 && key land 0xff00 != 0xff00 (* keyboard *)
2643 && key land 0xfe00 != 0xfe00 (* xkb *)
2644 && key land 0xfd00 != 0xfd00 (* 3270 *)
2646 begin match onkey
text key with
2650 G.postRedisplay "textentrykeyboard after confirm2";
2653 enttext (c, text, opthist
, onkey
, ondone, cancelonempty
);
2657 G.postRedisplay "textentrykeyboard after cancel3"
2660 state
.mode
<- Textentry
(te
, onleave
);
2661 G.postRedisplay "textentrykeyboard switch";
2665 vlog "unhandled key %s" (Wsi.keyname
key)
2668 let firstof first active
=
2669 if first > active
|| abs
(first - active
) > fstate
.maxrows
- 1
2670 then max
0 (active
- (fstate
.maxrows
/2))
2674 let calcfirst first active
=
2677 let rows = active
- first in
2678 if rows > fstate
.maxrows
then active
- fstate
.maxrows
else first
2682 let scrollph y maxy
=
2683 let sh = float (maxy
+ state
.winh
) /. float state
.winh
in
2684 let sh = float state
.winh
/. sh in
2685 let sh = max
sh (float conf
.scrollh
) in
2687 let percent = float y /. float maxy
in
2688 let position = (float state
.winh
-. sh) *. percent in
2691 if position +. sh > float state
.winh
2692 then float state
.winh
-. sh
2698 let coe s = (s :> uioh
);;
2700 class listview ~zebra ~helpmode ~
(source
:lvsource
) ~trusted ~modehash
=
2702 val m_pan
= source#getpan
2703 val m_first
= source#getfirst
2704 val m_active
= source#getactive
2706 val m_prev_uioh
= state
.uioh
2708 method private elemunder
y =
2712 let n = y / (fstate
.fontsize
+1) in
2713 if m_first
+ n < source#getitemcount
2715 if source#hasaction
(m_first
+ n)
2716 then Some
(m_first
+ n)
2723 GlFunc.blend_func ~src
:`src_alpha ~dst
:`one_minus_src_alpha
;
2724 GlDraw.color
(0., 0., 0.) ~alpha
:0.85;
2725 filledrect 0. 0. (float state
.winw
) (float state
.winh
);
2726 GlDraw.color
(1., 1., 1.);
2727 Gl.enable `texture_2d
;
2728 let fs = fstate
.fontsize
in
2730 let hw = (wadjsb () + xadjsb () + state
.winw
)/3 in
2731 let ww = fstate
.wwidth
in
2732 let tabw = 17.0*.ww in
2733 let itemcount = source#getitemcount
in
2734 let minfo = source#getminfo
in
2737 then float (xadjsb ()), float (state
.winw
- 1)
2738 else 0.0, float (state
.winw
- conf
.scrollbw
- 1)
2740 let xadj = xadjsb () in
2742 if (row - m_first
) > fstate
.maxrows
2745 if row >= 0 && row < itemcount
2747 let (s, level
) = source#getitem
row in
2748 let y = (row - m_first
) * nfs in
2750 (if conf
.leftscroll
then float xadj else 5.0)
2751 +. (float (level
+ m_pan
)) *. ww in
2754 (let c = if row land 1 = 0 then 1.0 else 0.92 in (c,c,c));
2758 Gl.disable `texture_2d
;
2759 let alpha = if source#hasaction
row then 0.9 else 0.3 in
2760 GlDraw.color
(1., 1., 1.) ~
alpha;
2761 linerect (x0 +. 1.) (float (y + 1)) (x1) (float (y + fs + 3));
2762 Gl.enable `texture_2d
;
2765 if zebra
&& row land 1 = 1
2769 GlDraw.color
(c,c,c);
2770 let drawtabularstring s =
2772 let x'
= truncate
(x0 +. x) in
2773 let pos = nindex
s '
\000'
in
2775 then drawstring1 fs x'
(y+nfs) s
2777 let s1 = String.sub
s 0 pos
2778 and s2
= String.sub
s (pos+1) (String.length
s - pos - 1) in
2783 let s'
= withoutlastutf8 s in
2784 let s = s' ^
"@Uellipsis" in
2785 let w = measurestr
fs s in
2786 if float x'
+. w +. ww < float (hw + x'
)
2791 if float x'
+. ww +. measurestr
fs s1 > float (hw + x'
)
2795 ignore
(drawstring1 fs x'
(y+nfs) s1);
2796 drawstring1 fs (hw + x'
) (y+nfs) s2
2800 let x = if helpmode
&& row > 0 then x +. ww else x in
2801 let tabpos = nindex
s '
\t'
in
2804 let len = String.length
s - tabpos - 1 in
2805 let s1 = String.sub
s 0 tabpos
2806 and s2
= String.sub
s (tabpos + 1) len in
2807 let nx = drawstr x s1 in
2809 let x = x +. (max
tabw sw) in
2812 let len = String.length
s - 2 in
2813 if len > 0 && s.[0] = '
\xc2'
&& s.[1] = '
\xb7'
2815 let s = String.sub
s 2 len in
2816 let x = if not helpmode
then x +. ww else x in
2817 GlDraw.color
(1.2, 1.2, 1.2);
2818 let vinc = drawstring1 (fs+fs/4)
2819 (truncate
(x -. ww)) (y+nfs) s in
2820 GlDraw.color
(1., 1., 1.);
2821 vinc +. (float fs *. 0.8)
2827 ignore
(drawtabularstring s);
2833 GlDraw.color
(1.0, 1.0, 1.0) ~
alpha:0.5;
2834 let xadj = float (xadjsb () + 5) in
2836 if (row - m_first
) > fstate
.maxrows
2839 if row >= 0 && row < itemcount
2841 let (s, level
) = source#getitem
row in
2842 let pos0 = nindex
s '
\000'
in
2843 let y = (row - m_first
) * nfs in
2844 let x = float (level
+ m_pan
) *. ww in
2845 let (first, last
) = minfo.(row) in
2847 if pos0 > 0 && first > pos0
2848 then String.sub
s (pos0+1) (first-pos0-1)
2849 else String.sub
s 0 first
2851 let suffix = String.sub
s first (last
- first) in
2852 let w1 = measurestr fstate
.fontsize
prefix in
2853 let w2 = measurestr fstate
.fontsize
suffix in
2854 let x = x +. if conf
.leftscroll
then xadj else 5.0 in
2855 let x = if pos0 > 0 && first > pos0 then x +. float hw else x in
2857 and y0 = float (y+2) in
2859 and y1 = float (y+fs+3) in
2860 filledrect x0 y0 x1 y1;
2865 Gl.disable `texture_2d
;
2866 if Array.length
minfo > 0 then loop m_first
;
2869 method updownlevel incr
=
2870 let len = source#getitemcount
in
2872 if m_active
>= 0 && m_active
< len
2873 then snd
(source#getitem m_active
)
2877 if i
= len then i
-1 else if i
= -1 then 0 else
2878 let _, l = source#getitem i
in
2879 if l != curlevel then i
else flow (i
+incr
)
2881 let active = flow m_active
in
2882 let first = calcfirst m_first
active in
2883 G.postRedisplay "outline updownlevel";
2884 {< m_active
= active; m_first
= first >}
2886 method private key1
key mask
=
2887 let set1 active first qsearch
=
2888 coe {< m_active
= active; m_first
= first; m_qsearch
= qsearch
>}
2890 let search active pattern incr
=
2891 let active = if active = -1 then m_first
else active in
2894 if n >= 0 && n < source#getitemcount
2896 let s, _ = source#getitem
n in
2898 (try ignore
(Str.search_forward
re s 0); true
2899 with Not_found
-> false)
2901 else loop (n + incr
)
2908 let re = Str.regexp_case_fold pattern
in
2914 let itemcount = source#getitemcount
in
2915 let find start incr
=
2917 if i
= -1 || i
= itemcount
2920 if source#hasaction i
2922 else find (i
+ incr
)
2927 let set active first =
2928 let first = bound
first 0 (itemcount - fstate
.maxrows
) in
2930 coe {< m_active
= active; m_first
= first; m_qsearch
= E.s >}
2933 let isvisible first n = n >= first && n - first <= fstate
.maxrows
in
2935 let incr1 = if incr
> 0 then 1 else -1 in
2936 if isvisible m_first m_active
2939 let next = m_active
+ incr
in
2941 if next < 0 || next >= itemcount
2943 else find next incr1
2945 if abs
(m_active
- next) > fstate
.maxrows
2951 let first = m_first
+ incr
in
2952 let first = bound
first 0 (itemcount - fstate
.maxrows
) in
2954 let next = m_active
+ incr
in
2955 let next = bound
next 0 (itemcount - 1) in
2962 if isvisible first next
2969 let first = min
next m_first
in
2971 if abs
(next - first) > fstate
.maxrows
2977 let first = m_first
+ incr
in
2978 let first = bound
first 0 (itemcount - 1) in
2980 let next = m_active
+ incr
in
2981 let next = bound
next 0 (itemcount - 1) in
2982 let next = find next incr1 in
2984 if next = -1 || abs
(m_active
- first) > fstate
.maxrows
2986 let active = if m_active
= -1 then next else m_active
in
2991 if isvisible first active
2997 G.postRedisplay "listview navigate";
3001 | (@r|@s) when Wsi.withctrl mask
->
3002 let incr = if key = @r then -1 else 1 in
3004 match search (m_active
+ incr) m_qsearch
incr with
3006 state
.text <- m_qsearch ^
" [not found]";
3009 state
.text <- m_qsearch
;
3010 active, firstof m_first
active
3012 G.postRedisplay "listview ctrl-r/s";
3013 set1 active first m_qsearch
;
3015 | @insert
when Wsi.withctrl mask
->
3016 if m_active
>= 0 && m_active
< source#getitemcount
3018 let s, _ = source#getitem m_active
in
3024 if emptystr m_qsearch
3027 let qsearch = withoutlastutf8 m_qsearch
in
3031 G.postRedisplay "listview empty qsearch";
3032 set1 m_active m_first
E.s;
3036 match search m_active
qsearch ~
-1 with
3038 state
.text <- qsearch ^
" [not found]";
3041 state
.text <- qsearch;
3042 active, firstof m_first
active
3044 G.postRedisplay "listview backspace qsearch";
3045 set1 active first qsearch
3048 | key when (key != 0 && key land 0xff00 != 0xff00) ->
3049 let pattern = m_qsearch ^ toutf8
key in
3051 match search m_active
pattern 1 with
3053 state
.text <- pattern ^
" [not found]";
3056 state
.text <- pattern;
3057 active, firstof m_first
active
3059 G.postRedisplay "listview qsearch add";
3060 set1 active first pattern;
3064 if emptystr m_qsearch
3066 G.postRedisplay "list view escape";
3069 source#exit ~uioh
:(coe self
)
3070 ~cancel
:true ~
active:m_active ~
first:m_first ~pan
:m_pan
3072 | None
-> m_prev_uioh
3077 G.postRedisplay "list view kill qsearch";
3078 coe {< m_qsearch
= E.s >}
3081 | @enter
| @kpenter
->
3083 let self = {< m_qsearch
= E.s >} in
3085 G.postRedisplay "listview enter";
3086 if m_active
>= 0 && m_active
< source#getitemcount
3088 source#exit ~uioh
:(coe self) ~cancel
:false
3089 ~
active:m_active ~
first:m_first ~pan
:m_pan
;
3092 source#exit ~uioh
:(coe self) ~cancel
:true
3093 ~
active:m_active ~
first:m_first ~pan
:m_pan
;
3096 begin match opt with
3097 | None
-> m_prev_uioh
3101 | @delete
| @kpdelete
->
3104 | @up
| @kpup
-> navigate ~
-1
3105 | @down
| @kpdown
-> navigate 1
3106 | @prior
| @kpprior
-> navigate ~
-(fstate
.maxrows
)
3107 | @next | @kpnext
-> navigate fstate
.maxrows
3109 | @right
| @kpright
->
3111 G.postRedisplay "listview right";
3112 coe {< m_pan
= m_pan
- 1 >}
3114 | @left | @kpleft
->
3116 G.postRedisplay "listview left";
3117 coe {< m_pan
= m_pan
+ 1 >}
3119 | @home
| @kphome
->
3120 let active = find 0 1 in
3121 G.postRedisplay "listview home";
3125 let first = max
0 (itemcount - fstate
.maxrows
) in
3126 let active = find (itemcount - 1) ~
-1 in
3127 G.postRedisplay "listview end";
3130 | key when (key = 0 || key land 0xff00 = 0xff00) ->
3134 dolog
"listview unknown key %#x" key; coe self
3136 method key key mask
=
3137 match state
.mode
with
3138 | Textentry te
-> textentrykeyboard key mask te
; coe self
3141 | LinkNav
_ -> self#key1
key mask
3143 method button button down
x y _ =
3146 | 1 when x > state
.winw
- conf
.scrollbw
->
3147 G.postRedisplay "listview scroll";
3150 let _, position, sh = self#
scrollph in
3151 if y > truncate
position && y < truncate
(position +. sh)
3153 state
.mstate
<- Mscrolly
;
3157 let s = float (max
0 (y - conf
.scrollh
)) /. float state
.winh
in
3158 let first = truncate
(s *. float source#getitemcount
) in
3159 let first = min source#getitemcount
first in
3160 Some
(coe {< m_first
= first; m_active
= first >})
3162 state
.mstate
<- Mnone
;
3166 begin match self#elemunder
y with
3168 G.postRedisplay "listview click";
3169 source#exit ~uioh
:(coe {< m_active
= n >})
3170 ~cancel
:false ~
active:n ~
first:m_first ~pan
:m_pan
3174 | n when (n == 4 || n == 5) && not down
->
3175 let len = source#getitemcount
in
3177 if n = 5 && m_first
+ fstate
.maxrows
>= len
3181 let first = m_first
+ (if n == 4 then -1 else 1) in
3182 bound
first 0 (len - 1)
3184 G.postRedisplay "listview wheel";
3185 Some
(coe {< m_first
= first >})
3186 | n when (n = 6 || n = 7) && not down
->
3187 let inc = if n = 7 then -1 else 1 in
3188 G.postRedisplay "listview hwheel";
3189 Some
(coe {< m_pan
= m_pan
+ inc >})
3194 | None
-> m_prev_uioh
3197 method multiclick
_ x y = self#button
1 true x y
3200 match state
.mstate
with
3202 let s = float (max
0 (y - conf
.scrollh
)) /. float state
.winh
in
3203 let first = truncate
(s *. float source#getitemcount
) in
3204 let first = min source#getitemcount
first in
3205 G.postRedisplay "listview motion";
3206 coe {< m_first
= first; m_active
= first >}
3214 method pmotion
x y =
3215 if x < state
.winw
- conf
.scrollbw
3218 match self#elemunder
y with
3219 | None
-> Wsi.setcursor
Wsi.CURSOR_INHERIT
; m_active
3220 | Some
n -> Wsi.setcursor
Wsi.CURSOR_INFO
; n
3224 then (G.postRedisplay "listview pmotion"; {< m_active
= n >})
3229 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
3233 method infochanged
_ = ()
3235 method scrollpw
= (0, 0.0, 0.0)
3237 let nfs = fstate
.fontsize
+ 1 in
3238 let y = m_first
* nfs in
3239 let itemcount = source#getitemcount
in
3240 let maxi = max
0 (itemcount - fstate
.maxrows
) in
3241 let maxy = maxi * nfs in
3242 let p, h = scrollph y maxy in
3245 method modehash
= modehash
3246 method eformsgs
= false
3247 method alwaysscrolly
= true
3250 class outlinelistview ~zebra ~source
=
3251 let settext autonarrow
s =
3254 let ss = source#statestr
in
3258 else "{" ^
ss ^
"} [" ^
s ^
"]"
3259 else state
.text <- s
3265 ~source
:(source
:> lvsource
)
3267 ~modehash
:(findkeyhash conf
"outline")
3270 val m_autonarrow
= false
3272 method! key key mask
=
3274 if emptystr state
.text
3276 else fstate
.maxrows - 2
3278 let calcfirst first active =
3281 let rows = active - first in
3282 if rows > maxrows then active - maxrows else first
3286 let active = m_active
+ incr in
3287 let active = bound
active 0 (source#getitemcount
- 1) in
3288 let first = calcfirst m_first
active in
3289 G.postRedisplay "outline navigate";
3290 coe {< m_active
= active; m_first
= first >}
3292 let navscroll first =
3294 let dist = m_active
- first in
3300 else first + maxrows
3303 G.postRedisplay "outline navscroll";
3304 coe {< m_first
= first; m_active
= active >}
3306 let ctrl = Wsi.withctrl mask
in
3311 then (source#denarrow
; E.s)
3313 let pattern = source#renarrow
in
3314 if nonemptystr m_qsearch
3315 then (source#narrow m_qsearch
; m_qsearch
)
3319 settext (not m_autonarrow
) text;
3320 G.postRedisplay "toggle auto narrowing";
3321 coe {< m_first
= 0; m_active
= 0; m_autonarrow
= not m_autonarrow
>}
3323 | @slash
when emptystr m_qsearch
&& not m_autonarrow
->
3325 G.postRedisplay "toggle auto narrowing";
3326 coe {< m_first
= 0; m_active
= 0; m_autonarrow
= true >}
3329 source#narrow m_qsearch
;
3331 then source#add_narrow_pattern m_qsearch
;
3332 G.postRedisplay "outline ctrl-n";
3333 coe {< m_first
= 0; m_active
= 0 >}
3336 let active = source#calcactive
(getanchor
()) in
3337 let first = firstof m_first
active in
3338 G.postRedisplay "outline ctrl-s";
3339 coe {< m_first
= first; m_active
= active >}
3342 G.postRedisplay "outline ctrl-u";
3343 if m_autonarrow
&& nonemptystr m_qsearch
3345 ignore
(source#renarrow
);
3346 settext m_autonarrow
E.s;
3347 coe {< m_first
= 0; m_active
= 0; m_qsearch
= E.s >}
3350 source#del_narrow_pattern
;
3351 let pattern = source#renarrow
in
3353 if emptystr
pattern then E.s else "Narrowed to " ^
pattern
3355 settext m_autonarrow
text;
3356 coe {< m_first
= 0; m_active
= 0; m_qsearch
= E.s >}
3360 let first = max
0 (m_active
- (fstate
.maxrows / 2)) in
3361 G.postRedisplay "outline ctrl-l";
3362 coe {< m_first
= first >}
3364 | @tab
when m_autonarrow
->
3365 if nonemptystr m_qsearch
3367 G.postRedisplay "outline list view tab";
3368 source#add_narrow_pattern m_qsearch
;
3370 coe {< m_qsearch
= E.s >}
3374 | @escape
when m_autonarrow
->
3375 if nonemptystr m_qsearch
3376 then source#add_narrow_pattern m_qsearch
;
3379 | @enter
| @kpenter
when m_autonarrow
->
3380 if nonemptystr m_qsearch
3381 then source#add_narrow_pattern m_qsearch
;
3384 | key when m_autonarrow
&& (key != 0 && key land 0xff00 != 0xff00) ->
3385 let pattern = m_qsearch ^ toutf8
key in
3386 G.postRedisplay "outlinelistview autonarrow add";
3387 source#narrow
pattern;
3388 settext true pattern;
3389 coe {< m_first
= 0; m_active
= 0; m_qsearch
= pattern >}
3391 | key when m_autonarrow
&& key = @backspace
->
3392 if emptystr m_qsearch
3395 let pattern = withoutlastutf8 m_qsearch
in
3396 G.postRedisplay "outlinelistview autonarrow backspace";
3397 ignore
(source#renarrow
);
3398 source#narrow
pattern;
3399 settext true pattern;
3400 coe {< m_first
= 0; m_active
= 0; m_qsearch
= pattern >}
3402 | @delete
| @kpdelete
->
3403 source#remove m_active
;
3404 G.postRedisplay "outline delete";
3405 let active = max
0 (m_active
-1) in
3406 coe {< m_first
= firstof m_first
active;
3407 m_active
= active >}
3409 | @up
| @kpup
when ctrl ->
3410 navscroll (max
0 (m_first
- 1))
3412 | @down
| @kpdown
when ctrl ->
3413 navscroll (min
(source#getitemcount
- 1) (m_first
+ 1))
3415 | @up
| @kpup
-> navigate ~
-1
3416 | @down
| @kpdown
-> navigate 1
3417 | @prior
| @kpprior
-> navigate ~
-(fstate
.maxrows)
3418 | @next | @kpnext
-> navigate fstate
.maxrows
3420 | @right
| @kpright
->
3424 G.postRedisplay "outline ctrl right";
3425 {< m_pan
= m_pan
+ 1 >}
3427 else self#updownlevel
1
3431 | @left | @kpleft
->
3435 G.postRedisplay "outline ctrl left";
3436 {< m_pan
= m_pan
- 1 >}
3438 else self#updownlevel ~
-1
3442 | @home
| @kphome
->
3443 G.postRedisplay "outline home";
3444 coe {< m_first
= 0; m_active
= 0 >}
3447 let active = source#getitemcount
- 1 in
3448 let first = max
0 (active - fstate
.maxrows) in
3449 G.postRedisplay "outline end";
3450 coe {< m_active
= active; m_first
= first >}
3452 | _ -> super#
key key mask
3455 let genhistoutlines =
3456 let order ty
(p1
, c1
, _, _, _) (p2
, c2
, _, _, _) =
3458 | `lastvisit
-> compare c1
.lastvisit c2
.lastvisit
3459 | `path
-> compare p2 p1
3460 | `file
-> compare
(Filename.basename p2
) (Filename.basename p1
)
3462 let e1 = emptystr c1
.title
3463 and e2
= emptystr c2
.title
in
3465 then compare
(Filename.basename p2
) (Filename.basename p1
)
3468 else compare c1
.title c2
.title
3470 let showfullpath = ref false in
3473 let s = if orderty
= t
then "[@Uradical] " ^
s else "[ ] " ^
s in
3474 s, 0, Oaction
(fun () -> Config.historder
:= t
; reeenterhist := true)
3476 let list = ref [] in
3477 if Config.gethist
list
3481 (fun accu (path
, c, b, x, a) ->
3482 let hist = (path
, (c, b, x, a)) in
3483 let s = if !showfullpath then path
else Filename.basename path
in
3484 let base = mbtoutf8
s in
3485 (base ^
"\000" ^
c.title
, 1, Ohistory
hist) :: accu
3487 [ setorty "Sort by time of last visit" `lastvisit
;
3488 setorty "Sort by file name" `file
;
3489 setorty "Sort by path" `path
;
3490 setorty "Sort by title" `title
;
3491 (if !showfullpath then "@Uradical "
3492 else " ") ^
"Show full path", 0, Oaction
(fun () ->
3493 showfullpath := not
!showfullpath; reeenterhist := true)
3494 ] (List.sort
(order orderty
) !list)
3500 let gotohist (path
, (c, bookmarks
, x, anchor)) =
3501 Config.save
leavebirdseye;
3502 state
.anchor <- anchor;
3504 state
.bookmarks
<- bookmarks
;
3505 state
.origin
<- E.s;
3507 let x0, y0, x1, y1 = conf
.trimfuzz
in
3508 wcmd "trimset %d %d %d %d %d" (btod conf
.trimmargins
) x0 y0 x1 y1;
3512 let makecheckers () =
3513 (* Based on lablGL-1.04/LablGlut/examples/lablGL/checker.ml which had
3515 converted by Issac Trotts. July 25, 2002 *)
3516 let image = GlPix.create `ubyte ~format
:`luminance ~width
:2 ~height
:2 in
3517 Raw.sets_string
(GlPix.to_raw
image) ~
pos:0 "\255\200\200\255";
3518 let id = GlTex.gen_texture
() in
3519 GlTex.bind_texture ~target
:`texture_2d
id;
3520 GlPix.store
(`unpack_alignment
1);
3521 GlTex.image2d
image;
3522 List.iter
(GlTex.parameter ~target
:`texture_2d
)
3523 [ `mag_filter `nearest
; `min_filter `nearest
];
3527 let setcheckers enabled
=
3528 match state
.checkerstexid
with
3530 if enabled
then state
.checkerstexid
<- Some
(makecheckers ())
3532 | Some checkerstexid
->
3535 GlTex.delete_texture checkerstexid
;
3536 state
.checkerstexid
<- None
;
3540 let describe_location () =
3541 let fn = page_of_y state
.y in
3542 let ln = page_of_y
(state
.y + state
.winh
- hscrollh () - 1) in
3543 let maxy = state
.maxy - (if conf
.maxhfit
then state
.winh
else 0) in
3547 else (100. *. (float state
.y /. float maxy))
3551 Printf.sprintf
"page %d of %d [%.2f%%]"
3552 (fn+1) state
.pagecount
percent
3555 "pages %d-%d of %d [%.2f%%]"
3556 (fn+1) (ln+1) state
.pagecount
percent
3559 let setpresentationmode v
=
3560 let n = page_of_y state
.y in
3561 state
.anchor <- (n, 0.0, 1.0);
3562 conf
.presentation
<- v
;
3563 if conf
.fitmodel
= FitPage
3564 then reqlayout conf
.angle conf
.fitmodel
;
3569 let btos b = if b then "@Uradical" else E.s in
3570 let showextended = ref false in
3571 let leave mode
_ = state
.mode
<- mode
in
3574 val mutable m_first_time
= true
3575 val mutable m_l
= []
3576 val mutable m_a
= E.a
3577 val mutable m_prev_uioh
= nouioh
3578 val mutable m_prev_mode
= View
3580 inherit lvsourcebase
3582 method reset prev_mode prev_uioh
=
3583 m_a
<- Array.of_list
(List.rev m_l
);
3585 m_prev_mode
<- prev_mode
;
3586 m_prev_uioh
<- prev_uioh
;
3590 if n >= Array.length m_a
3594 | _, _, _, Action
_ -> m_active
<- n
3595 | _, _, _, Noaction
-> loop (n+1)
3598 m_first_time
<- false;
3601 method int name get
set =
3603 (name
, `
int get
, 1, Action
(
3606 try set (int_of_string
s)
3608 state
.text <- Printf.sprintf
"bad integer `%s': %s"
3612 let te = name ^
": ", E.s, None
, intentry, ondone, true in
3613 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3617 method int_with_suffix name get
set =
3619 (name
, `intws get
, 1, Action
(
3622 try set (int_of_string_with_suffix
s)
3624 state
.text <- Printf.sprintf
"bad integer `%s': %s"
3629 name ^
": ", E.s, None
, intentry_with_suffix, ondone, true
3631 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3635 method bool ?
(offset
=1) ?
(btos=btos) name get
set =
3637 (name
, `
bool (btos, get
), offset
, Action
(
3644 method color name get
set =
3646 (name
, `color get
, 1, Action
(
3648 let invalid = (nan
, nan
, nan
) in
3651 try color_of_string
s
3653 state
.text <- Printf.sprintf
"bad color `%s': %s"
3660 let te = name ^
": ", E.s, None
, textentry, ondone, true in
3661 state
.text <- color_to_string
(get
());
3662 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3666 method string name get
set =
3668 (name
, `
string get
, 1, Action
(
3670 let ondone s = set s in
3671 let te = name ^
": ", E.s, None
, textentry, ondone, true in
3672 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3676 method colorspace name get
set =
3678 (name
, `
string get
, 1, Action
(
3682 inherit lvsourcebase
3685 m_active
<- CSTE.to_int conf
.colorspace
;
3688 method getitemcount
=
3689 Array.length
CSTE.names
3692 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3693 ignore
(uioh
, first, pan
);
3694 if not cancel
then set active;
3696 method hasaction
_ = true
3700 let modehash = findkeyhash conf
"info" in
3701 coe (new listview ~zebra
:false ~helpmode
:false
3702 ~
source ~trusted
:true ~
modehash)
3705 method paxmark name get
set =
3707 (name
, `
string get
, 1, Action
(
3711 inherit lvsourcebase
3714 m_active
<- MTE.to_int conf
.paxmark
;
3717 method getitemcount
= Array.length
MTE.names
3718 method getitem
n = (MTE.names
.(n), 0)
3719 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3720 ignore
(uioh
, first, pan
);
3721 if not cancel
then set active;
3723 method hasaction
_ = true
3727 let modehash = findkeyhash conf
"info" in
3728 coe (new listview ~zebra
:false ~helpmode
:false
3729 ~
source ~trusted
:true ~
modehash)
3732 method fitmodel name get
set =
3734 (name
, `
string get
, 1, Action
(
3738 inherit lvsourcebase
3741 m_active
<- FMTE.to_int conf
.fitmodel
;
3744 method getitemcount
= Array.length
FMTE.names
3745 method getitem
n = (FMTE.names
.(n), 0)
3746 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3747 ignore
(uioh
, first, pan
);
3748 if not cancel
then set active;
3750 method hasaction
_ = true
3754 let modehash = findkeyhash conf
"info" in
3755 coe (new listview ~zebra
:false ~helpmode
:false
3756 ~
source ~trusted
:true ~
modehash)
3759 method caption
s offset
=
3760 m_l
<- (s, `empty
, offset
, Noaction
) :: m_l
3762 method caption2
s f offset
=
3763 m_l
<- (s, `
string f, offset
, Noaction
) :: m_l
3765 method getitemcount
= Array.length m_a
3768 let tostr = function
3769 | `
int f -> string_of_int
(f ())
3770 | `intws
f -> string_with_suffix_of_int
(f ())
3772 | `color
f -> color_to_string
(f ())
3773 | `
bool (btos, f) -> btos (f ())
3776 let name, t
, offset
, _ = m_a
.(n) in
3777 ((let s = tostr t
in
3779 then Printf.sprintf
"%s\t%s" name s
3783 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3788 match m_a
.(active) with
3789 | _, _, _, Action
f -> f uioh
3790 | _, _, _, Noaction
-> uioh
3801 method hasaction
n =
3803 | _, _, _, Action
_ -> true
3804 | _, _, _, Noaction
-> false
3807 let rec fillsrc prevmode prevuioh
=
3808 let sep () = src#caption
E.s 0 in
3809 let colorp name get
set =
3811 (fun () -> color_to_string
(get
()))
3814 let c = color_of_string
v in
3817 state
.text <- Printf.sprintf
"bad color `%s': %s" v (exntos exn
)
3820 let oldmode = state
.mode
in
3821 let birdseye = isbirdseye state
.mode
in
3823 src#caption
(if birdseye then "Setup (Bird's eye)" else "Setup") 0;
3825 src#
bool "presentation mode"
3826 (fun () -> conf
.presentation
)
3827 (fun v -> setpresentationmode v);
3829 src#
bool "ignore case in searches"
3830 (fun () -> conf
.icase
)
3831 (fun v -> conf
.icase
<- v);
3834 (fun () -> conf
.preload)
3835 (fun v -> conf
.preload <- v);
3837 src#
bool "highlight links"
3838 (fun () -> conf
.hlinks
)
3839 (fun v -> conf
.hlinks
<- v);
3841 src#
bool "under info"
3842 (fun () -> conf
.underinfo
)
3843 (fun v -> conf
.underinfo
<- v);
3845 src#
bool "persistent bookmarks"
3846 (fun () -> conf
.savebmarks
)
3847 (fun v -> conf
.savebmarks
<- v);
3849 src#fitmodel
"fit model"
3850 (fun () -> FMTE.to_string conf
.fitmodel
)
3851 (fun v -> reqlayout conf
.angle
(FMTE.of_int
v));
3853 src#
bool "trim margins"
3854 (fun () -> conf
.trimmargins
)
3855 (fun v -> settrim v conf
.trimfuzz
; fillsrc prevmode prevuioh
);
3857 src#
bool "persistent location"
3858 (fun () -> conf
.jumpback
)
3859 (fun v -> conf
.jumpback
<- v);
3862 src#
int "inter-page space"
3863 (fun () -> conf
.interpagespace
)
3865 conf
.interpagespace
<- n;
3866 docolumns conf
.columns
;
3868 match state
.layout with
3873 state
.maxy <- calcheight
();
3874 let y = getpagey
pageno in
3879 (fun () -> conf
.pagebias
)
3880 (fun v -> conf
.pagebias
<- v);
3882 src#
int "scroll step"
3883 (fun () -> conf
.scrollstep
)
3884 (fun n -> conf
.scrollstep
<- n);
3886 src#
int "horizontal scroll step"
3887 (fun () -> conf
.hscrollstep
)
3888 (fun v -> conf
.hscrollstep
<- v);
3890 src#
int "auto scroll step"
3892 match state
.autoscroll
with
3894 | _ -> conf
.autoscrollstep
)
3896 let n = boundastep state
.winh
n in
3897 if state
.autoscroll
<> None
3898 then state
.autoscroll
<- Some
n;
3899 conf
.autoscrollstep
<- n);
3902 (fun () -> truncate
(conf
.zoom *. 100.))
3903 (fun v -> setzoom ((float v) /. 100.));
3906 (fun () -> conf
.angle
)
3907 (fun v -> reqlayout v conf
.fitmodel
);
3909 src#
int "scroll bar width"
3910 (fun () -> conf
.scrollbw
)
3913 reshape state
.winw state
.winh
;
3916 src#
int "scroll handle height"
3917 (fun () -> conf
.scrollh
)
3918 (fun v -> conf
.scrollh
<- v;);
3920 src#
int "thumbnail width"
3921 (fun () -> conf
.thumbw
)
3923 conf
.thumbw
<- min
4096 v;
3926 leavebirdseye beye
false;
3933 let mode = state
.mode in
3934 src#
string "columns"
3936 match conf
.columns
with
3938 | Cmulti
(multi
, _) -> multicolumns_to_string multi
3939 | Csplit
(count
, _) -> "-" ^ string_of_int count
3942 let n, a, b = multicolumns_of_string
v in
3943 setcolumns mode n a b);
3946 src#caption
"Pixmap cache" 0;
3947 src#int_with_suffix
"size (advisory)"
3948 (fun () -> conf
.memlimit
)
3949 (fun v -> conf
.memlimit
<- v);
3952 (fun () -> Printf.sprintf
"%s bytes, %d tiles"
3953 (string_with_suffix_of_int state
.memused
)
3954 (Hashtbl.length state
.tilemap
)) 1;
3957 src#caption
"Layout" 0;
3958 src#caption2
"Dimension"
3960 Printf.sprintf
"%dx%d (virtual %dx%d)"
3961 state
.winw state
.winh
3966 src#caption2
"Position" (fun () ->
3967 Printf.sprintf
"%dx%d" state
.x state
.y
3970 src#caption2
"Position" (fun () -> describe_location ()) 1
3974 src#
bool ~offset
:0 ~
btos:(fun v -> if v then "(on)" else "(off)")
3975 "Save these parameters as global defaults at exit"
3976 (fun () -> conf
.bedefault
)
3977 (fun v -> conf
.bedefault
<- v)
3981 let btos b = if b then "@Ulguillemet" else "@Urguillemet" in
3982 src#
bool ~offset
:0 ~
btos "Extended parameters"
3983 (fun () -> !showextended)
3984 (fun v -> showextended := v; fillsrc prevmode prevuioh
);
3988 (fun () -> conf
.checkers
)
3989 (fun v -> conf
.checkers
<- v; setcheckers v);
3990 src#
bool "update cursor"
3991 (fun () -> conf
.updatecurs
)
3992 (fun v -> conf
.updatecurs
<- v);
3993 src#
bool "scroll-bar on the left"
3994 (fun () -> conf
.leftscroll
)
3995 (fun v -> conf
.leftscroll
<- v);
3997 (fun () -> conf
.verbose
)
3998 (fun v -> conf
.verbose
<- v);
3999 src#
bool "invert colors"
4000 (fun () -> conf
.invert
)
4001 (fun v -> conf
.invert
<- v);
4003 (fun () -> conf
.maxhfit
)
4004 (fun v -> conf
.maxhfit
<- v);
4005 src#
bool "redirect stderr"
4006 (fun () -> conf
.redirectstderr)
4007 (fun v -> conf
.redirectstderr <- v; redirectstderr ());
4009 (fun () -> conf
.pax
!= None
)
4012 then conf
.pax
<- Some
(ref (now
(), 0, 0))
4013 else conf
.pax
<- None
);
4014 src#
string "uri launcher"
4015 (fun () -> conf
.urilauncher
)
4016 (fun v -> conf
.urilauncher
<- v);
4017 src#
string "path launcher"
4018 (fun () -> conf
.pathlauncher
)
4019 (fun v -> conf
.pathlauncher
<- v);
4020 src#
string "tile size"
4021 (fun () -> Printf.sprintf
"%dx%d" conf
.tilew conf
.tileh
)
4024 let w, h = Scanf.sscanf
v "%dx%d" (fun w h -> w, h) in
4025 conf
.tilew
<- max
64 w;
4026 conf
.tileh
<- max
64 h;
4029 state
.text <- Printf.sprintf
"bad tile size `%s': %s"
4032 src#
int "texture count"
4033 (fun () -> conf
.texcount
)
4036 then conf
.texcount
<- v
4037 else showtext '
!'
" Failed to set texture count please retry later"
4039 src#
int "slice height"
4040 (fun () -> conf
.sliceheight
)
4042 conf
.sliceheight
<- v;
4043 wcmd "sliceh %d" conf
.sliceheight
;
4045 src#
int "anti-aliasing level"
4046 (fun () -> conf
.aalevel
)
4048 conf
.aalevel
<- bound
v 0 8;
4049 state
.anchor <- getanchor
();
4050 opendoc state
.path state
.password;
4052 src#
string "page scroll scaling factor"
4053 (fun () -> string_of_float conf
.pgscale)
4056 let s = float_of_string
v in
4059 state
.text <- Printf.sprintf
4060 "bad page scroll scaling factor `%s': %s" v (exntos exn
)
4063 src#
int "ui font size"
4064 (fun () -> fstate
.fontsize
)
4065 (fun v -> setfontsize (bound
v 5 100));
4066 src#
int "hint font size"
4067 (fun () -> conf
.hfsize
)
4068 (fun v -> conf
.hfsize
<- bound
v 5 100);
4069 colorp "background color"
4070 (fun () -> conf
.bgcolor
)
4071 (fun v -> conf
.bgcolor
<- v);
4072 src#
bool "crop hack"
4073 (fun () -> conf
.crophack
)
4074 (fun v -> conf
.crophack
<- v);
4075 src#
string "trim fuzz"
4076 (fun () -> irect_to_string conf
.trimfuzz
)
4079 conf
.trimfuzz
<- irect_of_string
v;
4081 then settrim true conf
.trimfuzz
;
4083 state
.text <- Printf.sprintf
"bad irect `%s': %s" v (exntos exn
)
4085 src#
string "throttle"
4087 match conf
.maxwait
with
4088 | None
-> "show place holder if page is not ready"
4091 then "wait for page to fully render"
4093 "wait " ^ string_of_float
time
4094 ^
" seconds before showing placeholder"
4098 let f = float_of_string
v in
4100 then conf
.maxwait
<- None
4101 else conf
.maxwait
<- Some
f
4103 state
.text <- Printf.sprintf
"bad time `%s': %s" v (exntos exn
)
4105 src#
string "ghyll scroll"
4107 match conf
.ghyllscroll
with
4109 | Some nab
-> ghyllscroll_to_string nab
4112 try conf
.ghyllscroll
<- ghyllscroll_of_string
v
4114 state
.text <- Printf.sprintf
"bad ghyll `%s': %s" v (exntos exn
)
4116 src#
string "selection command"
4117 (fun () -> conf
.selcmd
)
4118 (fun v -> conf
.selcmd
<- v);
4119 src#
string "synctex command"
4120 (fun () -> conf
.stcmd
)
4121 (fun v -> conf
.stcmd
<- v);
4122 src#
string "pax command"
4123 (fun () -> conf
.paxcmd
)
4124 (fun v -> conf
.paxcmd
<- v);
4125 src#
string "ask password command"
4126 (fun () -> conf
.passcmd)
4127 (fun v -> conf
.passcmd <- v);
4128 src#
string "save path command"
4129 (fun () -> conf
.savecmd
)
4130 (fun v -> conf
.savecmd
<- v);
4131 src#colorspace
"color space"
4132 (fun () -> CSTE.to_string conf
.colorspace
)
4134 conf
.colorspace
<- CSTE.of_int
v;
4138 src#paxmark
"pax mark method"
4139 (fun () -> MTE.to_string conf
.paxmark
)
4140 (fun v -> conf
.paxmark
<- MTE.of_int
v);
4144 (fun () -> conf
.usepbo
)
4145 (fun v -> conf
.usepbo
<- v);
4146 src#
bool "mouse wheel scrolls pages"
4147 (fun () -> conf
.wheelbypage
)
4148 (fun v -> conf
.wheelbypage
<- v);
4149 src#
bool "open remote links in a new instance"
4150 (fun () -> conf
.riani
)
4151 (fun v -> conf
.riani
<- v);
4155 src#caption
"Document" 0;
4156 List.iter
(fun (_, s) -> src#caption
s 1) state
.docinfo
;
4157 src#caption2
"Pages"
4158 (fun () -> string_of_int state
.pagecount
) 1;
4159 src#caption2
"Dimensions"
4160 (fun () -> string_of_int
(List.length state
.pdims
)) 1;
4164 src#caption
"Trimmed margins" 0;
4165 src#caption2
"Dimensions"
4166 (fun () -> string_of_int
(List.length state
.pdims
)) 1;
4170 src#caption
"OpenGL" 0;
4171 src#caption
(Printf.sprintf
"Vendor\t%s" (GlMisc.get_string `vendor
)) 1;
4172 src#caption
(Printf.sprintf
"Renderer\t%s" (GlMisc.get_string `renderer
)) 1;
4175 src#caption
"Location" 0;
4176 if nonemptystr state
.origin
4177 then src#caption
("Orign\t" ^ mbtoutf8 state
.origin
) 1;
4178 src#caption
("Path\t" ^ mbtoutf8 state
.path
) 1;
4180 src#reset prevmode prevuioh
;
4185 let prevmode = state
.mode
4186 and prevuioh
= state
.uioh in
4187 fillsrc prevmode prevuioh
;
4188 let source = (src :> lvsource
) in
4189 let modehash = findkeyhash conf
"info" in
4190 state
.uioh <- coe (object (self)
4191 inherit listview ~zebra
:false ~helpmode
:false
4192 ~
source ~trusted
:true ~
modehash as super
4193 val mutable m_prevmemused
= 0
4194 method! infochanged
= function
4196 if m_prevmemused
!= state
.memused
4198 m_prevmemused
<- state
.memused
;
4199 G.postRedisplay "memusedchanged";
4201 | Pdim
-> G.postRedisplay "pdimchanged"
4202 | Docinfo
-> fillsrc prevmode prevuioh
4204 method! key key mask
=
4205 if not
(Wsi.withctrl mask
)
4208 | @left | @kpleft
-> coe (self#updownlevel ~
-1)
4209 | @right
| @kpright
-> coe (self#updownlevel
1)
4210 | _ -> super#
key key mask
4211 else super#
key key mask
4213 G.postRedisplay "info";
4219 inherit lvsourcebase
4220 method getitemcount
= Array.length state
.help
4222 let s, l, _ = state
.help
.(n) in
4225 method exit ~
uioh ~cancel ~
active ~
first ~pan
=
4229 match state
.help
.(active) with
4230 | _, _, Action
f -> Some
(f uioh)
4231 | _, _, Noaction
-> Some
uioh
4240 method hasaction
n =
4241 match state
.help
.(n) with
4242 | _, _, Action
_ -> true
4243 | _, _, Noaction
-> false
4249 let modehash = findkeyhash conf
"help" in
4251 state
.uioh <- coe (new listview
4252 ~zebra
:false ~helpmode
:true
4253 ~
source ~trusted
:true ~
modehash);
4254 G.postRedisplay "help";
4260 inherit lvsourcebase
4261 val mutable m_items
= E.a
4263 method getitemcount
= 1 + Array.length m_items
4268 else m_items
.(n-1), 0
4270 method exit ~
uioh ~cancel ~
active ~
first ~pan
=
4275 then Buffer.clear state
.errmsgs
;
4282 method hasaction
n =
4286 state
.newerrmsgs
<- false;
4287 let l = Str.split newlinere
(Buffer.contents state
.errmsgs
) in
4288 m_items
<- Array.of_list
l
4297 let source = (msgsource :> lvsource
) in
4298 let modehash = findkeyhash conf
"listview" in
4299 state
.uioh <- coe (object
4300 inherit listview ~zebra
:false ~helpmode
:false
4301 ~
source ~trusted
:false ~
modehash as super
4304 then msgsource#reset
;
4307 G.postRedisplay "msgs";
4310 let enterannotmode opaque slinkindex
=
4313 inherit lvsourcebase
4314 val mutable m_text
= E.s
4315 val mutable m_items
= E.a
4317 method getitemcount
= 2 + Array.length m_items
4320 if n = Array.length m_items
4321 then "[Copy text to the clipboard]", 0
4323 if n = Array.length m_items
+ 1
4324 then "[Delete annotation]", 0
4327 method exit ~
uioh ~cancel ~
active ~
first ~pan
=
4328 ignore
(uioh, first, pan
);
4331 if active = Array.length m_items
4332 then selstring m_text
4334 if active = Array.length m_items
+ 1
4336 delannot
opaque slinkindex
;
4337 wcmd "freepage %s" (~
> opaque);
4339 Hashtbl.fold (fun key opaque'
accu ->
4340 if opaque'
= opaque'
4341 then key :: accu else accu) state
.pagemap
[]
4343 List.iter
(Hashtbl.remove state
.pagemap
) keys;
4350 method hasaction
_ = true
4353 let rec split accu b i
=
4355 if p = String.length
s
4356 then String.sub
s b (p-b) :: accu
4358 if (i
> 70 && s.[p] = ' '
) || s.[p] = '
\r'
|| s.[p] = '
\n'
4360 let ss = if i
= 0 then E.s else String.sub
s b i
in
4361 split (ss::accu) (p+1) 0
4366 m_items
<- split [] 0 0 |> List.rev
|> Array.of_list
4373 let s = getannotcontents
opaque slinkindex
in
4376 let source = (msgsource :> lvsource
) in
4377 let modehash = findkeyhash conf
"listview" in
4378 state
.uioh <- coe (object
4379 inherit listview ~zebra
:false ~helpmode
:false
4380 ~
source ~trusted
:false ~
modehash
4382 G.postRedisplay "enterannotmode";
4385 let gotounder under =
4386 let getpath filename
=
4388 if nonemptystr filename
4390 if Filename.is_relative filename
4392 let dir = Filename.dirname state
.path in
4394 if Filename.is_implicit
dir
4395 then Filename.concat
(Sys.getcwd
()) dir
4398 Filename.concat
dir filename
4402 if Sys.file_exists
path
4407 | Ulinkgoto
(pageno, top) ->
4411 gotopage1 pageno top;
4417 | Uremote
(filename
, pageno) ->
4418 let path = getpath filename
in
4423 let command = Printf.sprintf
"%s -page %d %S" !selfexec pageno path in
4424 try addpid @@ popen
command []
4426 Printf.eprintf
"failed to execute `%s': %s\n" command (exntos exn
);
4429 let anchor = getanchor
() in
4430 let ranchor = state
.path, state
.password, anchor, state
.origin
in
4431 state
.origin
<- E.s;
4432 state
.anchor <- (pageno, 0.0, 0.0);
4433 state
.ranchors
<- ranchor :: state
.ranchors
;
4436 else showtext '
!'
("Could not find " ^ filename
)
4438 | Uremotedest
(filename
, destname
) ->
4439 let path = getpath filename
in
4444 let command = !selfexec ^
" " ^
path ^
" -dest " ^ destname
in
4445 try addpid @@ popen
command []
4448 "failed to execute `%s': %s\n" command (exntos exn
);
4451 let anchor = getanchor
() in
4452 let ranchor = state
.path, state
.password, anchor, state
.origin
in
4453 state
.origin
<- E.s;
4454 state
.nameddest
<- destname
;
4455 state
.ranchors
<- ranchor :: state
.ranchors
;
4458 else showtext '
!'
("Could not find " ^ filename
)
4460 | Uunexpected
_ | Ulaunch
_ | Unamed
_ | Utext
_ | Unone
-> ()
4461 | Uannotation
(opaque, slinkindex
) -> enterannotmode opaque slinkindex
4464 let gotooutline (_, _, kind
) =
4468 let (pageno, y, _) = anchor in
4470 (if conf
.presentation
then (pageno, y, 1.0) else anchor)
4474 | Ouri
uri -> gotounder (Ulinkuri
uri)
4475 | Olaunch cmd
-> gotounder (Ulaunch cmd
)
4476 | Oremote remote
-> gotounder (Uremote remote
)
4477 | Ohistory
hist -> gotohist hist
4478 | Oremotedest remotedest
-> gotounder (Uremotedest remotedest
)
4482 let outlinesource sourcetype
=
4484 inherit lvsourcebase
4485 val mutable m_items
= E.a
4486 val mutable m_minfo
= E.a
4487 val mutable m_orig_items
= E.a
4488 val mutable m_orig_minfo
= E.a
4489 val mutable m_narrow_patterns
= []
4490 val mutable m_hadremovals
= false
4491 val mutable m_gen
= -1
4493 method getitemcount
=
4494 Array.length m_items
+ (if m_hadremovals
then 1 else 0)
4497 if n == Array.length m_items
&& m_hadremovals
4499 ("[Confirm removal]", 0)
4501 let s, n, _ = m_items
.(n) in
4504 method exit ~
uioh ~cancel ~
active ~
first ~pan
=
4505 ignore
(uioh, first);
4506 let confrimremoval = m_hadremovals
&& active = Array.length m_items
in
4508 if m_narrow_patterns
= []
4509 then m_orig_items
, m_orig_minfo
4510 else m_items
, m_minfo
4514 if not
confrimremoval
4516 gotooutline m_items
.(active);
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
_ -> 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 !Config.historder
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
_ ->
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 !Config.historder
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 =
4694 let f = enterselector `
outlines in
4695 fun () -> f "Document has no outline";
4698 let enterbookmarkmode =
4699 let f = enterselector `bookmarks
in
4700 fun () -> f "Document has no bookmarks (yet)";
4703 let enterhistmode () = enterselector `history
"No history (yet)";;
4705 let quickbookmark ?title
() =
4706 match state
.layout with
4712 let tm = Unix.localtime
(now
()) in
4713 Printf.sprintf
"Quick (page %d) (bookmarked at %d/%d/%d %d:%d)"
4717 (tm.Unix.tm_year
+ 1900)
4720 | Some
title -> title
4722 state
.bookmarks
<- (title, 0, Oanchor
(getanchor1
l)) :: state
.bookmarks
4725 let setautoscrollspeed step goingdown
=
4726 let incr = max
1 ((abs step
) / 2) in
4727 let incr = if goingdown
then incr else -incr in
4728 let astep = boundastep state
.winh
(step
+ incr) in
4729 state
.autoscroll
<- Some
astep;
4733 match conf
.columns
with
4735 | Csingle
_ | Cmulti
_ -> state
.x != 0 || conf
.zoom > 1.0
4738 let panbound x = bound
x (-state
.w) (wadjsb () + state
.winw
);;
4740 let existsinrow pageno (columns
, coverA
, coverB
) p =
4741 let last = ((pageno - coverA
) mod columns
) + columns
in
4742 let rec any = function
4745 if l.pageno = coverA
- 1 || l.pageno = state
.pagecount
- coverB
4749 then (if l.pageno = last then false else any rest
)
4757 match state
.layout with
4759 let pageno = page_of_y state
.y in
4760 gotoghyll (getpagey
(pageno+1))
4762 match conf
.columns
with
4764 if conf
.presentation
&& rest
== [] && l.pageh
> l.pagey + l.pagevh
4766 let y = clamp (pgscale state
.winh
) in
4769 let pageno = min
(l.pageno+1) (state
.pagecount
-1) in
4770 gotoghyll (getpagey
pageno)
4771 | Cmulti
((c, _, _) as cl, _) ->
4772 if conf
.presentation
4773 && (existsinrow l.pageno cl
4774 (fun l -> l.pageh
> l.pagey + l.pagevh))
4776 let y = clamp (pgscale state
.winh
) in
4779 let pageno = min
(l.pageno+c) (state
.pagecount
-1) in
4780 gotoghyll (getpagey
pageno)
4782 if l.pageno < state
.pagecount
- 1 || l.pagecol
< n - 1
4784 let pagey, pageh
= getpageyh
l.pageno in
4785 let pagey = pagey + pageh
* l.pagecol
in
4786 let ips = if l.pagecol
= 0 then 0 else conf
.interpagespace
in
4787 gotoghyll (pagey + pageh
+ ips)
4791 match state
.layout with
4793 let pageno = page_of_y state
.y in
4794 gotoghyll (getpagey
(pageno-1))
4796 match conf
.columns
with
4798 if conf
.presentation
&& l.pagey != 0
4800 gotoghyll (clamp (pgscale ~
-(state
.winh
)))
4802 let pageno = max
0 (l.pageno-1) in
4803 gotoghyll (getpagey
pageno)
4804 | Cmulti
((c, _, coverB
) as cl, _) ->
4805 if conf
.presentation
&&
4806 (existsinrow l.pageno cl (fun l -> l.pagey != 0))
4808 gotoghyll (clamp (pgscale ~
-(state
.winh
)))
4811 if l.pageno = state
.pagecount
- coverB
4815 let pageno = max
0 (l.pageno-decr) in
4816 gotoghyll (getpagey
pageno)
4824 let pageno = max
0 (l.pageno-1) in
4825 let pagey, pageh
= getpageyh
pageno in
4828 let pagey, pageh
= getpageyh
l.pageno in
4829 pagey + pageh
* (l.pagecol
-1) - conf
.interpagespace
4835 if emptystr conf
.savecmd
4836 then error
"don't know where to save modified document"
4838 match Unix.open_process_in conf
.savecmd
with
4839 | (exception exn
) ->
4841 (Printf.sprintf
"savecmd open_process_in failed: %s"
4844 let path = try input_line ic
with End_of_file
-> E.s in
4846 match Unix.close_process_in ic
with
4847 | (exception exn
) ->
4848 error
"error obtaining save path: %s" (exntos exn
)
4854 let viewkeyboard key mask
=
4856 let mode = state
.mode in
4857 state
.mode <- Textentry
(te, fun _ -> state
.mode <- mode);
4860 G.postRedisplay "view:enttext"
4862 let ctrl = Wsi.withctrl mask
in
4864 if key >= 0xffb0 && key < 0xffb9 then key - 0xffb0 + 48 else key
4870 if hasunsavedchanges
()
4874 if conf
.angle
mod 360 = 0 && not
(isbirdseye state
.mode)
4876 state
.mode <- LinkNav
(Ltgendir
0);
4879 else showtext '
!'
"Keyboard link navigation does not work under rotation"
4882 begin match state
.mstate
with
4885 G.postRedisplay "kill rect";
4888 | Mscrolly
| Mscrollx
4891 begin match state
.mode with
4894 G.postRedisplay "esc leave linknav"
4898 match state
.ranchors
with
4900 | (path, password, anchor, origin
) :: rest
->
4901 state
.ranchors
<- rest
;
4902 state
.anchor <- anchor;
4903 state
.origin
<- origin
;
4904 state
.nameddest
<- E.s;
4905 opendoc path password
4910 gotoghyll (getnav ~
-1)
4921 Hashtbl.iter
(fun _ opaque -> clearmark
opaque) state
.pagemap
;
4922 G.postRedisplay "dehighlight";
4924 | @slash
| @question
->
4925 let ondone isforw
s =
4926 cbput state
.hists
.pat
s;
4927 state
.searchpattern
<- s;
4930 let s = String.make
1 (Char.chr
key) in
4931 enttext (s, E.s, Some
(onhist state
.hists
.pat
),
4932 textentry, ondone (key = @slash
), true)
4934 | @plus
| @kpplus
| @equals
when ctrl ->
4935 let incr = if conf
.zoom +. 0.01 > 0.1 then 0.1 else 0.01 in
4936 setzoom (conf
.zoom +. incr)
4938 | @plus
| @kpplus
->
4941 try int_of_string
s with exc
->
4942 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
);
4948 state
.text <- "page bias is now " ^ string_of_int
n;
4951 enttext ("page bias: ", E.s, None
, intentry, ondone, true)
4953 | @minus
| @kpminus
when ctrl ->
4954 let decr = if conf
.zoom -. 0.1 < 0.1 then 0.01 else 0.1 in
4955 setzoom (max
0.01 (conf
.zoom -. decr))
4957 | @minus
| @kpminus
->
4958 let ondone msg
= state
.text <- msg
in
4960 "option [acfhilpstvxACFPRSZTISM]: ", E.s, None
,
4961 optentry state
.mode, ondone, true
4972 | (@1 | @2) when ctrl && conf
.fitmodel
!= FitPage
-> (* ctrl-1/2 *)
4974 match conf
.columns
with
4975 | Csingle
_ | Cmulti
_ -> 1
4976 | Csplit
(n, _) -> n
4978 let h = state
.winh
-
4979 conf
.interpagespace
lsl (if conf
.presentation
then 1 else 0)
4981 let zoom = zoomforh state
.winw
h (vscrollw ()) cols in
4982 if zoom > 0.0 && (key = 50 || zoom < 1.0)
4987 match conf
.fitmodel
with
4988 | FitWidth
-> FitProportional
4989 | FitProportional
-> FitPage
4990 | FitPage
-> FitWidth
4992 state
.text <- "fit model: " ^
FMTE.to_string
fm;
4993 reqlayout conf
.angle
fm
5001 | (48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57)
5002 when not
ctrl -> (* 0..9 *)
5005 try int_of_string
s with exc
->
5006 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
);
5012 cbput state
.hists
.pag
(string_of_int
n);
5013 gotopage1 (n + conf
.pagebias
- 1) 0;
5016 let pageentry text key =
5017 match Char.unsafe_chr
key with
5018 | '
g'
-> TEdone
text
5019 | _ -> intentry text key
5021 let text = String.make
1 (Char.chr
key) in
5022 enttext (":", text, Some
(onhist state
.hists
.pag
),
5023 pageentry, ondone, true)
5026 conf
.scrollb
<- if conf
.scrollb
= 0 then (scrollbvv
lor scrollbhv
) else 0;
5027 reshape state
.winw state
.winh
;
5030 state
.bzoom
<- not state
.bzoom
;
5032 showtext ' '
("block zoom " ^
if state
.bzoom
then "on" else "off")
5035 conf
.hlinks
<- not conf
.hlinks
;
5036 state
.text <- "highlightlinks " ^
if conf
.hlinks
then "on" else "off";
5037 G.postRedisplay "toggle highlightlinks";
5040 state
.glinks
<- true;
5041 let mode = state
.mode in
5042 state
.mode <- Textentry
(
5043 (":", E.s, None
, linknentry, linkndone gotounder, false),
5045 state
.glinks
<- false;
5049 G.postRedisplay "view:linkent(F)"
5052 state
.glinks
<- true;
5053 let mode = state
.mode in
5054 state
.mode <- Textentry
(
5056 ":", E.s, None
, linknentry, linkndone (fun under ->
5057 selstring (undertext under);
5061 state
.glinks
<- false;
5065 G.postRedisplay "view:linkent"
5068 begin match state
.autoscroll
with
5070 conf
.autoscrollstep
<- step
;
5071 state
.autoscroll
<- None
5073 if conf
.autoscrollstep
= 0
5074 then state
.autoscroll
<- Some
1
5075 else state
.autoscroll
<- Some conf
.autoscrollstep
5082 setpresentationmode (not conf
.presentation
);
5083 showtext ' '
("presentation mode " ^
5084 if conf
.presentation
then "on" else "off");
5087 if List.mem
Wsi.Fullscreen state
.winstate
5088 then Wsi.reshape conf
.cwinw conf
.cwinh
5089 else Wsi.fullscreen
()
5092 search state
.searchpattern
false
5095 search state
.searchpattern
true
5098 begin match state
.layout with
5101 gotoghyll (getpagey
l.pageno)
5107 | @delete
| @kpdelete
-> (* delete *)
5111 showtext ' '
(describe_location ());
5114 begin match state
.layout with
5117 Wsi.reshape (l.pagew
+ vscrollw ()) l.pageh
;
5122 enterbookmarkmode ()
5130 | @e when Buffer.length state
.errmsgs
> 0 ->
5135 match state
.layout with
5140 (s, 0, Oanchor
(getanchor1
l)) :: state
.bookmarks
5143 enttext ("bookmark: ", E.s, None
, textentry, ondone, true)
5147 showtext ' '
"Quick bookmark added";
5150 begin match state
.layout with
5152 let rect = getpdimrect
l.pagedimno
in
5156 (truncate
(1.8 *. (rect.(1) -. rect.(0))),
5157 truncate
(1.2 *. (rect.(3) -. rect.(0))))
5159 (truncate
(rect.(1) -. rect.(0)),
5160 truncate
(rect.(3) -. rect.(0)))
5162 let w = truncate
((float w)*.conf
.zoom)
5163 and h = truncate
((float h)*.conf
.zoom) in
5166 state
.anchor <- getanchor
();
5167 Wsi.reshape (w + vscrollw ()) (h + conf
.interpagespace
)
5169 G.postRedisplay "z";
5174 | @x -> state
.roam
()
5177 reqlayout (conf
.angle
+
5178 (if key = @Gt
then 30 else -30)) conf
.fitmodel
5182 bound
(conf
.colorscale
+. (if key = 93 then 0.1 else -0.1)) 0.0 1.0
5184 G.postRedisplay "brightness";
5186 | @c when state
.mode = View
->
5191 let m = (wadjsb () + state
.winw
- state
.w) / 2 in
5193 gotoy_and_clear_text state
.y
5197 match state
.prevcolumns
with
5198 | None
-> (1, 0, 0), 1.0
5199 | Some
(columns
, z
) ->
5202 | Csplit
(c, _) -> -c, 0, 0
5203 | Cmulti
((c, a, b), _) -> c, a, b
5204 | Csingle
_ -> 1, 0, 0
5208 setcolumns View
c a b;
5211 | @down
| @up
when ctrl && Wsi.withshift mask
->
5212 let zoom, x = state
.prevzoom
in
5216 | @k
| @up
| @kpup
->
5217 begin match state
.autoscroll
with
5219 begin match state
.mode with
5220 | Birdseye beye
-> upbirdseye 1 beye
5225 then gotoy_and_clear_text (clamp ~
-(state
.winh
/2))
5227 if not
(Wsi.withshift mask
) && conf
.presentation
5229 else gotoghyll1 true (clamp (-conf
.scrollstep
))
5233 setautoscrollspeed n false
5236 | @j
| @down
| @kpdown
->
5237 begin match state
.autoscroll
with
5239 begin match state
.mode with
5240 | Birdseye beye
-> downbirdseye 1 beye
5245 then gotoy_and_clear_text (clamp (state
.winh
/2))
5247 if not
(Wsi.withshift mask
) && conf
.presentation
5249 else gotoghyll1 true (clamp (conf
.scrollstep
))
5253 setautoscrollspeed n true
5256 | @left | @right
| @kpleft
| @kpright
when not
(Wsi.withalt mask
) ->
5262 else conf
.hscrollstep
5264 let dx = if key = @left || key = @kpleft
then dx else -dx in
5265 state
.x <- panbound (state
.x + dx);
5266 gotoy_and_clear_text state
.y
5269 G.postRedisplay "left/right"
5272 | @prior
| @kpprior
->
5276 match state
.layout with
5278 | l :: _ -> state
.y - l.pagey
5280 clamp (pgscale (-state
.winh
))
5284 | @next | @kpnext
->
5288 match List.rev state
.layout with
5290 | l :: _ -> getpagey
l.pageno
5292 clamp (pgscale state
.winh
)
5296 | @g | @home
| @kphome
->
5299 | @G
| @jend
| @kpend
->
5301 gotoghyll (clamp state
.maxy)
5303 | @right
| @kpright
when Wsi.withalt mask
->
5304 gotoghyll (getnav 1)
5305 | @left | @kpleft
when Wsi.withalt mask
->
5306 gotoghyll (getnav ~
-1)
5311 | @v when conf
.debug
->
5314 match getopaque l.pageno with
5317 let x0, y0, x1, y1 = pagebbox
opaque in
5318 let a,b = float x0, float y0 in
5319 let c,d = float x1, float y0 in
5320 let e,f = float x1, float y1 in
5321 let h,j
= float x0, float y1 in
5322 let rect = (a,b,c,d,e,f,h,j
) in
5324 state
.rects
<- (l.pageno, l.pageno mod 3, rect) :: state
.rects
;
5326 G.postRedisplay "v";
5329 let mode = state
.mode in
5330 let cmd = ref E.s in
5331 let onleave = function
5332 | Cancel
-> state
.mode <- mode
5335 match getopaque l.pageno with
5336 | Some
opaque -> pipesel opaque !cmd
5337 | None
-> ()) state
.layout;
5341 cbput state
.hists
.sel
s;
5345 "| ", !cmd, Some
(onhist state
.hists
.sel
), textentry, ondone, true
5347 G.postRedisplay "|";
5348 state
.mode <- Textentry
(te, onleave);
5351 vlog "huh? %s" (Wsi.keyname
key)
5354 let linknavkeyboard key mask
linknav =
5355 let getpage pageno =
5356 let rec loop = function
5358 | l :: _ when l.pageno = pageno -> Some
l
5359 | _ :: rest
-> loop rest
5360 in loop state
.layout
5362 let doexact (pageno, n) =
5363 match getopaque pageno, getpage pageno with
5364 | Some
opaque, Some
l ->
5365 if key = @enter
|| key = @kpenter
5367 let under = getlink
opaque n in
5368 G.postRedisplay "link gotounder";
5375 Some
(findlink
opaque LDfirst
), -1
5378 Some
(findlink
opaque LDlast
), 1
5381 Some
(findlink
opaque (LDleft
n)), -1
5384 Some
(findlink
opaque (LDright
n)), 1
5387 Some
(findlink
opaque (LDup
n)), -1
5390 Some
(findlink
opaque (LDdown
n)), 1
5395 begin match findpwl
l.pageno dir with
5399 state
.mode <- LinkNav
(Ltgendir
dir);
5400 let y, h = getpageyh
pageno in
5403 then y + h - state
.winh
5408 begin match getopaque pageno, getpage pageno with
5409 | Some
opaque, Some
_ ->
5411 let ld = if dir > 0 then LDfirst
else LDlast
in
5414 begin match link with
5416 showlinktype (getlink
opaque m);
5417 state
.mode <- LinkNav
(Ltexact
(pageno, m));
5418 G.postRedisplay "linknav jpage";
5419 | Lnotfound
-> notfound dir
5425 begin match opt with
5426 | Some Lnotfound
-> pwl l dir;
5427 | Some
(Lfound
m) ->
5431 let _, y0, _, y1 = getlinkrect
opaque m in
5433 then gotopage1 l.pageno y0
5435 let d = fstate
.fontsize
+ 1 in
5436 if y1 - l.pagey > l.pagevh - d
5437 then gotopage1 l.pageno (y1 - state
.winh
- hscrollh () + d)
5438 else G.postRedisplay "linknav";
5440 showlinktype (getlink
opaque m);
5441 state
.mode <- LinkNav
(Ltexact
(l.pageno, m));
5444 | None
-> viewkeyboard key mask
5446 | _ -> viewkeyboard key mask
5451 G.postRedisplay "leave linknav"
5455 | Ltgendir
_ | Ltnotready
_ -> viewkeyboard key mask
5456 | Ltexact exact
-> doexact exact
5459 let keyboard key mask
=
5460 if (key = 103 && Wsi.withctrl mask
) && not
(istextentry state
.mode)
5461 then wcmd "interrupt"
5462 else state
.uioh <- state
.uioh#
key key mask
5465 let birdseyekeyboard key mask
5466 ((oconf
, leftx
, pageno, hooverpageno
, anchor) as beye
) =
5468 match conf
.columns
with
5470 | Cmulti
((c, _, _), _) -> c
5471 | Csplit
_ -> failwith
"bird's eye split mode"
5473 let pgh layout = List.fold_left
5474 (fun m l -> max
l.pageh
m) state
.winh
layout in
5476 | @l when Wsi.withctrl mask
->
5477 let y, h = getpageyh
pageno in
5478 let top = (state
.winh
- h) / 2 in
5479 gotoy (max
0 (y - top))
5480 | @enter
| @kpenter
-> leavebirdseye beye
false
5481 | @escape
-> leavebirdseye beye
true
5482 | @up
-> upbirdseye incr beye
5483 | @down
-> downbirdseye incr beye
5484 | @left -> upbirdseye 1 beye
5485 | @right
-> downbirdseye 1 beye
5488 begin match state
.layout with
5492 state
.mode <- Birdseye
(
5493 oconf
, leftx
, l.pageno, hooverpageno
, anchor
5495 gotopage1 l.pageno 0;
5498 let layout = layout (state
.y-state
.winh
) (pgh state
.layout) in
5500 | [] -> gotoy (clamp (-state
.winh
))
5502 state
.mode <- Birdseye
(
5503 oconf
, leftx
, l.pageno, hooverpageno
, anchor
5505 gotopage1 l.pageno 0
5508 | [] -> gotoy (clamp (-state
.winh
))
5512 begin match List.rev state
.layout with
5514 let layout = layout (state
.y + (pgh state
.layout)) state
.winh
in
5515 begin match layout with
5517 let incr = l.pageh
- l.pagevh in
5522 oconf
, leftx
, state
.pagecount
- 1, hooverpageno
, anchor
5524 G.postRedisplay "birdseye pagedown";
5526 else gotoy (clamp (incr + conf
.interpagespace
*2));
5530 Birdseye
(oconf
, leftx
, l.pageno, hooverpageno
, anchor);
5531 gotopage1 l.pageno 0;
5534 | [] -> gotoy (clamp state
.winh
)
5538 state
.mode <- Birdseye
(oconf
, leftx
, 0, hooverpageno
, anchor);
5542 let pageno = state
.pagecount
- 1 in
5543 state
.mode <- Birdseye
(oconf
, leftx
, pageno, hooverpageno
, anchor);
5544 if not
(pagevisible state
.layout pageno)
5547 match List.rev state
.pdims
with
5549 | (_, _, h, _) :: _ -> h
5551 gotoy (max
0 (getpagey
pageno - (state
.winh
- h - conf
.interpagespace
)))
5552 else G.postRedisplay "birdseye end";
5554 | _ -> viewkeyboard key mask
5559 match state
.mode with
5560 | Textentry
_ -> scalecolor 0.4
5562 | View
-> scalecolor 1.0
5563 | Birdseye
(_, _, pageno, hooverpageno
, _) ->
5564 if l.pageno = hooverpageno
5567 if l.pageno = pageno
5569 let c = scalecolor 1.0 in
5571 GlDraw.line_width
3.0;
5572 let dispx = xadjsb () + l.pagedispx in
5574 (float (dispx-1)) (float (l.pagedispy-1))
5575 (float (dispx+l.pagevw+1))
5576 (float (l.pagedispy+l.pagevh+1))
5578 GlDraw.line_width
1.0;
5587 let postdrawpage l linkindexbase
=
5588 match getopaque l.pageno with
5590 if tileready l l.pagex
l.pagey
5592 let x = l.pagedispx - l.pagex
+ xadjsb ()
5593 and y = l.pagedispy - l.pagey in
5595 match conf
.columns
with
5596 | Csingle
_ | Cmulti
_ ->
5597 (if conf
.hlinks
then 1 else 0)
5599 && not
(isbirdseye state
.mode) then 2 else 0)
5603 match state
.mode with
5604 | Textentry
((_, s, _, _, _, _), _) when state
.glinks
-> s
5610 postprocess
opaque hlmask x y (linkindexbase
, s, conf
.hfsize
);
5615 let scrollindicator () =
5616 let sbw, ph
, sh = state
.uioh#
scrollph in
5617 let sbh, pw, sw = state
.uioh#scrollpw
in
5622 else ((state
.winw
- sbw), state
.winw
, 0)
5625 GlDraw.color (0.64, 0.64, 0.64);
5626 filledrect (float x0) 0. (float x1) (float state
.winh
);
5628 (float hx0
) (float (state
.winh
- sbh))
5629 (float (hx0
+ wadjsb () + state
.winw
)) (float state
.winh
)
5631 GlDraw.color (0.0, 0.0, 0.0);
5633 filledrect (float x0) ph
(float x1) (ph
+. sh);
5634 let pw = pw +. float hx0
in
5635 filledrect pw (float (state
.winh
- sbh)) (pw +. sw) (float state
.winh
);
5639 match state
.mstate
with
5640 | Mnone
| Mscrolly
| Mscrollx
| Mpan
_ | Mzoom
_ | Mzoomrect
_ ->
5643 | Msel
((x0, y0), (x1, y1)) ->
5644 let identify opaque l px py = Some
(opaque, l.pageno, px, py) in
5645 let o0,n0
,px0
,py0
= onppundermouse identify x0 y0 (~
< E.s, -1, 0, 0) in
5646 let _o1,n1
,px1
,py1
= onppundermouse identify x1 y1 (~
< E.s, -1, 0, 0) in
5647 if n0
!= -1 && n0
= n1
then seltext
o0 (px0
, py0
, px1
, py1
);
5650 let showrects = function [] -> () | rects
->
5652 GlDraw.color (0.0, 0.0, 1.0) ~
alpha:0.5;
5653 GlFunc.blend_func ~
src:`src_alpha ~dst
:`one_minus_src_alpha
;
5655 (fun (pageno, c, (x0, y0, x1, y1, x2
, y2
, x3
, y3
)) ->
5657 if l.pageno = pageno
5659 let dx = float (l.pagedispx - l.pagex
) in
5660 let dy = float (l.pagedispy - l.pagey) in
5661 GlDraw.color (0.0, 0.0, 1.0 /. float c) ~
alpha:0.5;
5662 Raw.sets_float state
.vraw ~
pos:0
5667 GlArray.vertex `two state
.vraw
;
5668 GlArray.draw_arrays `triangle_strip ~
first:0 ~count
:4;
5677 GlClear.color (scalecolor2 conf
.bgcolor
);
5678 GlClear.clear
[`
color];
5679 List.iter
drawpage state
.layout;
5681 match state
.mode with
5682 | LinkNav
(Ltexact
(pageno, linkno
)) ->
5683 begin match getopaque pageno with
5685 let dx = xadjsb () in
5686 let x0, y0, x1, y1 = getlinkrect
opaque linkno
in
5687 let x0 = x0 + dx and x1 = x1 + dx in
5694 | None
-> state
.rects
5696 | LinkNav
(Ltgendir
_) | LinkNav
(Ltnotready
_)
5699 | View
-> state
.rects
5702 let rec postloop linkindexbase
= function
5704 let linkindexbase = linkindexbase + postdrawpage l linkindexbase in
5705 postloop linkindexbase rest
5709 postloop 0 state
.layout;
5711 begin match state
.mstate
with
5712 | Mzoomrect
((x0, y0), (x1, y1)) ->
5714 GlDraw.color (0.3, 0.3, 0.3) ~
alpha:0.5;
5715 GlFunc.blend_func ~
src:`src_alpha ~dst
:`one_minus_src_alpha
;
5716 filledrect (float x0) (float y0) (float x1) (float y1);
5720 | Mscrolly
| Mscrollx
5729 let zoomrect x y x1 y1 =
5732 and y0 = min
y y1 in
5733 gotoy (state
.y + y0);
5734 state
.anchor <- getanchor
();
5735 let zoom = (float state
.w) /. float (x1 - x0) in
5738 let adjw = wadjsb () + state
.winw
in
5740 then (adjw - state
.w) / 2
5743 match conf
.fitmodel
with
5744 | FitWidth
| FitProportional
-> simple ()
5746 match conf
.columns
with
5748 onppundermouse (fun _ l _ _ -> Some
l.pagedispx) x0 y0 x0
5749 | Cmulti
_ | Csingle
_ -> simple ()
5751 state
.x <- (state
.x + margin) - x0;
5756 let filecontents path =
5757 let ic = open_in
path in
5758 let b = Buffer.create
(in_channel_length
ic) in
5760 match input_line
ic with
5761 | (exception End_of_file
) -> Buffer.contents
b
5763 if Buffer.length
b > 0
5764 then Buffer.add_char
b '
\n'
;
5765 Buffer.add_string
b line
;
5771 let getusertext () =
5772 let editor = getenvwithdef
"EDITOR" E.s in
5776 let tmppath = Filename.temp_file
"llpp" "note" in
5777 let execstr = editor ^
" " ^
tmppath in
5779 match Unix.system
execstr with
5780 | (exception exn
) ->
5782 Printf.sprintf
"Unix.system(%S) failed: %s" execstr (exntos exn
);
5784 | Unix.WEXITED
0 -> filecontents tmppath
5787 Printf.sprintf
"editor process(%s) exited abnormally: %d"
5790 | Unix.WSIGNALED
n ->
5792 Printf.sprintf
"editor process(%s) was killed by signal %d"
5795 | Unix.WSTOPPED
n ->
5797 Printf.sprintf
"editor(%s) process was stopped by signal %d"
5801 match Unix.unlink
tmppath with
5802 | (exception exn
) ->
5804 Printf.sprintf
"failed to ulink %S: %s"
5805 tmppath (exntos exn
);
5810 let annot inline
x y =
5811 match unproject x y with
5812 | Some
(opaque, n, ux
, uy
) ->
5814 addannot
opaque ux uy
text;
5815 wcmd "freepage %s" (~
> opaque);
5816 Hashtbl.remove state
.pagemap
(n, state
.gen
);
5822 let ondone s = add s in
5823 let mode = state
.mode in
5824 state
.mode <- Textentry
(
5825 ("annotation: ", E.s, None
, textentry, ondone, true),
5826 fun _ -> state
.mode <- mode);
5829 G.postRedisplay "annot"
5832 let s = getusertext () in
5833 let l = Str.split newlinere
s in
5841 let g opaque l px py =
5842 match rectofblock
opaque px py with
5844 let x0 = a.(0) -. 20. in
5845 let x1 = a.(1) +. 20. in
5846 let y0 = a.(2) -. 20. in
5847 let zoom = (float state
.w) /. (x1 -. x0) in
5848 let pagey = getpagey
l.pageno in
5849 gotoy_and_clear_text (pagey + truncate
y0);
5850 state
.anchor <- getanchor
();
5851 let margin = (state
.w - l.pagew
)/2 in
5852 state
.x <- -truncate
x0 - margin;
5857 match conf
.columns
with
5859 showtext '
!'
"block zooming does not work properly in split columns mode"
5860 | Cmulti
_ | Csingle
_ -> onppundermouse g x y ()
5864 let winw = wadjsb () + state
.winw - 1 in
5865 let s = float x /. float winw in
5866 let destx = truncate
(float (state
.w + winw) *. s) in
5867 state
.x <- winw - destx;
5868 gotoy_and_clear_text state
.y;
5869 state
.mstate
<- Mscrollx
;
5873 let s = float y /. float state
.winh
in
5874 let desty = truncate
(float (state
.maxy - state
.winh
) *. s) in
5875 gotoy_and_clear_text desty;
5876 state
.mstate
<- Mscrolly
;
5879 let viewmulticlick clicks
x y mask
=
5880 let g opaque l px py =
5888 if markunder
opaque px py mark
5892 match getopaque l.pageno with
5894 | Some
opaque -> pipesel opaque cmd
5896 state
.roam
<- (fun () -> dopipe conf
.paxcmd
);
5897 if not
(Wsi.withctrl mask
) then dopipe conf
.selcmd
;
5902 G.postRedisplay "viewmulticlick";
5903 onppundermouse g x y (fun () -> showtext '
!'
"Nothing to select") ();
5907 match conf
.columns
with
5909 | Csingle
_ | Cmulti
_ -> conf
.angle
mod 360 = 0
5912 let viewmouse button down
x y mask
=
5914 | n when (n == 4 || n == 5) && not down
->
5915 if Wsi.withctrl mask
5917 match state
.mstate
with
5918 | Mzoom
(oldn
, i
) ->
5926 if conf
.zoom +. 0.01 > 0.1 then 0.1 else 0.01
5928 if conf
.zoom -. 0.1 < 0.1 then -0.01 else -0.1
5930 let zoom = conf
.zoom -. incr in
5932 state
.mstate
<- Mzoom
(n, 0);
5934 state
.mstate
<- Mzoom
(n, i
+1);
5936 else state
.mstate
<- Mzoom
(n, 0)
5940 | Mscrolly
| Mscrollx
5942 | Mnone
-> state
.mstate
<- Mzoom
(n, 0)
5945 match state
.autoscroll
with
5946 | Some step
-> setautoscrollspeed step
(n=4)
5948 if conf
.wheelbypage
|| conf
.presentation
5957 then -conf
.scrollstep
5958 else conf
.scrollstep
5960 let incr = incr * 2 in
5961 let y = clamp incr in
5962 gotoy_and_clear_text y
5965 | n when (n = 6 || n = 7) && not down
&& canpan () ->
5967 panbound (state
.x + (if n = 7 then -2 else 2) * conf
.hscrollstep
);
5968 gotoy_and_clear_text state
.y
5970 | 1 when Wsi.withshift mask
->
5971 state
.mstate
<- Mnone
;
5974 match unproject x y with
5975 | Some
(_, pageno, ux
, uy
) ->
5976 let cmd = Printf.sprintf
5978 conf
.stcmd state
.path pageno ux uy
5980 addpid @@ popen
cmd []
5984 | 1 when Wsi.withctrl mask
->
5987 Wsi.setcursor
Wsi.CURSOR_CROSSHAIR
;
5988 state
.mstate
<- Mpan
(x, y)
5991 state
.mstate
<- Mnone
5996 if Wsi.withshift mask
5998 annot (not
(Wsi.withctrl mask
)) x y;
5999 G.postRedisplay "addannot"
6003 Wsi.setcursor
Wsi.CURSOR_CYCLE
;
6004 state
.mstate
<- Mzoomrect
(p, p)
6007 match state
.mstate
with
6008 | Mzoomrect
((x0, y0), _) ->
6009 if abs
(x-x0) > 10 && abs
(y - y0) > 10
6010 then zoomrect x0 y0 x y
6013 G.postRedisplay "kill accidental zoom rect";
6017 | Mscrolly
| Mscrollx
6023 | 1 when x > state
.winw - vscrollw () ->
6026 let _, position, sh = state
.uioh#
scrollph in
6027 if y > truncate
position && y < truncate
(position +. sh)
6028 then state
.mstate
<- Mscrolly
6031 state
.mstate
<- Mnone
6033 | 1 when y > state
.winh
- hscrollh () ->
6036 let _, position, sw = state
.uioh#scrollpw
in
6037 if x > truncate
position && x < truncate
(position +. sw)
6038 then state
.mstate
<- Mscrollx
6041 state
.mstate
<- Mnone
6043 | 1 when state
.bzoom
-> if not down
then zoomblock x y
6046 let dest = if down
then getunder x y else Unone
in
6047 begin match dest with
6050 | Uremote
_ | Uremotedest
_
6051 | Uunexpected
_ | Ulaunch
_ | Unamed
_ ->
6054 | Unone
when down
->
6055 Wsi.setcursor
Wsi.CURSOR_CROSSHAIR
;
6056 state
.mstate
<- Mpan
(x, y);
6058 | Uannotation
(opaque, slinkindex
) -> enterannotmode opaque slinkindex
6060 | Unone
| Utext
_ ->
6065 state
.mstate
<- Msel
((x, y), (x, y));
6066 G.postRedisplay "mouse select";
6070 match state
.mstate
with
6073 | Mzoom
_ | Mscrollx
| Mscrolly
->
6074 state
.mstate
<- Mnone
6076 | Mzoomrect
((x0, y0), _) ->
6080 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
6081 state
.mstate
<- Mnone
6083 | Msel
((x0, y0), (x1, y1)) ->
6084 let rec loop = function
6088 let a0 = l.pagedispy in
6089 let a1 = a0 + l.pagevh in
6090 let b0 = l.pagedispx in
6091 let b1 = b0 + l.pagevw in
6092 ((y0 >= a0 && y0 <= a1) || (y1 >= a0 && y1 <= a1))
6093 && ((x0 >= b0 && x0 <= b1) || (x1 >= b0 && x1 <= b1))
6097 match getopaque l.pageno with
6100 match Unix.pipe
() with
6104 "can not create sel pipe: %s"
6108 Ne.clo fd
(fun msg
->
6109 dolog
"%s close failed: %s" what msg
)
6112 try popen
cmd [r, 0; w, -1]
6114 dolog
"can not execute %S: %s"
6122 G.postRedisplay "copysel";
6124 else clo "Msel pipe/w" w;
6125 clo "Msel pipe/r" r;
6127 dosel conf
.selcmd
();
6128 state
.roam
<- dosel conf
.paxcmd
;
6140 let birdseyemouse button down
x y mask
6141 (conf
, leftx
, _, hooverpageno
, anchor) =
6144 let rec loop = function
6147 if y > l.pagedispy && y < l.pagedispy + l.pagevh
6148 && x > l.pagedispx && x < l.pagedispx + l.pagevw
6150 leavebirdseye (conf
, leftx
, l.pageno, hooverpageno
, anchor) false;
6156 | _ -> viewmouse button down
x y mask
6162 method key key mask
=
6163 begin match state
.mode with
6164 | Textentry
textentry -> textentrykeyboard key mask
textentry
6165 | Birdseye
birdseye -> birdseyekeyboard key mask
birdseye
6166 | View
-> viewkeyboard key mask
6167 | LinkNav
linknav -> linknavkeyboard key mask
linknav
6171 method button button bstate
x y mask
=
6172 begin match state
.mode with
6174 | View
-> viewmouse button bstate
x y mask
6175 | Birdseye beye
-> birdseyemouse button bstate
x y mask beye
6180 method multiclick clicks
x y mask
=
6181 begin match state
.mode with
6183 | View
-> viewmulticlick clicks
x y mask
6190 begin match state
.mode with
6192 | View
| Birdseye
_ | LinkNav
_ ->
6193 match state
.mstate
with
6194 | Mzoom
_ | Mnone
-> ()
6199 state
.mstate
<- Mpan
(x, y);
6201 then state
.x <- panbound (state
.x + dx);
6203 gotoy_and_clear_text y
6206 state
.mstate
<- Msel
(a, (x, y));
6207 G.postRedisplay "motion select";
6210 let y = min state
.winh
(max
0 y) in
6214 let x = min state
.winw (max
0 x) in
6217 | Mzoomrect
(p0
, _) ->
6218 state
.mstate
<- Mzoomrect
(p0
, (x, y));
6219 G.postRedisplay "motion zoomrect";
6223 method pmotion
x y =
6224 begin match state
.mode with
6225 | Birdseye
(conf
, leftx
, pageno, hooverpageno
, anchor) ->
6226 let rec loop = function
6228 if hooverpageno
!= -1
6230 state
.mode <- Birdseye
(conf
, leftx
, pageno, -1, anchor);
6231 G.postRedisplay "pmotion birdseye no hoover";
6234 if y > l.pagedispy && y < l.pagedispy + l.pagevh
6235 && x > l.pagedispx && x < l.pagedispx + l.pagevw
6237 state
.mode <- Birdseye
(conf
, leftx
, pageno, l.pageno, anchor);
6238 G.postRedisplay "pmotion birdseye hoover";
6248 match state
.mstate
with
6249 | Mpan
_ | Msel
_ | Mzoom
_ | Mscrolly
| Mscrollx
| Mzoomrect
_ -> ()
6257 let past, _, _ = !r in
6259 let delta = now -. past in
6262 else r := (now, x, y)
6266 method infochanged
_ = ()
6269 let maxy = state
.maxy - (if conf
.maxhfit
then state
.winh
else 0) in
6272 then 0.0, float state
.winh
6273 else scrollph state
.y maxy
6278 let winw = wadjsb () + state
.winw in
6279 let fwinw = float winw in
6281 let sw = fwinw /. float state
.w in
6282 let sw = fwinw *. sw in
6283 max
sw (float conf
.scrollh
)
6286 let maxx = state
.w + winw in
6287 let x = winw - state
.x in
6288 let percent = float x /. float maxx in
6289 (fwinw -. sw) *. percent
6291 hscrollh (), position, sw
6295 match state
.mode with
6296 | LinkNav
_ -> "links"
6297 | Textentry
_ -> "textentry"
6298 | Birdseye
_ -> "birdseye"
6301 findkeyhash conf
modename
6303 method eformsgs
= true
6304 method alwaysscrolly
= false
6307 let adderrmsg src msg
=
6308 Buffer.add_string state
.errmsgs msg
;
6309 state
.newerrmsgs
<- true;
6313 let adderrfmt src fmt
=
6314 Format.ksprintf
(fun s -> adderrmsg src s) fmt
;
6318 let cl = splitatspace cmds
in
6320 try Scanf.sscanf
s fmt
f
6322 adderrfmt "remote exec"
6323 "error processing '%S': %s\n" cmds
(exntos exn
)
6326 | "reload" :: [] -> reload ()
6327 | "goto" :: args
:: [] ->
6328 scan args
"%u %f %f"
6330 let cmd, _ = state
.geomcmds
in
6332 then gotopagexy pageno x y
6335 gotopagexy pageno x y;
6338 state
.reprf
<- f state
.reprf
6340 | "goto1" :: args
:: [] -> scan args
"%u %f" gotopage
6341 | "gotor" :: args
:: [] ->
6343 (fun filename
pageno -> gotounder (Uremote
(filename
, pageno)))
6344 | "gotord" :: args
:: [] ->
6346 (fun filename
dest -> gotounder (Uremotedest
(filename
, dest)))
6347 | "rect" :: args
:: [] ->
6348 scan args
"%u %u %f %f %f %f"
6349 (fun pageno color x0 y0 x1 y1 ->
6350 onpagerect pageno (fun w h ->
6351 let _,w1,h1
,_ = getpagedim
pageno in
6352 let sw = float w1 /. float w
6353 and sh = float h1
/. float h in
6357 and y1s
= y1 *. sh in
6358 let rect = (x0s,y0s
,x1s
,y0s
,x1s
,y1s
,x0s,y1s
) in
6360 state
.rects <- (pageno, color, rect) :: state
.rects;
6361 G.postRedisplay "rect";
6364 | "activatewin" :: [] -> Wsi.activatewin
()
6365 | "quit" :: [] -> raise Quit
6367 adderrfmt "remote command"
6368 "error processing remote command: %S\n" cmds
;
6372 let scratch = Bytes.create
80 in
6373 let buf = Buffer.create
80 in
6376 try Some
(Unix.read fd
scratch 0 80)
6378 | Unix.Unix_error
(Unix.EAGAIN
, _, _) -> None
6379 | Unix.Unix_error
(Unix.EINTR
, _, _) -> tempfr ()
6382 match tempfr () with
6388 if Buffer.length
buf > 0
6390 let s = Buffer.contents
buf in
6400 let pos = Bytes.index_from
scratch ppos '
\n'
in
6401 if pos >= n then -1 else pos
6402 with Not_found
-> -1
6406 Buffer.add_subbytes
buf scratch ppos
(nlpos-ppos
);
6407 let s = Buffer.contents
buf in
6413 Buffer.add_subbytes
buf scratch ppos
(n-ppos
);
6419 let remoteopen path =
6420 try Some
(Unix.openfile
path [Unix.O_NONBLOCK
; Unix.O_RDONLY
] 0o0)
6422 adderrfmt "remoteopen" "error opening %S: %s" path (exntos exn
);
6427 let gcconfig = ref E.s in
6428 let trimcachepath = ref E.s in
6429 let rcmdpath = ref E.s in
6430 let pageno = ref None
in
6431 let rootwid = ref 0 in
6432 let openlast = ref false in
6433 let nofc = ref false in
6434 selfexec := Sys.executable_name
;
6437 [("-p", Arg.String
(fun s -> state
.password <- s),
6438 "<password> Set password");
6442 Config.fontpath
:= s;
6443 selfexec := !selfexec ^
" -f " ^
Filename.quote
s;
6445 "<path> Set path to the user interface font");
6449 selfexec := !selfexec ^
" -c " ^
Filename.quote
s;
6450 Config.confpath
:= s),
6451 "<path> Set path to the configuration file");
6453 ("-last", Arg.Set
openlast, " Open last document");
6455 ("-page", Arg.Int
(fun pageno1
-> pageno := Some
(pageno1
-1)),
6456 "<page-number> Jump to page");
6458 ("-tcf", Arg.String
(fun s -> trimcachepath := s),
6459 "<path> Set path to the trim cache file");
6461 ("-dest", Arg.String
(fun s -> state
.nameddest
<- s),
6462 "<named-destination> Set named destination");
6464 ("-wtmode", Arg.Set
wtmode, " Operate in wt mode");
6465 ("-cxack", Arg.Set
cxack, " Cut corners");
6467 ("-remote", Arg.String
(fun s -> rcmdpath := s),
6468 "<path> Set path to the remote commands source");
6470 ("-origin", Arg.String
(fun s -> state
.origin
<- s),
6471 "<original-path> Set original path");
6473 ("-gc", Arg.Set_string
gcconfig,
6474 "<script-path> Collect garbage with the help of a script");
6476 ("-nofc", Arg.Set
nofc, " Do not use fontconfig");
6478 ("-v", Arg.Unit
(fun () ->
6480 "%s\nconfiguration path: %s\n"
6484 exit
0), " Print version and exit");
6486 ("-embed", Arg.Set_int
rootwid,
6487 "<window-id> Embed into window")
6490 (fun s -> state
.path <- s)
6491 ("Usage: " ^
Sys.argv
.(0) ^
" [options] some.pdf\nOptions:")
6494 then selfexec := !selfexec ^
" -wtmode";
6496 let histmode = emptystr state
.path && not
!openlast in
6498 if not
(Config.load !openlast)
6499 then prerr_endline
"failed to load configuration";
6500 begin match !pageno with
6501 | Some
pageno -> state
.anchor <- (pageno, 0.0, 0.0)
6505 if not
(emptystr
!gcconfig)
6508 match Unix.socketpair
Unix.PF_UNIX
Unix.SOCK_STREAM
0 with
6510 error
"gc socketpair failed: %s" (exntos exn
)
6513 match addpid @@ popen
!gcconfig [(c, 0); (c, 1)] with
6515 error
"failed to popen gc script: %s" (exntos exn
);
6521 let wsfd, winw, winh
= Wsi.init
(object (self)
6522 val mutable m_clicks
= 0
6523 val mutable m_click_x
= 0
6524 val mutable m_click_y
= 0
6525 val mutable m_lastclicktime
= infinity
6527 method private cleanup
=
6528 state
.roam
<- noroam
;
6529 Hashtbl.iter
(fun _ opaque -> clearmark
opaque) state
.pagemap
6530 method expose
= G.postRedisplay"expose"
6534 | Wsi.Unobscured
-> "unobscured"
6535 | Wsi.PartiallyObscured
-> "partiallyobscured"
6536 | Wsi.FullyObscured
-> "fullyobscured"
6538 vlog "visibility change %s" name
6539 method display = display ()
6540 method map mapped
= vlog "mappped %b" mapped
6541 method reshape w h =
6544 method mouse
b d x y m =
6545 if d && canselect ()
6547 (* http://blogs.msdn.com/b/oldnewthing/archive/2004/10/18/243925.aspx *)
6553 if abs
x - m_click_x
> 10
6554 || abs
y - m_click_y
> 10
6555 || abs_float
(t -. m_lastclicktime
) > 0.3
6557 m_clicks
<- m_clicks
+ 1;
6558 m_lastclicktime
<- t;
6562 G.postRedisplay "cleanup";
6563 state
.uioh <- state
.uioh#button
b d x y m;
6565 else state
.uioh <- state
.uioh#multiclick m_clicks
x y m
6570 m_lastclicktime
<- infinity
;
6571 state
.uioh <- state
.uioh#button
b d x y m
6575 state
.uioh <- state
.uioh#button
b d x y m
6578 state
.mpos
<- (x, y);
6579 state
.uioh <- state
.uioh#motion
x y
6580 method pmotion
x y =
6581 state
.mpos
<- (x, y);
6582 state
.uioh <- state
.uioh#pmotion
x y
6584 let mascm = m land (
6585 Wsi.altmask
+ Wsi.shiftmask
+ Wsi.ctrlmask
+ Wsi.metamask
6588 let x = state
.x and y = state
.y in
6590 if x != state
.x || y != state
.y then self#cleanup
6592 match state
.keystate
with
6594 let km = k
, mascm in
6597 let modehash = state
.uioh#
modehash in
6598 try Hashtbl.find modehash km
6600 try Hashtbl.find (findkeyhash conf
"global") km
6601 with Not_found
-> KMinsrt
(k
, m)
6603 | KMinsrt
(k
, m) -> keyboard k
m
6604 | KMinsrl
l -> List.iter
(fun (k
, m) -> keyboard k
m) l
6605 | KMmulti
(l, r) -> state
.keystate
<- KSinto
(l, r)
6607 | KSinto
((k'
, m'
) :: [], insrt
) when k'
=k
&& m'
land mascm = m'
->
6608 List.iter
(fun (k
, m) -> keyboard k
m) insrt
;
6609 state
.keystate
<- KSnone
6610 | KSinto
((k'
, m'
) :: keys, insrt
) when k'
=k
&& m'
land mascm = m'
->
6611 state
.keystate
<- KSinto
(keys, insrt
)
6612 | KSinto
_ -> state
.keystate
<- KSnone
6615 state
.mpos
<- (x, y);
6616 state
.uioh <- state
.uioh#pmotion
x y
6617 method leave = state
.mpos
<- (-1, -1)
6618 method winstate wsl
= state
.winstate
<- wsl
6619 method quit
= raise Quit
6620 end) !rootwid conf
.cwinw conf
.cwinh platform
in
6625 List.exists
GlMisc.check_extension
6626 [ "GL_ARB_texture_rectangle"
6627 ; "GL_EXT_texture_recangle"
6628 ; "GL_NV_texture_rectangle" ]
6630 then (prerr_endline
"OpenGL does not suppport rectangular textures"; exit
1);
6633 let r = GlMisc.get_string `renderer
in
6634 let p = "Mesa DRI Intel(" in
6635 let l = String.length
p in
6636 String.length
r > l && String.sub
r 0 l = p
6639 defconf
.sliceheight
<- 1024;
6640 defconf
.texcount
<- 32;
6641 defconf
.usepbo
<- true;
6645 match Unix.socketpair
Unix.PF_UNIX
Unix.SOCK_STREAM
0 with
6647 Printf.eprintf
"socketpair failed: %s" (exntos exn
);
6655 setcheckers conf
.checkers
;
6657 if conf
.redirectstderr
6661 (Buffer.to_bytes state
.errmsgs
)
6662 (match state
.errfd
with
6664 let s = Bytes.create
(80*24) in
6667 let r, _, _ = Unix.select
[fd
] [] [] 0.0 in
6669 then Unix.read fd
s 0 (Bytes.length
s)
6675 else Bytes.sub
s 0 n
6679 try ignore
(Unix.write state
.stderr
s 0 (Bytes.length
s))
6680 with exn
-> print_endline
(exntos exn
)
6685 conf
.angle
, conf
.fitmodel
, (conf
.trimmargins
, conf
.trimfuzz
),
6686 conf
.texcount
, conf
.sliceheight
, conf
.mustoresize
, conf
.colorspace
,
6687 !Config.fontpath
, !trimcachepath,
6688 GlMisc.check_extension
"GL_ARB_pixel_buffer_object",
6691 List.iter
GlArray.enable
[`texture_coord
; `vertex
];
6697 Wsi.settitle
"llpp (history)";
6701 state
.text <- "Opening " ^
(mbtoutf8 state
.path);
6702 opendoc state
.path state
.password;
6707 Sys.set_signal
Sys.sighup
(Sys.Signal_handle
(fun _ -> reload ()));
6710 if nonemptystr
!rcmdpath
6711 then remoteopen !rcmdpath
6716 let rec loop deadline
=
6718 if pidcount
.contents
> 0
6720 match Unix.wait
() with
6721 | (exception exn
) -> dolog
"Unix.wait: %s" @@ exntos exn
6728 match state
.errfd
with
6729 | None
-> [state
.ss; state
.wsfd]
6730 | Some fd
-> [state
.ss; state
.wsfd; fd
]
6735 | Some fd
-> fd
:: r
6739 state
.redisplay
<- false;
6746 if deadline
= infinity
6748 else max
0.0 (deadline
-. now)
6753 try Unix.select
r [] [] timeout
6754 with Unix.Unix_error
(Unix.EINTR
, _, _) -> [], [], []
6760 if state
.ghyll
== noghyll
6762 match state
.autoscroll
with
6763 | Some step
when step
!= 0 ->
6764 let y = state
.y + step
in
6768 else if y >= state
.maxy then 0 else y
6771 if state
.mode = View
6772 then state
.text <- E.s;
6775 else deadline
+. 0.01
6780 let rec checkfds = function
6782 | fd
:: rest
when fd
= state
.ss ->
6783 let cmd = readcmd state
.ss in
6787 | fd
:: rest
when fd
= state
.wsfd ->
6791 | fd
:: rest
when Some fd
= !optrfd ->
6792 begin match remote fd
with
6793 | None
-> optrfd := remoteopen !rcmdpath;
6794 | opt -> optrfd := opt
6799 let s = Bytes.create
80 in
6800 let n = tempfailureretry
(Unix.read fd
s 0) 80 in
6801 if conf
.redirectstderr
6803 Buffer.add_substring state
.errmsgs
(Bytes.to_string
s) 0 n;
6804 state
.newerrmsgs
<- true;
6805 state
.redisplay
<- true;
6808 prerr_string
(String.sub
(Bytes.to_string
s) 0 n);
6814 if !reeenterhist then (
6816 reeenterhist := false;
6820 if deadline
= infinity
6824 match state
.autoscroll
with
6825 | Some step
when step
!= 0 -> deadline1
6826 | _ -> if state
.ghyll
== noghyll
then infinity
else deadline1
6834 Config.save leavebirdseye;
6835 if hasunsavedchanges
()