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 if emptystr conf
.pathlauncher
138 then print_endline state
.path
140 let command = Str.global_replace percentsre state
.path conf
.pathlauncher
in
141 try addpid @@ popen
command []
143 Printf.eprintf
"failed to execute `%s': %s\n" command (exntos exn
);
148 let redirectstderr () =
149 let clofail what errmsg
= dolog
"failed to close %s: %s" what errmsg
in
150 if conf
.redirectstderr
152 match Unix.pipe
() with
154 dolog
"failed to create stderr redirection pipes: %s" (exntos exn
)
157 begin match Unix.dup
Unix.stderr
with
159 dolog
"failed to dup stderr: %s" (exntos exn
);
160 Ne.clo r
(clofail "pipe/r");
161 Ne.clo w
(clofail "pipe/w");
164 begin match Unix.dup2 w
Unix.stderr
with
166 dolog
"failed to dup2 to stderr: %s" (exntos exn
);
167 Ne.clo dupstderr
(clofail "stderr duplicate");
168 Ne.clo r
(clofail "redir pipe/r");
169 Ne.clo w
(clofail "redir pipe/w");
172 state
.stderr
<- dupstderr
;
173 state
.errfd
<- Some r
;
177 state
.newerrmsgs
<- false;
178 begin match state
.errfd
with
180 begin match Unix.dup2 state
.stderr
Unix.stderr
with
182 dolog
"failed to dup2 original stderr: %s" (exntos exn
)
184 Ne.clo fd
(clofail "dup of stderr");
189 prerr_string
(Buffer.contents state
.errmsgs
);
191 Buffer.clear state
.errmsgs
;
197 let postRedisplay who
=
199 then prerr_endline
("redisplay for " ^ who
);
200 state
.redisplay
<- true;
204 let getopaque pageno
=
205 try Some
(Hashtbl.find state
.pagemap
(pageno
, state
.gen
))
206 with Not_found
-> None
209 let putopaque pageno opaque
=
210 Hashtbl.replace state
.pagemap
(pageno
, state
.gen
) opaque
213 let pagetranslatepoint l x y
=
214 let dy = y
- l
.pagedispy
in
215 let y = dy + l
.pagey
in
216 let dx = x
- l
.pagedispx
in
217 let x = dx + l
.pagex
in
221 let onppundermouse g
x y d
=
224 begin match getopaque l
.pageno
with
226 let x0 = l
.pagedispx
in
227 let x1 = x0 + l
.pagevw
in
228 let y0 = l
.pagedispy
in
229 let y1 = y0 + l
.pagevh
in
230 if y >= y0 && y <= y1 && x >= x0 && x <= x1
232 let px, py
= pagetranslatepoint l
x y in
233 match g opaque l
px py
with
246 let g opaque l
px py
=
249 match rectofblock opaque
px py
with
251 let rect = (a
.(0),a
.(2),a
.(1),a
.(2),a
.(1),a
.(3),a
.(0),a
.(3)) in
252 state
.rects
<- [l
.pageno
, l
.pageno
mod 3, rect];
253 G.postRedisplay "getunder";
256 let under = whatsunder opaque
px py
in
267 | Uannotation _
-> Some
under
269 onppundermouse g x y Unone
274 match unproject opaque
x y with
275 | Some
(x, y) -> Some
(Some
(opaque
, l
.pageno
, x, y))
278 onppundermouse g x y None
;
282 state
.text
<- Printf.sprintf
"%c%s" c s
;
283 G.postRedisplay "showtext";
286 let pipesel opaque cmd
=
289 match Unix.pipe
() with
292 (Printf.sprintf
"pipesel can not create pipe: %s" (exntos exn
));
294 let doclose what fd
=
295 Ne.clo fd
(fun msg
-> dolog
"%s close failed: %s" what msg
)
298 try popen cmd
[r
, 0; w
, -1]
300 dolog
"can not execute %S: %s" cmd
(exntos exn
);
307 G.postRedisplay "pipesel";
309 else doclose "pipesel pipe/w" w
;
310 doclose "pipesel pipe/r" r
;
314 let g opaque l
px py
=
315 if markunder opaque
px py conf
.paxmark
318 match getopaque l
.pageno
with
320 | Some opaque
-> pipesel opaque conf
.paxcmd
325 G.postRedisplay "paxunder";
326 if conf
.paxmark
= Mark_page
329 match getopaque l
.pageno
with
331 | Some opaque
-> clearmark opaque
) state
.layout
;
333 onppundermouse g x y (fun () -> showtext '
!'
"Whoopsie daisy");
337 match Unix.pipe
() with
339 showtext '
!'
(Printf.sprintf
"pipe failed: %s" (exntos exn
))
342 Ne.clo fd
(fun msg
->
343 showtext '
!'
(Printf.sprintf
"failed to close %s: %s" cap msg
)
347 try popen conf
.selcmd
[r
, 0; w
, -1]
350 (Printf.sprintf
"failed to execute %s: %s"
351 conf
.selcmd
(exntos exn
));
358 let l = String.length s
in
359 let bytes = Bytes.unsafe_of_string s
in
360 let n = tempfailureretry
(Unix.write w
bytes 0) l in
365 "failed to write %d characters to sel pipe, wrote %d"
370 (Printf.sprintf
"failed to write to sel pipe: %s"
375 clo "selstring pipe/r" r
;
376 clo "selstring pipe/w" w
;
379 let undertext = function
382 | Ulinkgoto
(pageno
, _
) -> Printf.sprintf
"%s: page %d" state
.path
(pageno
+1)
383 | Utext s
-> "font: " ^ s
384 | Uunexpected s
-> "unexpected: " ^ s
385 | Ulaunch s
-> "launch: " ^ s
386 | Unamed s
-> "named: " ^ s
387 | Uremote
(filename
, pageno
) ->
388 Printf.sprintf
"%s: page %d" filename
(pageno
+1)
389 | Uremotedest
(filename
, destname
) ->
390 Printf.sprintf
"%s: destination %S" filename destname
391 | Uannotation
(opaque
, slinkindex
) ->
392 "annotation: " ^ getannotcontents opaque slinkindex
395 let updateunder x y =
396 match getunder x y with
397 | Unone
-> Wsi.setcursor
Wsi.CURSOR_INHERIT
399 if conf
.underinfo
then showtext 'u'
("ri: " ^ uri
);
400 Wsi.setcursor
Wsi.CURSOR_INFO
401 | Ulinkgoto
(pageno
, _
) ->
403 then showtext 'p'
("age: " ^ string_of_int
(pageno
+1));
404 Wsi.setcursor
Wsi.CURSOR_INFO
406 if conf
.underinfo
then showtext '
f'
("ont: " ^ s
);
407 Wsi.setcursor
Wsi.CURSOR_TEXT
409 if conf
.underinfo
then showtext 'u'
("nexpected: " ^ s
);
410 Wsi.setcursor
Wsi.CURSOR_INHERIT
412 if conf
.underinfo
then showtext '
l'
("aunch: " ^ s
);
413 Wsi.setcursor
Wsi.CURSOR_INHERIT
415 if conf
.underinfo
then showtext '
n'
("amed: " ^ s
);
416 Wsi.setcursor
Wsi.CURSOR_INHERIT
417 | Uremote
(filename
, pageno
) ->
418 if conf
.underinfo
then showtext 'r'
419 (Printf.sprintf
"emote: %s (%d)" filename
(pageno
+1));
420 Wsi.setcursor
Wsi.CURSOR_INFO
421 | Uremotedest
(filename
, destname
) ->
422 if conf
.underinfo
then showtext 'r'
423 (Printf.sprintf
"emote destination: %s (%S)" filename destname
);
424 Wsi.setcursor
Wsi.CURSOR_INFO
426 if conf
.underinfo
then showtext 'a'
"nnotation";
427 Wsi.setcursor
Wsi.CURSOR_INFO
430 let showlinktype under =
444 let s = undertext under in
449 let b = Buffer.create
(String.length
s + 1) in
450 Buffer.add_string
b s;
455 let intentry_with_suffix text key
=
457 if key
>= 32 && key
< 127
461 match Char.lowercase
c with
463 let text = addchar text c in
467 let text = addchar text c in
471 state
.text <- Printf.sprintf
"invalid char (%d, `%c')" key
c;
476 let s = Bytes.create
4 in
477 let n = tempfailureretry
(Unix.read fd
s 0) 4 in
478 if n != 4 then error
"incomplete read(len) = %d" n;
479 let len = (Char.code
(Bytes.get
s 0) lsl 24)
480 lor (Char.code
(Bytes.get
s 1) lsl 16)
481 lor (Char.code
(Bytes.get
s 2) lsl 8)
482 lor (Char.code
(Bytes.get
s 3))
484 let s = Bytes.create
len in
485 let n = tempfailureretry
(Unix.read fd
s 0) len in
486 if n != len then error
"incomplete read(data) %d vs %d" n len;
490 let btod b = if b then 1 else 0;;
493 let b = Buffer.create
16 in
494 Buffer.add_string
b "llll";
497 let s = Buffer.to_bytes
b in
498 let n = Bytes.length
s in
500 (* dolog "wcmd %S" (String.sub s 4 len); *)
501 Bytes.set
s 0 (Char.chr
((len lsr 24) land 0xff));
502 Bytes.set
s 1 (Char.chr
((len lsr 16) land 0xff));
503 Bytes.set
s 2 (Char.chr
((len lsr 8) land 0xff));
504 Bytes.set
s 3 (Char.chr
(len land 0xff));
505 let n'
= tempfailureretry
(Unix.write state
.ss
s 0) n in
506 if n'
!= n then error
"write failed %d vs %d" n'
n;
510 let nogeomcmds cmds
=
512 | s, [] -> emptystr
s
516 let layoutN ((columns
, coverA
, coverB
), b) y sh
=
517 let sh = sh - (hscrollh ()) in
518 let wadj = wadjsb () in
519 let rec fold accu
n =
520 if n = Array.length
b
523 let pdimno, dx, vy
, (_
, w
, h
, xoff
) = b.(n) in
526 || n = state
.pagecount
- coverB
527 || (n - coverA
) mod columns
= columns
- 1)
533 let pagey = max
0 (y - vy
) in
534 let pagedispy = if pagey > 0 then 0 else vy
- y in
535 let pagedispx, pagex
=
537 if n = coverA
- 1 || n = state
.pagecount
- coverB
538 then state
.x + (wadj + state
.winw
- w
) / 2
539 else dx + xoff
+ state
.x
546 let vw = wadj + state
.winw
- pagedispx in
547 let pw = w
- pagex
in
550 let pagevh = min
(h
- pagey) (sh - pagedispy) in
551 if pagevw > 0 && pagevh > 0
562 ; pagedispx = pagedispx
563 ; pagedispy = pagedispy
575 if Array.length
b = 0
577 else List.rev
(fold [] (page_of_y
y))
580 let layoutS (columns
, b) y sh =
581 let sh = sh - hscrollh () in
582 let wadj = wadjsb () in
583 let rec fold accu n =
584 if n = Array.length
b
587 let pdimno, px, vy
, (_
, pagew
, pageh
, xoff
) = b.(n) in
594 let x = xoff
+ state
.x in
595 let pagey = max
0 (y - vy
) in
596 let pagedispy = if pagey > 0 then 0 else vy
- y in
597 let pagedispx, pagex
=
611 let pagecolw = pagew
/columns
in
613 if pagecolw < state
.winw
614 then pagedispx + ((wadj + state
.winw
- pagecolw) / 2)
618 let vw = wadj + state
.winw
- pagedispx in
619 let pw = pagew
- pagex
in
622 let pagevw = min
pagevw pagecolw in
623 let pagevh = min
(pageh
- pagey) (sh - pagedispy) in
624 if pagevw > 0 && pagevh > 0
635 ; pagedispx = pagedispx
636 ; pagedispy = pagedispy
637 ; pagecol
= n mod columns
652 if nogeomcmds state
.geomcmds
654 match conf
.columns
with
655 | Csingle
b -> layoutN ((1, 0, 0), b) y sh
656 | Cmulti
c -> layoutN c y sh
657 | Csplit
s -> layoutS s y sh
662 let y = state
.y + incr
in
664 let y = min
y (state
.maxy
- (if conf
.maxhfit
then state
.winh
else 0)) in
669 let tilex = l.pagex
mod conf
.tilew
in
670 let tiley = l.pagey mod conf
.tileh
in
672 let col = l.pagex
/ conf
.tilew
in
673 let row = l.pagey / conf
.tileh
in
675 let xadj = xadjsb () in
676 let rec rowloop row y0 dispy h
=
680 let dh = conf
.tileh
- y0 in
682 let rec colloop col x0 dispx w
=
686 let dw = conf
.tilew
- x0 in
688 let dispx'
= xadj + dispx in
689 f col row dispx' dispy
x0 y0 dw dh;
690 colloop (col+1) 0 (dispx+dw) (w
-dw)
693 colloop col tilex l.pagedispx l.pagevw;
694 rowloop (row+1) 0 (dispy
+dh) (h
-dh)
697 if l.pagevw > 0 && l.pagevh > 0
698 then rowloop row tiley l.pagedispy l.pagevh;
701 let gettileopaque l col row =
703 l.pageno
, state
.gen
, conf
.colorspace
, conf
.angle
, l.pagew
, l.pageh
, col, row
705 try Some
(Hashtbl.find state
.tilemap
key)
706 with Not_found
-> None
709 let puttileopaque l col row gen colorspace angle opaque size elapsed
=
710 let key = l.pageno
, gen
, colorspace
, angle
, l.pagew
, l.pageh
, col, row in
711 Hashtbl.add state
.tilemap
key (opaque
, size
, elapsed
)
714 let filledrect x0 y0 x1 y1 =
715 GlArray.disable `texture_coord
;
716 Raw.sets_float state
.vraw ~pos
:0 [| x0; y0; x0; y1; x1; y0; x1; y1 |];
717 GlArray.vertex `two state
.vraw
;
718 GlArray.draw_arrays `triangle_strip ~first
:0 ~count
:4;
719 GlArray.enable `texture_coord
;
722 let linerect x0 y0 x1 y1 =
723 GlArray.disable `texture_coord
;
724 Raw.sets_float state
.vraw ~pos
:0 [| x0; y0; x0; y1; x1; y1; x1; y0 |];
725 GlArray.vertex `two state
.vraw
;
726 GlArray.draw_arrays `line_loop ~first
:0 ~count
:4;
727 GlArray.enable `texture_coord
;
730 let drawtiles l color
=
732 let wadj = wadjsb () in
734 let f col row x y tilex tiley w h
=
735 match gettileopaque l col row with
736 | Some
(opaque
, _
, t
) ->
737 let params = x, y, w
, h
, tilex, tiley in
739 then GlTex.env
(`mode `blend
);
740 drawtile
params opaque
;
742 then GlTex.env
(`mode `modulate
);
746 let s = Printf.sprintf
750 let w = measurestr fstate
.fontsize
s in
751 GlDraw.color
(0.0, 0.0, 0.0);
752 filledrect (float (x-2))
755 (float (y + fstate
.fontsize
+ 2));
756 GlDraw.color
(1.0, 1.0, 1.0);
757 drawstring fstate
.fontsize
x (y + fstate
.fontsize
- 1) s;
767 let lw = wadj + state
.winw
- x in
770 let lh = state
.winh
- y in
774 then GlTex.env
(`mode `blend
);
775 begin match state
.checkerstexid
with
777 Gl.enable `texture_2d
;
778 GlTex.bind_texture ~target
:`texture_2d id
;
782 and y1 = float (y+h
) in
784 let tw = float w /. 16.0
785 and th
= float h
/. 16.0 in
786 let tx0 = float tilex /. 16.0
787 and ty0
= float tiley /. 16.0 in
789 and ty1
= ty0
+. th
in
790 Raw.sets_float state
.vraw ~pos
:0
791 [| x0; y0; x0; y1; x1; y0; x1; y1 |];
792 Raw.sets_float state
.traw ~pos
:0
793 [| tx0; ty0
; tx0; ty1
; tx1; ty0
; tx1; ty1
|];
794 GlArray.vertex `two state
.vraw
;
795 GlArray.tex_coord `two state
.traw
;
796 GlArray.draw_arrays `triangle_strip ~first
:0 ~count
:4;
797 Gl.disable `texture_2d
;
800 GlDraw.color
(1.0, 1.0, 1.0);
801 filledrect (float x) (float y) (float (x+w)) (float (y+h
));
804 then GlTex.env
(`mode `modulate
);
805 if w > 128 && h
> fstate
.fontsize
+ 10
807 let c = if conf
.invert
then 1.0 else 0.0 in
808 GlDraw.color
(c, c, c);
811 then (col*conf
.tilew
, row*conf
.tileh
)
814 drawstring2 fstate
.fontsize
x y "Loading %d [%d,%d]" l.pageno
c r
;
823 let pagevisible layout n = List.exists
(fun l -> l.pageno
= n) layout;;
825 let tilevisible1 l x y =
827 and ax1
= l.pagex
+ l.pagevw
829 and ay1
= l.pagey + l.pagevh in
833 let bx1 = min
(bx0 + conf
.tilew
) l.pagew
834 and by1
= min
(by0
+ conf
.tileh
) l.pageh
in
836 let rx0 = max
ax0 bx0
837 and ry0
= max ay0 by0
838 and rx1
= min ax1
bx1
839 and ry1
= min ay1 by1
in
841 let nonemptyintersection = rx1
> rx0 && ry1
> ry0
in
845 let tilevisible layout n x y =
846 let rec findpageinlayout m
= function
847 | l :: rest
when l.pageno
= n ->
848 tilevisible1 l x y || (
849 match conf
.columns
with
850 | Csplit
(c, _
) when c > m
-> findpageinlayout (m
+1) rest
855 | _
:: rest
-> findpageinlayout 0 rest
858 findpageinlayout 0 layout;
861 let tileready l x y =
862 tilevisible1 l x y &&
863 gettileopaque l (x/conf
.tilew
) (y/conf
.tileh
) != None
866 let tilepage n p
layout =
867 let rec loop = function
871 let f col row _ _ _ _ _ _
=
872 if state
.currently
= Idle
874 match gettileopaque l col row with
877 let x = col*conf
.tilew
878 and y = row*conf
.tileh
in
880 let w = l.pagew
- x in
884 let h = l.pageh
- y in
889 then getpbo
w h conf
.colorspace
892 wcmd "tile %s %d %d %d %d %s"
893 (~
> p
) x y w h (~
> pbo);
896 l, p
, conf
.colorspace
, conf
.angle
,
897 state
.gen
, col, row, conf
.tilew
, conf
.tileh
906 if nogeomcmds state
.geomcmds
910 let preloadlayout y =
911 let y = if y < state
.winh
then 0 else y - state
.winh
in
912 let h = state
.winh
*3 in
918 if state
.currently
!= Idle
923 begin match getopaque l.pageno
with
925 wcmd "page %d %d" l.pageno
l.pagedimno
;
926 state
.currently
<- Loading
(l, state
.gen
);
928 tilepage l.pageno opaque pages
;
933 if nogeomcmds state
.geomcmds
939 if conf
.preload && state
.currently
= Idle
940 then load (preloadlayout state
.y);
943 let layoutready layout =
944 let rec fold all ls
=
947 let seen = ref false in
948 let allvisible = ref true in
949 let foo col row _ _ _ _ _ _
=
951 allvisible := !allvisible &&
952 begin match gettileopaque l col row with
958 fold (!seen && !allvisible) rest
961 let alltilesvisible = fold true layout in
966 let y = bound
y 0 state
.maxy
in
967 let y, layout, proceed
=
968 match conf
.maxwait
with
969 | Some time
when state
.ghyll
== noghyll
->
970 begin match state
.throttle
with
972 let layout = layout y state
.winh
in
973 let ready = layoutready layout in
977 state
.throttle
<- Some
(layout, y, now
());
979 else G.postRedisplay "gotoy showall (None)";
981 | Some
(_
, _
, started
) ->
982 let dt = now
() -. started
in
985 state
.throttle
<- None
;
986 let layout = layout y state
.winh
in
988 G.postRedisplay "maxwait";
995 let layout = layout y state
.winh
in
996 if not
!wtmode || layoutready layout
997 then G.postRedisplay "gotoy ready";
1003 state
.layout <- layout;
1004 begin match state
.mode
with
1007 | Ltexact
(pageno
, linkno
) ->
1008 let rec loop = function
1010 state
.mode
<- LinkNav
(Ltgendir
0)
1011 | l :: _
when l.pageno
= pageno
->
1012 begin match getopaque pageno
with
1013 | None
-> state
.mode
<- LinkNav
(Ltnotready
(pageno
, 0))
1015 let x0, y0, x1, y1 = getlinkrect opaque linkno
in
1016 if not
(x0 >= l.pagex
&& x1 <= l.pagex
+ l.pagevw
1017 && y0 >= l.pagey && y1 <= l.pagey + l.pagevh)
1018 then state
.mode
<- LinkNav
(Ltgendir
0)
1020 | _
:: rest
-> loop rest
1023 | Ltnotready _
| Ltgendir _
-> ()
1029 begin match state
.mode
with
1030 | Birdseye
(conf
, leftx
, pageno
, hooverpageno
, anchor
) ->
1031 if not
(pagevisible layout pageno
)
1033 match state
.layout with
1036 state
.mode
<- Birdseye
(
1037 conf
, leftx
, l.pageno
, hooverpageno
, anchor
1042 | Ltnotready
(_
, dir
)
1045 let rec loop = function
1048 match getopaque l.pageno
with
1049 | None
-> Ltnotready
(l.pageno
, dir
)
1054 then LDfirstvisible
(l.pagex
, l.pagey, dir
)
1056 if dir
> 0 then LDfirst
else LDlast
1062 | Lnotfound
-> loop rest
1064 showlinktype (getlink opaque
n);
1065 Ltexact
(l.pageno
, n)
1069 state
.mode
<- LinkNav
linknav
1077 state
.ghyll
<- noghyll
;
1080 let mx, my
= state
.mpos
in
1085 let conttiling pageno opaque
=
1086 tilepage pageno opaque
1087 (if conf
.preload then preloadlayout state
.y else state
.layout)
1090 let gotoy_and_clear_text y =
1091 if not conf
.verbose
then state
.text <- E.s;
1095 let getanchory (n, top
, dtop
) =
1096 let y, h = getpageyh
n in
1097 if conf
.presentation
1099 let ips = calcips
h in
1100 y + truncate
(top
*.float h -. dtop
*.float ips) + ips;
1102 y + truncate
(top
*.float h -. dtop
*.float conf
.interpagespace
)
1105 let gotoanchor anchor
=
1106 gotoy (getanchory anchor
);
1110 cbput state
.hists
.nav
(getanchor
());
1114 let anchor = cbgetc state
.hists
.nav dir
in
1118 let gotoghyll1 single
y =
1119 let scroll f n a
b =
1120 (* http://devmaster.net/forums/topic/9796-ease-in-ease-out-algorithm/ *)
1122 let s x = 3.0*.x**2.0 -. 2.0*.x**3.0 in
1124 then s (float f /. float a
)
1127 then 1.0 -. s ((float (f-b) /. float (n-b)))
1133 let ins = float a
*. 0.5
1134 and outs
= float (n-b) *. 0.5 in
1136 ins +. outs
+. float ones
1138 let rec set nab
y sy
=
1139 let (_N
, _A
, _B
), y =
1142 let scl = if y > sy
then 2 else -2 in
1143 let _N, _
, _
= nab
in
1144 (_N,0,_N), y+conf
.scrollstep
*scl
1146 let sum = summa
_N _A _B
in
1147 let dy = float (y - sy
) in
1151 then state
.ghyll
<- noghyll
1154 let s = scroll n _N _A _B
in
1155 let y1 = y1 +. ((s *. dy) /. sum) in
1156 gotoy_and_clear_text (truncate
y1);
1157 state
.ghyll
<- gf (n+1) y1;
1161 | Some
y'
when single
-> set nab
y' state
.y
1162 | Some
y'
-> set (_N/2, 1, 1) y' state
.y
1164 gf 0 (float state
.y)
1167 match conf
.ghyllscroll
with
1168 | Some nab
when not conf
.presentation
->
1169 if state
.ghyll
== noghyll
1170 then set nab
y state
.y
1171 else state
.ghyll
(Some
y)
1173 gotoy_and_clear_text y
1176 let gotoghyll = gotoghyll1 false;;
1178 let gotopage n top
=
1179 let y, h = getpageyh
n in
1180 let y = y + (truncate
(top
*. float h)) in
1184 let gotopage1 n top
=
1185 let y = getpagey
n in
1190 let invalidate s f =
1195 match state
.geomcmds
with
1196 | ps
, [] when emptystr ps
->
1198 state
.geomcmds
<- s, [];
1201 state
.geomcmds
<- ps
, [s, f];
1203 | ps
, (s'
, _
) :: rest
when s'
= s ->
1204 state
.geomcmds
<- ps
, ((s, f) :: rest
);
1207 state
.geomcmds
<- ps
, ((s, f) :: cmds
);
1211 Hashtbl.iter
(fun _ opaque
->
1212 wcmd "freepage %s" (~
> opaque
);
1214 Hashtbl.clear state
.pagemap
;
1218 if not
(Queue.is_empty state
.tilelru
)
1220 Queue.iter
(fun (k
, p
, s) ->
1221 wcmd "freetile %s" (~
> p
);
1222 state
.memused
<- state
.memused
- s;
1223 Hashtbl.remove state
.tilemap k
;
1225 state
.uioh#infochanged Memused
;
1226 Queue.clear state
.tilelru
;
1232 let h = truncate
(float h*.conf
.zoom
) in
1233 let d = conf
.interpagespace
lsl (if conf
.presentation
then 1 else 0) in
1237 let opendoc path password
=
1239 state
.password
<- password
;
1240 state
.gen
<- state
.gen
+ 1;
1241 state
.docinfo
<- [];
1242 state
.outlines
<- [||];
1245 setaalevel conf
.aalevel
;
1247 if emptystr state
.origin
1251 Wsi.settitle
("llpp " ^
(mbtoutf8
(Filename.basename
titlepath)));
1252 wcmd "open %d %d %s\000%s\000" (btod !wtmode) (btod !cxack) path password
;
1253 invalidate "reqlayout"
1255 wcmd "reqlayout %d %d %d %s\000"
1256 conf
.angle
(FMTE.to_int conf
.fitmodel
)
1257 (stateh state
.winh
) state
.nameddest
1262 state
.anchor <- getanchor
();
1263 opendoc state
.path state
.password
;
1267 let c = c *. conf
.colorscale
in
1271 let scalecolor2 (r
, g, b) =
1272 (r
*. conf
.colorscale
, g *. conf
.colorscale
, b *. conf
.colorscale
);
1275 let docolumns columns
=
1276 let wadj = wadjsb () in
1279 let a = Array.make state
.pagecount
(-1, -1, -1, (-1, -1, -1, -1)) in
1280 let wadj = wadjsb () in
1281 let rec loop pageno
pdimno pdim
y ph pdims
=
1282 if pageno
= state
.pagecount
1285 let pdimno, ((_
, w, h, xoff
) as pdim
), pdims
=
1287 | ((pageno'
, _
, _
, _
) as pdim
) :: rest
when pageno'
= pageno
->
1288 pdimno+1, pdim
, rest
1292 let x = max
0 (((wadj + state
.winw
- w) / 2) - xoff
) in
1294 (if conf
.presentation
1295 then (if pageno
= 0 then calcips
h else calcips ph
+ calcips
h)
1296 else (if pageno
= 0 then 0 else conf
.interpagespace
)
1299 a.(pageno
) <- (pdimno, x, y, pdim
);
1300 loop (pageno
+1) pdimno pdim
(y + h) h pdims
1302 loop 0 ~
-1 (-1,-1,-1,-1) 0 0 state
.pdims
;
1303 conf
.columns
<- Csingle
a;
1305 | Cmulti
((columns
, coverA
, coverB
), _
) ->
1306 let a = Array.make state
.pagecount
(-1, -1, -1, (-1, -1, -1, -1)) in
1307 let rec loop pageno
pdimno pdim
x y rowh pdims
=
1308 let rec fixrow m
= if m
= pageno
then () else
1309 let (pdimno, x, y, ((_
, _
, h, _
) as pdim
)) = a.(m
) in
1312 let y = y + (rowh
- h) / 2 in
1313 a.(m
) <- (pdimno, x, y, pdim
);
1317 if pageno
= state
.pagecount
1318 then fixrow (((pageno
- 1) / columns
) * columns
)
1320 let pdimno, ((_
, w, h, xoff
) as pdim
), pdims
=
1322 | ((pageno'
, _
, _
, _
) as pdim
) :: rest
when pageno'
= pageno
->
1323 pdimno+1, pdim
, rest
1328 if pageno
= coverA
- 1 || pageno
= state
.pagecount
- coverB
1330 let x = (wadj + state
.winw
- w) / 2 in
1332 if conf
.presentation
then calcips
h else conf
.interpagespace
in
1333 x, y + ips + rowh
, h
1336 if (pageno
- coverA
) mod columns
= 0
1338 let x = max
0 (wadj + state
.winw
- state
.w) / 2 in
1340 if conf
.presentation
1342 let ips = calcips
h in
1343 y + (if pageno
= 0 then 0 else calcips rowh
+ ips)
1345 y + (if pageno
= 0 then 0 else conf
.interpagespace
)
1349 else x, y, max rowh
h
1353 if pageno
> 1 && (pageno
- coverA
) mod columns
= 0
1356 if pageno
= columns
&& conf
.presentation
1358 let ips = calcips rowh
in
1359 for i
= 0 to pred columns
1361 let (pdimno, x, y, pdim
) = a.(i
) in
1362 a.(i
) <- (pdimno, x, y+ips, pdim
)
1368 fixrow (pageno
- columns
);
1373 a.(pageno
) <- (pdimno, x, y, pdim
);
1374 let x = x + w + xoff
*2 + conf
.interpagespace
in
1375 loop (pageno
+1) pdimno pdim
x y rowh' pdims
1377 loop 0 ~
-1 (-1,-1,-1,-1) 0 0 0 state
.pdims
;
1378 conf
.columns
<- Cmulti
((columns
, coverA
, coverB
), a);
1381 let a = Array.make
(state
.pagecount
*c) (-1, -1, -1, (-1, -1, -1, -1)) in
1382 let rec loop pageno
pdimno pdim
y pdims
=
1383 if pageno
= state
.pagecount
1386 let pdimno, ((_
, w, h, _
) as pdim
), pdims
=
1388 | ((pageno'
, _
, _
, _
) as pdim
) :: rest
when pageno'
= pageno
->
1389 pdimno+1, pdim
, rest
1394 let rec loop1 n x y =
1395 if n = c then y else (
1396 a.(pageno
*c + n) <- (pdimno, x, y, pdim
);
1397 loop1 (n+1) (x+cw) (y + h + conf
.interpagespace
)
1400 let y = loop1 0 0 y in
1401 loop (pageno
+1) pdimno pdim
y pdims
1403 loop 0 ~
-1 (-1,-1,-1,-1) 0 state
.pdims
;
1404 conf
.columns
<- Csplit
(c, a);
1408 docolumns conf
.columns
;
1409 state
.maxy
<- calcheight
();
1410 if state
.reprf
== noreprf
1412 match state
.mode
with
1413 | Birdseye
(_
, _
, pageno
, _
, _
) ->
1414 let y, h = getpageyh pageno
in
1415 let top = (state
.winh
- h) / 2 in
1416 gotoy (max
0 (y - top))
1419 | LinkNav _
-> gotoanchor state
.anchor
1423 state
.reprf
<- noreprf
;
1428 GlDraw.viewport ~
x:0 ~
y:0 ~
w:w ~
h:h;
1429 let firsttime = state
.geomcmds
== firstgeomcmds
in
1430 if not
firsttime && nogeomcmds state
.geomcmds
1431 then state
.anchor <- getanchor
();
1434 let w = wadjsb () + (truncate
(float w *. conf
.zoom
)) in
1437 setfontsize fstate
.fontsize
;
1438 GlMat.mode `modelview
;
1439 GlMat.load_identity
();
1441 GlMat.mode `projection
;
1442 GlMat.load_identity
();
1443 GlMat.rotate ~
x:1.0 ~angle
:180.0 ();
1444 GlMat.translate ~
x:~
-.1.0 ~
y:~
-.1.0 ();
1445 GlMat.scale3
(2.0 /. float state
.winw
, 2.0 /. float state
.winh
, 1.0);
1450 else float state
.x /. float state
.w
1452 invalidate "geometry"
1456 then state
.x <- truncate
(relx *. float w);
1458 match conf
.columns
with
1460 | Cmulti
((c, _
, _
), _
) -> (w - (c-1)*conf
.interpagespace
) / c
1461 | Csplit
(c, _
) -> w * c
1463 wcmd "geometry %d %d %d"
1464 w (stateh h) (FMTE.to_int conf
.fitmodel
)
1469 let len = String.length state
.text in
1470 let x0 = xadjsb () in
1473 match state
.mode
with
1474 | Textentry _
| View
| LinkNav _
->
1475 let h, _
, _
= state
.uioh#scrollpw
in
1480 filledrect x (float (state
.winh
- (fstate
.fontsize
+ 4) - hscrollh))
1481 (x+.w) (float (state
.winh
- hscrollh))
1484 let w = float (wadjsb () + state
.winw
- 1) in
1485 if state
.progress
>= 0.0 && state
.progress
< 1.0
1487 GlDraw.color
(0.3, 0.3, 0.3);
1488 let w1 = w *. state
.progress
in
1490 GlDraw.color
(0.0, 0.0, 0.0);
1491 rect (float x0+.w1) (float x0+.w-.w1)
1494 GlDraw.color
(0.0, 0.0, 0.0);
1498 GlDraw.color
(1.0, 1.0, 1.0);
1499 drawstring fstate
.fontsize
1500 (if conf
.leftscroll
then x0 + 2 else x0 + if len > 0 then 8 else 2)
1501 (state
.winh
- hscrollh - 5) s;
1504 match state
.mode
with
1505 | Textentry
((prefix
, text, _
, _
, _
, _
), _
) ->
1509 Printf.sprintf
"%s%s_ [%s]" prefix
text state
.text
1511 Printf.sprintf
"%s%s_" prefix
text
1517 | LinkNav _
-> state
.text
1522 if not
(istextentry state
.mode
) && state
.uioh#eformsgs
1524 let s1 = "(press 'e' to review error messasges)" in
1525 if nonemptystr
s then s ^
" " ^
s1 else s1
1535 let len = Queue.length state
.tilelru
in
1537 match state
.throttle
with
1540 then preloadlayout state
.y
1542 | Some
(layout, _
, _
) ->
1546 if state
.memused
<= conf
.memlimit
1551 let (k
, p
, s) as lruitem
= Queue.pop state
.tilelru
in
1552 let n, gen
, colorspace
, angle
, pagew
, pageh
, col, row = k
in
1553 let (_
, pw, ph
, _
) = getpagedim
n in
1556 && colorspace
= conf
.colorspace
1557 && angle
= conf
.angle
1561 let x = col*conf
.tilew
1562 and y = row*conf
.tileh
in
1563 tilevisible (Lazy.force_val
layout) n x y
1565 then Queue.push lruitem state
.tilelru
1568 wcmd "freetile %s" (~
> p
);
1569 state
.memused
<- state
.memused
- s;
1570 state
.uioh#infochanged Memused
;
1571 Hashtbl.remove state
.tilemap k
;
1579 let logcurrently = function
1580 | Idle
-> dolog
"Idle"
1581 | Loading
(l, gen
) ->
1582 dolog
"Loading %d gen=%d curgen=%d" l.pageno gen state
.gen
1583 | Tiling
(l, pageopaque
, colorspace
, angle
, gen
, col, row, tilew
, tileh
) ->
1585 "Tiling %d[%d,%d] page=%s cs=%s angle"
1586 l.pageno
col row (~
> pageopaque
)
1587 (CSTE.to_string colorspace
)
1589 dolog
"gen=(%d,%d) (%d,%d) tile=(%d,%d) (%d,%d)"
1590 angle gen conf
.angle state
.gen
1592 conf
.tilew conf
.tileh
1599 let r = Str.regexp
" " in
1600 fun s -> Str.bounded_split
r s 2;
1603 let onpagerect pageno
f =
1605 match conf
.columns
with
1606 | Cmulti
(_
, b) -> b
1608 | Csplit
(_
, b) -> b
1610 if pageno
>= 0 && pageno
< Array.length
b
1612 let (_
, _
, _
, (w, h, _
, _
)) = b.(pageno
) in
1616 let gotopagexy1 pageno
x y =
1617 let _,w1,h1
,leftx
= getpagedim pageno
in
1618 let top = y /. (float h1
) in
1619 let left = x /. (float w1) in
1620 let py, w, h = getpageywh pageno
in
1621 let wh = state
.winh
- hscrollh () in
1622 let x = left *. (float w) in
1623 let x = leftx
+ state
.x + truncate
x in
1624 let wadj = wadjsb () in
1626 if x < 0 || x >= wadj + state
.winw
1630 let pdy = truncate
(top *. float h) in
1631 let y'
= py + pdy in
1632 let dy = y'
- state
.y in
1634 if x != state
.x || not
(dy > 0 && dy < wh)
1636 if conf
.presentation
1638 if abs
(py - y'
) > wh
1645 if state
.x != sx || state
.y != sy
1650 let ww = wadj + state
.winw
in
1652 and qy
= pdy / wh in
1654 and y = py + qy
* wh in
1655 let x = if -x + ww > w1 then -(w1-ww) else x
1656 and y'
= if y + wh > state
.maxy
then state
.maxy
- wh else y in
1658 if conf
.presentation
1660 if abs
(py - y'
) > wh
1670 gotoy_and_clear_text y;
1672 else gotoy_and_clear_text state
.y;
1675 let gotopagexy pageno
x y =
1676 match state
.mode
with
1677 | Birdseye
_ -> gotopage pageno
0.0
1680 | LinkNav
_ -> gotopagexy1 pageno
x y
1683 let getpassword () =
1684 let passcmd = getenvwithdef
"LLPP_ASKPASS" conf
.passcmd in
1688 match Unix.open_process_in
passcmd with
1689 | (exception exn
) ->
1692 "getpassword: open_process_in failed: %s" (exntos exn
));
1695 let s = try input_line ic
with End_of_file
-> E.s in
1697 match Unix.close_process_in ic
with
1698 | (exception exn
) ->
1700 (Printf.sprintf
"getpassword: close_process_in failed: %s"
1709 (* dolog "%S" cmds; *)
1710 let cl = splitatspace cmds
in
1712 try Scanf.sscanf
s fmt
f
1714 dolog
"error processing '%S': %s" cmds
(exntos exn
);
1717 let addoutline outline
=
1718 match state
.currently
with
1719 | Outlining outlines
->
1720 state
.currently
<- Outlining
(outline
:: outlines
)
1721 | Idle
-> state
.currently
<- Outlining
[outline
]
1724 dolog
"invalid outlining state";
1725 logcurrently state
.currently
1729 state
.uioh#infochanged Pdim
;
1732 | "clearrects" :: [] ->
1733 state
.rects
<- state
.rects1
;
1734 G.postRedisplay "clearrects";
1736 | "continue" :: args
:: [] ->
1737 let n = scan args
"%u" (fun n -> n) in
1738 state
.pagecount
<- n;
1739 begin match state
.currently
with
1741 state
.currently
<- Idle
;
1742 state
.outlines
<- Array.of_list
(List.rev
l)
1748 let cur, cmds
= state
.geomcmds
in
1750 then failwith
"umpossible";
1752 begin match List.rev cmds
with
1754 state
.geomcmds
<- E.s, [];
1755 state
.throttle
<- None
;
1759 state
.geomcmds
<- s, List.rev rest
;
1761 if conf
.maxwait
= None
&& not
!wtmode
1762 then G.postRedisplay "continue";
1764 | "msg" :: args
:: [] ->
1767 | "vmsg" :: args
:: [] ->
1769 then showtext ' ' args
1771 | "emsg" :: args
:: [] ->
1772 Buffer.add_string state
.errmsgs args
;
1773 state
.newerrmsgs
<- true;
1774 G.postRedisplay "error message"
1776 | "progress" :: args
:: [] ->
1777 let progress, text =
1780 f, String.sub args pos
(String.length args
- pos
))
1783 state
.progress <- progress;
1784 G.postRedisplay "progress"
1786 | "firstmatch" :: args
:: [] ->
1787 let pageno, c, x0, y0, x1, y1, x2
, y2
, x3
, y3
=
1788 scan args
"%u %d %f %f %f %f %f %f %f %f"
1789 (fun p
c x0 y0 x1 y1 x2 y2 x3 y3
->
1790 (p
, c, x0, y0, x1, y1, x2
, y2
, x3
, y3
))
1792 let xoff = float (xadjsb ()) in
1796 and x3
= x3
+. xoff in
1797 let y = (getpagey
pageno) + truncate
y0 in
1800 state
.rects1
<- [pageno, c, (x0, y0, x1, y1, x2
, y2
, x3
, y3
)]
1802 | "match" :: args
:: [] ->
1803 let pageno, c, x0, y0, x1, y1, x2
, y2
, x3
, y3
=
1804 scan args
"%u %d %f %f %f %f %f %f %f %f"
1805 (fun p
c x0 y0 x1 y1 x2 y2 x3 y3
->
1806 (p
, c, x0, y0, x1, y1, x2
, y2
, x3
, y3
))
1808 let xoff = float (xadjsb ()) in
1812 and x3
= x3
+. xoff in
1814 (pageno, c, (x0, y0, x1, y1, x2
, y2
, x3
, y3
)) :: state
.rects1
1816 | "page" :: args
:: [] ->
1817 let pageopaques, t
= scan args
"%s %f" (fun p t
-> p
, t
) in
1818 let pageopaque = ~
< pageopaques in
1819 begin match state
.currently
with
1820 | Loading
(l, gen
) ->
1821 vlog "page %d took %f sec" l.pageno t
;
1822 Hashtbl.replace state
.pagemap
(l.pageno, gen
) pageopaque;
1823 begin match state
.throttle
with
1825 let preloadedpages =
1827 then preloadlayout state
.y
1832 List.fold_left
(fun s l -> IntSet.add
l.pageno s)
1833 IntSet.empty
preloadedpages
1836 Hashtbl.fold (fun ((pageno, _) as key) opaque
accu ->
1837 if not
(IntSet.mem
pageno set)
1839 wcmd "freepage %s" (~
> opaque
);
1845 List.iter
(Hashtbl.remove state
.pagemap
) evictedpages;
1848 state
.currently
<- Idle
;
1851 tilepage l.pageno pageopaque state
.layout;
1853 load preloadedpages;
1854 let visible = pagevisible state
.layout l.pageno in
1857 match state
.mode
with
1858 | LinkNav
(Ltnotready
(pageno, dir
)) ->
1859 if pageno = l.pageno
1864 then LDfirstvisible
(l.pagex
, l.pagey, dir
)
1866 if dir
> 0 then LDfirst
else LDlast
1869 findlink
pageopaque ld
1874 showlinktype (getlink
pageopaque n);
1875 state
.mode
<- LinkNav
(Ltexact
(l.pageno, n))
1877 | LinkNav
(Ltgendir
_)
1878 | LinkNav
(Ltexact
_)
1884 if visible && layoutready state
.layout
1886 G.postRedisplay "page";
1890 | Some
(layout, _, _) ->
1891 state
.currently
<- Idle
;
1892 tilepage l.pageno pageopaque layout;
1899 dolog
"Inconsistent loading state";
1900 logcurrently state
.currently
;
1904 | "tile" :: args
:: [] ->
1905 let (x, y, opaques
, size
, t
) =
1906 scan args
"%u %u %s %u %f"
1907 (fun x y p size t
-> (x, y, p
, size
, t
))
1909 let opaque = ~
< opaques
in
1910 begin match state
.currently
with
1911 | Tiling
(l, pageopaque, cs
, angle
, gen
, col, row, tilew
, tileh
) ->
1912 vlog "tile %d [%d,%d] took %f sec" l.pageno col row t
;
1915 if tilew
!= conf
.tilew
|| tileh
!= conf
.tileh
1917 wcmd "freetile %s" (~
> opaque);
1918 state
.currently
<- Idle
;
1922 puttileopaque l col row gen cs angle
opaque size t
;
1923 state
.memused
<- state
.memused
+ size
;
1924 state
.uioh#infochanged Memused
;
1926 Queue.push
((l.pageno, gen
, cs
, angle
, l.pagew
, l.pageh
, col, row),
1927 opaque, size
) state
.tilelru
;
1930 match state
.throttle
with
1931 | None
-> state
.layout
1932 | Some
(layout, _, _) -> layout
1935 state
.currently
<- Idle
;
1937 && conf
.colorspace
= cs
1938 && conf
.angle
= angle
1939 && tilevisible layout l.pageno x y
1940 then conttiling l.pageno pageopaque;
1942 begin match state
.throttle
with
1944 preload state
.layout;
1946 && conf
.colorspace
= cs
1947 && conf
.angle
= angle
1948 && tilevisible state
.layout l.pageno x y
1949 && (not
!wtmode || layoutready state
.layout)
1950 then G.postRedisplay "tile nothrottle";
1952 | Some
(layout, y, _) ->
1953 let ready = layoutready layout in
1957 state
.layout <- layout;
1958 state
.throttle
<- None
;
1959 G.postRedisplay "throttle";
1968 dolog
"Inconsistent tiling state";
1969 logcurrently state
.currently
;
1973 | "pdim" :: args
:: [] ->
1974 let (n, w, h, _) as pdim
=
1975 scan args
"%u %u %u %u" (fun n w h x -> n, w, h, x)
1978 match conf
.fitmodel
with
1980 | FitPage
| FitProportional
->
1981 match conf
.columns
with
1982 | Csplit
_ -> (n, w, h, 0)
1983 | Csingle
_ | Cmulti
_ -> pdim
1985 state
.uioh#infochanged Pdim
;
1986 state
.pdims
<- pdim :: state
.pdims
1988 | "o" :: args
:: [] ->
1989 let (l, n, t
, h, pos
) =
1990 scan args
"%u %u %d %u %n"
1991 (fun l n t
h pos
-> l, n, t
, h, pos
)
1993 let s = String.sub args pos
(String.length args
- pos
) in
1994 addoutline (s, l, Oanchor
(n, float t
/. float h, 0.0))
1996 | "ou" :: args
:: [] ->
1997 let (l, len, pos
) = scan args
"%u %u %n" (fun l len pos
-> l, len, pos
) in
1998 let s = String.sub args pos
len in
1999 let pos2 = pos
+ len + 1 in
2000 let uri = String.sub args
pos2 (String.length args
- pos2) in
2001 addoutline (s, l, Ouri
uri)
2003 | "on" :: args
:: [] ->
2004 let (l, pos
) = scan args
"%u %n" (fun l pos
-> l, pos
) in
2005 let s = String.sub args pos
(String.length args
- pos
) in
2006 addoutline (s, l, Onone
)
2008 | "a" :: args
:: [] ->
2010 scan args
"%u %d %d" (fun n l t
-> n, l, t
)
2012 state
.reprf
<- (fun () -> gotopagexy n (float l) (float t
))
2014 | "info" :: args
:: [] ->
2015 let pos = nindex args '
\t'
in
2016 if pos >= 0 && String.sub args
0 pos = "Title"
2018 let s = String.sub args
(pos+1) @@ String.length args
- pos - 1 in
2021 state
.docinfo
<- (1, args
) :: state
.docinfo
2023 | "infoend" :: [] ->
2024 state
.uioh#infochanged Docinfo
;
2025 state
.docinfo
<- List.rev state
.docinfo
2029 then Wsi.settitle
"Wrong password";
2030 let password = getpassword () in
2032 then error
"document is password protected"
2033 else opendoc state
.path
password
2036 error
"unknown cmd `%S'" cmds
2041 let action = function
2042 | HCprev
-> cbget cb ~
-1
2043 | HCnext
-> cbget cb
1
2044 | HCfirst
-> cbget cb ~
-(cb
.rc)
2045 | HClast
-> cbget cb
(cb
.len - 1 - cb
.rc)
2046 and cancel
() = cb
.rc <- rc
2050 let search pattern forward
=
2051 match conf
.columns
with
2053 showtext '
!'
"searching does not work properly in split columns mode"
2056 if nonemptystr pattern
2059 match state
.layout with
2062 l.pageno, (l.pagey + if forward
then 0 else 0*l.pagevh)
2064 wcmd "search %d %d %d %d,%s\000"
2065 (btod conf
.icase
) pn py (btod forward
) pattern
;
2068 let intentry text key =
2070 if key >= 32 && key < 127
2076 let text = addchar text c in
2080 state
.text <- Printf.sprintf
"invalid char (%d, `%c')" key c;
2084 let linknentry text key =
2086 if key >= 32 && key < 127
2092 let text = addchar text c in
2096 state
.text <- Printf.sprintf
"invalid char (%d, `%c')" key c;
2104 let l = String.length
s in
2105 let rec loop pos n = if pos = l then n else
2106 let m = Char.code
s.[pos] - (if pos = 0 && l > 1 then 96 else 97) in
2107 loop (pos+1) (n*26 + m)
2110 let rec loop n = function
2113 match getopaque l.pageno with
2114 | None
-> loop n rest
2116 let m = getlinkcount
opaque in
2119 let under = getlink
opaque n in
2122 else loop (n-m) rest
2124 loop n state
.layout;
2128 let textentry text key =
2129 if key land 0xff00 = 0xff00
2131 else TEcont
(text ^ toutf8
key)
2134 let reqlayout angle fitmodel
=
2135 match state
.throttle
with
2137 if nogeomcmds state
.geomcmds
2138 then state
.anchor <- getanchor
();
2139 conf
.angle
<- angle
mod 360;
2142 match state
.mode
with
2143 | LinkNav
_ -> state
.mode
<- View
2148 conf
.fitmodel
<- fitmodel
;
2149 invalidate "reqlayout"
2151 wcmd "reqlayout %d %d %d"
2152 conf
.angle
(FMTE.to_int conf
.fitmodel
) (stateh state
.winh
)
2157 let settrim trimmargins trimfuzz
=
2158 if nogeomcmds state
.geomcmds
2159 then state
.anchor <- getanchor
();
2160 conf
.trimmargins
<- trimmargins
;
2161 conf
.trimfuzz
<- trimfuzz
;
2162 let x0, y0, x1, y1 = trimfuzz
in
2163 invalidate "settrim"
2165 wcmd "settrim %d %d %d %d %d" (btod conf
.trimmargins
) x0 y0 x1 y1);
2170 match state
.throttle
with
2172 let zoom = max
0.0001 zoom in
2173 if zoom <> conf
.zoom
2175 state
.prevzoom
<- (conf
.zoom, state
.x);
2177 reshape state
.winw state
.winh
;
2178 state
.text <- Printf.sprintf
"zoom is now %-5.2f" (zoom *. 100.0);
2181 | Some
(layout, y, started
) ->
2183 match conf
.maxwait
with
2187 let dt = now
() -. started
in
2195 let setcolumns mode columns coverA coverB
=
2196 state
.prevcolumns
<- Some
(conf
.columns
, conf
.zoom);
2200 then showtext '
!'
"split mode doesn't work in bird's eye"
2202 conf
.columns
<- Csplit
(-columns
, E.a);
2210 conf
.columns
<- Csingle
E.a;
2215 conf
.columns
<- Cmulti
((columns
, coverA
, coverB
), E.a);
2219 reshape state
.winw state
.winh
;
2222 let resetmstate () =
2223 state
.mstate
<- Mnone
;
2224 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
2227 let enterbirdseye () =
2228 let zoom = float conf
.thumbw
/. float state
.winw
in
2229 let birdseyepageno =
2230 let cy = state
.winh
/ 2 in
2234 let rec fold best
= function
2237 let d = cy - (l.pagedispy + l.pagevh/2)
2238 and dbest
= cy - (best
.pagedispy + best
.pagevh/2) in
2239 if abs
d < abs dbest
2246 state
.mode
<- Birdseye
(
2247 { conf
with zoom = conf
.zoom }, state
.x, birdseyepageno, -1, getanchor
()
2251 conf
.presentation
<- false;
2252 conf
.interpagespace
<- 10;
2253 conf
.hlinks
<- false;
2254 conf
.fitmodel
<- FitPage
;
2256 conf
.maxwait
<- None
;
2258 match conf
.beyecolumns
with
2261 Cmulti
((c, 0, 0), E.a)
2262 | None
-> Csingle
E.a
2266 state
.text <- Printf.sprintf
"birds eye mode on (zoom %3.1f%%)"
2271 reshape state
.winw state
.winh
;
2274 let leavebirdseye (c, leftx
, pageno, _, anchor) goback
=
2276 conf
.zoom <- c.zoom;
2277 conf
.presentation
<- c.presentation
;
2278 conf
.interpagespace
<- c.interpagespace
;
2279 conf
.maxwait
<- c.maxwait
;
2280 conf
.hlinks
<- c.hlinks
;
2281 conf
.fitmodel
<- c.fitmodel
;
2282 conf
.beyecolumns
<- (
2283 match conf
.columns
with
2284 | Cmulti
((c, _, _), _) -> Some
c
2286 | Csplit
_ -> failwith
"leaving bird's eye split mode"
2289 match c.columns
with
2290 | Cmulti
(c, _) -> Cmulti
(c, E.a)
2291 | Csingle
_ -> Csingle
E.a
2292 | Csplit
(c, _) -> Csplit
(c, E.a)
2296 state
.text <- Printf.sprintf
"birds eye mode off (zoom %3.1f%%)"
2299 reshape state
.winw state
.winh
;
2300 state
.anchor <- if goback
then anchor else (pageno, 0.0, 1.0);
2304 let togglebirdseye () =
2305 match state
.mode
with
2306 | Birdseye vals
-> leavebirdseye vals
true
2307 | View
-> enterbirdseye ()
2312 let upbirdseye incr
(conf
, leftx
, pageno, hooverpageno
, anchor) =
2313 let pageno = max
0 (pageno - incr
) in
2314 let rec loop = function
2315 | [] -> gotopage1 pageno 0
2316 | l :: _ when l.pageno = pageno ->
2317 if l.pagedispy >= 0 && l.pagey = 0
2318 then G.postRedisplay "upbirdseye"
2319 else gotopage1 pageno 0
2320 | _ :: rest
-> loop rest
2324 state
.mode
<- Birdseye
(conf
, leftx
, pageno, hooverpageno
, anchor)
2327 let downbirdseye incr
(conf
, leftx
, pageno, hooverpageno
, anchor) =
2328 let pageno = min
(state
.pagecount
- 1) (pageno + incr
) in
2329 state
.mode
<- Birdseye
(conf
, leftx
, pageno, hooverpageno
, anchor);
2330 let rec loop = function
2332 let y, h = getpageyh
pageno in
2333 let dy = (y - state
.y) - (state
.winh
- h - conf
.interpagespace
) in
2335 | l :: _ when l.pageno = pageno ->
2336 if l.pagevh != l.pageh
2337 then gotoy (clamp (l.pageh
- l.pagevh + conf
.interpagespace
))
2338 else G.postRedisplay "downbirdseye"
2339 | _ :: rest
-> loop rest
2345 let boundastep h step
=
2347 then bound step ~
-h 0
2351 let optentry mode
_ key =
2352 let btos b = if b then "on" else "off" in
2353 if key >= 32 && key < 127
2355 let c = Char.chr
key in
2359 try conf
.scrollstep
<- int_of_string
s with exc
->
2360 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2362 TEswitch
("scroll step: ", E.s, None
, intentry, ondone, true)
2367 conf
.autoscrollstep
<- boundastep state
.winh
(int_of_string
s);
2368 if state
.autoscroll
<> None
2369 then state
.autoscroll
<- Some conf
.autoscrollstep
2371 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2373 TEswitch
("auto scroll step: ", E.s, None
, intentry, ondone, true)
2378 let n, a, b = multicolumns_of_string
s in
2379 setcolumns mode
n a b;
2381 state
.text <- Printf.sprintf
"bad columns `%s': %s" s (exntos exc
)
2383 TEswitch
("columns: ", E.s, None
, textentry, ondone, true)
2388 let zoom = float (int_of_string
s) /. 100.0 in
2391 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2393 TEswitch
("zoom: ", E.s, None
, intentry, ondone, true)
2398 conf
.thumbw
<- bound
(int_of_string
s) 2 4096;
2400 Printf.sprintf
"thumbnail width is set to %d" conf
.thumbw
;
2401 begin match mode
with
2403 leavebirdseye beye
false;
2410 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2412 TEswitch
("thumbnail width: ", E.s, None
, intentry, ondone, true)
2417 Some
(int_of_string
s)
2419 state
.text <- Printf.sprintf
"bad integer `%s': %s"
2423 | Some angle
-> reqlayout angle conf
.fitmodel
2426 TEswitch
("rotation: ", E.s, None
, intentry, ondone, true)
2429 conf
.icase
<- not conf
.icase
;
2430 TEdone
("case insensitive search " ^
(btos conf
.icase
))
2433 conf
.preload <- not conf
.preload;
2435 TEdone
("preload " ^
(btos conf
.preload))
2438 conf
.verbose
<- not conf
.verbose
;
2439 TEdone
("verbose " ^
(btos conf
.verbose
))
2442 conf
.debug
<- not conf
.debug
;
2443 TEdone
("debug " ^
(btos conf
.debug
))
2446 conf
.maxhfit
<- not conf
.maxhfit
;
2447 state
.maxy
<- calcheight
();
2448 TEdone
("maxhfit " ^
(btos conf
.maxhfit
))
2451 conf
.crophack
<- not conf
.crophack
;
2452 TEdone
("crophack " ^
btos conf
.crophack
)
2456 match conf
.maxwait
with
2458 conf
.maxwait
<- Some infinity
;
2459 "always wait for page to complete"
2461 conf
.maxwait
<- None
;
2462 "show placeholder if page is not ready"
2467 conf
.underinfo
<- not conf
.underinfo
;
2468 TEdone
("underinfo " ^
btos conf
.underinfo
)
2471 conf
.savebmarks
<- not conf
.savebmarks
;
2472 TEdone
("persistent bookmarks " ^
btos conf
.savebmarks
)
2478 match state
.layout with
2483 conf
.interpagespace
<- int_of_string
s;
2484 docolumns conf
.columns
;
2485 state
.maxy
<- calcheight
();
2486 let y = getpagey
pageno in
2489 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2491 TEswitch
("vertical margin: ", E.s, None
, intentry, ondone, true)
2495 match conf
.fitmodel
with
2496 | FitProportional
-> FitWidth
2497 | FitWidth
| FitPage
-> FitProportional
2499 reqlayout conf
.angle
fm;
2500 TEdone
("proportional display " ^
btos (fm == FitProportional
))
2503 settrim (not conf
.trimmargins
) conf
.trimfuzz
;
2504 TEdone
("trim margins " ^
btos conf
.trimmargins
)
2507 conf
.invert
<- not conf
.invert
;
2508 TEdone
("invert colors " ^
btos conf
.invert
)
2512 cbput state
.hists
.sel
s;
2515 TEswitch
("selection command: ", E.s, Some
(onhist state
.hists
.sel
),
2516 textentry, ondone, true)
2520 then conf
.pax
<- Some
(ref (0.0, 0, 0))
2521 else conf
.pax
<- None
;
2522 TEdone
("PAX " ^
btos (conf
.pax
!= None
))
2525 state
.text <- Printf.sprintf
"bad option %d `%c'" key c;
2531 class type lvsource
= object
2532 method getitemcount
: int
2533 method getitem
: int -> (string * int)
2534 method hasaction
: int -> bool
2542 method getactive
: int
2543 method getfirst
: int
2545 method getminfo
: (int * int) array
2548 class virtual lvsourcebase
= object
2549 val mutable m_active
= 0
2550 val mutable m_first
= 0
2551 val mutable m_pan
= 0
2552 method getactive
= m_active
2553 method getfirst
= m_first
2554 method getpan
= m_pan
2555 method getminfo
: (int * int) array
= E.a
2558 let withoutlastutf8 s =
2559 let len = String.length
s in
2567 let b = Char.code
s.[pos] in
2568 if b land 0b11000000 = 0b11000000
2573 if Char.code
s.[len-1] land 0x80 = 0
2577 String.sub
s 0 first;
2580 let textentrykeyboard
2581 key _mask
((c, text, opthist
, onkey
, ondone, cancelonempty
), onleave
) =
2583 if key >= 0xffb0 && key <= 0xffb9
2584 then key - 0xffb0 + 48 else key
2587 state
.mode
<- Textentry
(te
, onleave
);
2590 G.postRedisplay "textentrykeyboard enttext";
2592 let histaction cmd
=
2595 | Some
(action, _) ->
2596 state
.mode
<- Textentry
(
2597 (c, action cmd
, opthist
, onkey
, ondone, cancelonempty
), onleave
2599 G.postRedisplay "textentry histaction"
2603 if emptystr
text && cancelonempty
2606 G.postRedisplay "textentrykeyboard after cancel";
2609 let s = withoutlastutf8 text in
2610 enttext (c, s, opthist
, onkey
, ondone, cancelonempty
)
2612 | @enter
| @kpenter
->
2615 G.postRedisplay "textentrykeyboard after confirm"
2617 | @up
| @kpup
-> histaction HCprev
2618 | @down
| @kpdown
-> histaction HCnext
2619 | @home
| @kphome
-> histaction HCfirst
2620 | @jend
| @kpend
-> histaction HClast
2625 begin match opthist
with
2627 | Some
(_, onhistcancel
) -> onhistcancel
()
2631 G.postRedisplay "textentrykeyboard after cancel2"
2634 enttext (c, E.s, opthist
, onkey
, ondone, cancelonempty
)
2637 | @delete
| @kpdelete
-> ()
2640 && key land 0xff00 != 0xff00 (* keyboard *)
2641 && key land 0xfe00 != 0xfe00 (* xkb *)
2642 && key land 0xfd00 != 0xfd00 (* 3270 *)
2644 begin match onkey
text key with
2648 G.postRedisplay "textentrykeyboard after confirm2";
2651 enttext (c, text, opthist
, onkey
, ondone, cancelonempty
);
2655 G.postRedisplay "textentrykeyboard after cancel3"
2658 state
.mode
<- Textentry
(te
, onleave
);
2659 G.postRedisplay "textentrykeyboard switch";
2663 vlog "unhandled key %s" (Wsi.keyname
key)
2666 let firstof first active
=
2667 if first > active
|| abs
(first - active
) > fstate
.maxrows
- 1
2668 then max
0 (active
- (fstate
.maxrows
/2))
2672 let calcfirst first active
=
2675 let rows = active
- first in
2676 if rows > fstate
.maxrows
then active
- fstate
.maxrows
else first
2680 let scrollph y maxy
=
2681 let sh = float (maxy
+ state
.winh
) /. float state
.winh
in
2682 let sh = float state
.winh
/. sh in
2683 let sh = max
sh (float conf
.scrollh
) in
2685 let percent = float y /. float maxy
in
2686 let position = (float state
.winh
-. sh) *. percent in
2689 if position +. sh > float state
.winh
2690 then float state
.winh
-. sh
2696 let coe s = (s :> uioh
);;
2698 class listview ~zebra ~helpmode ~
(source
:lvsource
) ~trusted ~modehash
=
2700 val m_pan
= source#getpan
2701 val m_first
= source#getfirst
2702 val m_active
= source#getactive
2704 val m_prev_uioh
= state
.uioh
2706 method private elemunder
y =
2710 let n = y / (fstate
.fontsize
+1) in
2711 if m_first
+ n < source#getitemcount
2713 if source#hasaction
(m_first
+ n)
2714 then Some
(m_first
+ n)
2721 GlFunc.blend_func ~src
:`src_alpha ~dst
:`one_minus_src_alpha
;
2722 GlDraw.color
(0., 0., 0.) ~alpha
:0.85;
2723 filledrect 0. 0. (float state
.winw
) (float state
.winh
);
2724 GlDraw.color
(1., 1., 1.);
2725 Gl.enable `texture_2d
;
2726 let fs = fstate
.fontsize
in
2728 let hw = (wadjsb () + xadjsb () + state
.winw
)/3 in
2729 let ww = fstate
.wwidth
in
2730 let tabw = 17.0*.ww in
2731 let itemcount = source#getitemcount
in
2732 let minfo = source#getminfo
in
2735 then float (xadjsb ()), float (state
.winw
- 1)
2736 else 0.0, float (state
.winw
- conf
.scrollbw
- 1)
2738 let xadj = xadjsb () in
2740 if (row - m_first
) > fstate
.maxrows
2743 if row >= 0 && row < itemcount
2745 let (s, level
) = source#getitem
row in
2746 let y = (row - m_first
) * nfs in
2748 (if conf
.leftscroll
then float xadj else 5.0)
2749 +. (float (level
+ m_pan
)) *. ww in
2752 (let c = if row land 1 = 0 then 1.0 else 0.92 in (c,c,c));
2756 Gl.disable `texture_2d
;
2757 let alpha = if source#hasaction
row then 0.9 else 0.3 in
2758 GlDraw.color
(1., 1., 1.) ~
alpha;
2759 linerect (x0 +. 1.) (float (y + 1)) (x1) (float (y + fs + 3));
2760 Gl.enable `texture_2d
;
2763 if zebra
&& row land 1 = 1
2767 GlDraw.color
(c,c,c);
2768 let drawtabularstring s =
2770 let x'
= truncate
(x0 +. x) in
2771 let pos = nindex
s '
\000'
in
2773 then drawstring1 fs x'
(y+nfs) s
2775 let s1 = String.sub
s 0 pos
2776 and s2
= String.sub
s (pos+1) (String.length
s - pos - 1) in
2781 let s'
= withoutlastutf8 s in
2782 let s = s' ^
"@Uellipsis" in
2783 let w = measurestr
fs s in
2784 if float x'
+. w +. ww < float (hw + x'
)
2789 if float x'
+. ww +. measurestr
fs s1 > float (hw + x'
)
2793 ignore
(drawstring1 fs x'
(y+nfs) s1);
2794 drawstring1 fs (hw + x'
) (y+nfs) s2
2798 let x = if helpmode
&& row > 0 then x +. ww else x in
2799 let tabpos = nindex
s '
\t'
in
2802 let len = String.length
s - tabpos - 1 in
2803 let s1 = String.sub
s 0 tabpos
2804 and s2
= String.sub
s (tabpos + 1) len in
2805 let nx = drawstr x s1 in
2807 let x = x +. (max
tabw sw) in
2810 let len = String.length
s - 2 in
2811 if len > 0 && s.[0] = '
\xc2'
&& s.[1] = '
\xb7'
2813 let s = String.sub
s 2 len in
2814 let x = if not helpmode
then x +. ww else x in
2815 GlDraw.color
(1.2, 1.2, 1.2);
2816 let vinc = drawstring1 (fs+fs/4)
2817 (truncate
(x -. ww)) (y+nfs) s in
2818 GlDraw.color
(1., 1., 1.);
2819 vinc +. (float fs *. 0.8)
2825 ignore
(drawtabularstring s);
2831 GlDraw.color
(1.0, 1.0, 1.0) ~
alpha:0.5;
2832 let xadj = float (xadjsb () + 5) in
2834 if (row - m_first
) > fstate
.maxrows
2837 if row >= 0 && row < itemcount
2839 let (s, level
) = source#getitem
row in
2840 let pos0 = nindex
s '
\000'
in
2841 let y = (row - m_first
) * nfs in
2842 let x = float (level
+ m_pan
) *. ww in
2843 let (first, last
) = minfo.(row) in
2845 if pos0 > 0 && first > pos0
2846 then String.sub
s (pos0+1) (first-pos0-1)
2847 else String.sub
s 0 first
2849 let suffix = String.sub
s first (last
- first) in
2850 let w1 = measurestr fstate
.fontsize
prefix in
2851 let w2 = measurestr fstate
.fontsize
suffix in
2852 let x = x +. if conf
.leftscroll
then xadj else 5.0 in
2853 let x = if pos0 > 0 && first > pos0 then x +. float hw else x in
2855 and y0 = float (y+2) in
2857 and y1 = float (y+fs+3) in
2858 filledrect x0 y0 x1 y1;
2863 Gl.disable `texture_2d
;
2864 if Array.length
minfo > 0 then loop m_first
;
2867 method updownlevel incr
=
2868 let len = source#getitemcount
in
2870 if m_active
>= 0 && m_active
< len
2871 then snd
(source#getitem m_active
)
2875 if i
= len then i
-1 else if i
= -1 then 0 else
2876 let _, l = source#getitem i
in
2877 if l != curlevel then i
else flow (i
+incr
)
2879 let active = flow m_active
in
2880 let first = calcfirst m_first
active in
2881 G.postRedisplay "outline updownlevel";
2882 {< m_active
= active; m_first
= first >}
2884 method private key1
key mask
=
2885 let set1 active first qsearch
=
2886 coe {< m_active
= active; m_first
= first; m_qsearch
= qsearch
>}
2888 let search active pattern incr
=
2889 let active = if active = -1 then m_first
else active in
2892 if n >= 0 && n < source#getitemcount
2894 let s, _ = source#getitem
n in
2896 (try ignore
(Str.search_forward re
s 0); true
2897 with Not_found
-> false)
2899 else loop (n + incr
)
2906 let re = Str.regexp_case_fold pattern
in
2912 let itemcount = source#getitemcount
in
2913 let find start incr
=
2915 if i
= -1 || i
= itemcount
2918 if source#hasaction i
2920 else find (i
+ incr
)
2925 let set active first =
2926 let first = bound
first 0 (itemcount - fstate
.maxrows
) in
2928 coe {< m_active
= active; m_first
= first; m_qsearch
= E.s >}
2931 let isvisible first n = n >= first && n - first <= fstate
.maxrows
in
2933 let incr1 = if incr
> 0 then 1 else -1 in
2934 if isvisible m_first m_active
2937 let next = m_active
+ incr
in
2939 if next < 0 || next >= itemcount
2941 else find next incr1
2943 if abs
(m_active
- next) > fstate
.maxrows
2949 let first = m_first
+ incr
in
2950 let first = bound
first 0 (itemcount - fstate
.maxrows
) in
2952 let next = m_active
+ incr
in
2953 let next = bound
next 0 (itemcount - 1) in
2960 if isvisible first next
2967 let first = min
next m_first
in
2969 if abs
(next - first) > fstate
.maxrows
2975 let first = m_first
+ incr
in
2976 let first = bound
first 0 (itemcount - 1) in
2978 let next = m_active
+ incr
in
2979 let next = bound
next 0 (itemcount - 1) in
2980 let next = find next incr1 in
2982 if next = -1 || abs
(m_active
- first) > fstate
.maxrows
2984 let active = if m_active
= -1 then next else m_active
in
2989 if isvisible first active
2995 G.postRedisplay "listview navigate";
2999 | (@r|@s) when Wsi.withctrl mask
->
3000 let incr = if key = @r then -1 else 1 in
3002 match search (m_active
+ incr) m_qsearch
incr with
3004 state
.text <- m_qsearch ^
" [not found]";
3007 state
.text <- m_qsearch
;
3008 active, firstof m_first
active
3010 G.postRedisplay "listview ctrl-r/s";
3011 set1 active first m_qsearch
;
3013 | @insert
when Wsi.withctrl mask
->
3014 if m_active
>= 0 && m_active
< source#getitemcount
3016 let s, _ = source#getitem m_active
in
3022 if emptystr m_qsearch
3025 let qsearch = withoutlastutf8 m_qsearch
in
3029 G.postRedisplay "listview empty qsearch";
3030 set1 m_active m_first
E.s;
3034 match search m_active
qsearch ~
-1 with
3036 state
.text <- qsearch ^
" [not found]";
3039 state
.text <- qsearch;
3040 active, firstof m_first
active
3042 G.postRedisplay "listview backspace qsearch";
3043 set1 active first qsearch
3046 | key when (key != 0 && key land 0xff00 != 0xff00) ->
3047 let pattern = m_qsearch ^ toutf8
key in
3049 match search m_active
pattern 1 with
3051 state
.text <- pattern ^
" [not found]";
3054 state
.text <- pattern;
3055 active, firstof m_first
active
3057 G.postRedisplay "listview qsearch add";
3058 set1 active first pattern;
3062 if emptystr m_qsearch
3064 G.postRedisplay "list view escape";
3067 source#exit ~uioh
:(coe self
)
3068 ~cancel
:true ~
active:m_active ~
first:m_first ~pan
:m_pan
3070 | None
-> m_prev_uioh
3075 G.postRedisplay "list view kill qsearch";
3076 coe {< m_qsearch
= E.s >}
3079 | @enter
| @kpenter
->
3081 let self = {< m_qsearch
= E.s >} in
3083 G.postRedisplay "listview enter";
3084 if m_active
>= 0 && m_active
< source#getitemcount
3086 source#exit ~uioh
:(coe self) ~cancel
:false
3087 ~
active:m_active ~
first:m_first ~pan
:m_pan
;
3090 source#exit ~uioh
:(coe self) ~cancel
:true
3091 ~
active:m_active ~
first:m_first ~pan
:m_pan
;
3094 begin match opt with
3095 | None
-> m_prev_uioh
3099 | @delete
| @kpdelete
->
3102 | @up
| @kpup
-> navigate ~
-1
3103 | @down
| @kpdown
-> navigate 1
3104 | @prior
| @kpprior
-> navigate ~
-(fstate
.maxrows
)
3105 | @next | @kpnext
-> navigate fstate
.maxrows
3107 | @right
| @kpright
->
3109 G.postRedisplay "listview right";
3110 coe {< m_pan
= m_pan
- 1 >}
3112 | @left | @kpleft
->
3114 G.postRedisplay "listview left";
3115 coe {< m_pan
= m_pan
+ 1 >}
3117 | @home
| @kphome
->
3118 let active = find 0 1 in
3119 G.postRedisplay "listview home";
3123 let first = max
0 (itemcount - fstate
.maxrows
) in
3124 let active = find (itemcount - 1) ~
-1 in
3125 G.postRedisplay "listview end";
3128 | key when (key = 0 || key land 0xff00 = 0xff00) ->
3132 dolog
"listview unknown key %#x" key; coe self
3134 method key key mask
=
3135 match state
.mode
with
3136 | Textentry te
-> textentrykeyboard key mask te
; coe self
3139 | LinkNav
_ -> self#key1
key mask
3141 method button button down
x y _ =
3144 | 1 when x > state
.winw
- conf
.scrollbw
->
3145 G.postRedisplay "listview scroll";
3148 let _, position, sh = self#
scrollph in
3149 if y > truncate
position && y < truncate
(position +. sh)
3151 state
.mstate
<- Mscrolly
;
3155 let s = float (max
0 (y - conf
.scrollh
)) /. float state
.winh
in
3156 let first = truncate
(s *. float source#getitemcount
) in
3157 let first = min source#getitemcount
first in
3158 Some
(coe {< m_first
= first; m_active
= first >})
3160 state
.mstate
<- Mnone
;
3164 begin match self#elemunder
y with
3166 G.postRedisplay "listview click";
3167 source#exit ~uioh
:(coe {< m_active
= n >})
3168 ~cancel
:false ~
active:n ~
first:m_first ~pan
:m_pan
3172 | n when (n == 4 || n == 5) && not down
->
3173 let len = source#getitemcount
in
3175 if n = 5 && m_first
+ fstate
.maxrows
>= len
3179 let first = m_first
+ (if n == 4 then -1 else 1) in
3180 bound
first 0 (len - 1)
3182 G.postRedisplay "listview wheel";
3183 Some
(coe {< m_first
= first >})
3184 | n when (n = 6 || n = 7) && not down
->
3185 let inc = if n = 7 then -1 else 1 in
3186 G.postRedisplay "listview hwheel";
3187 Some
(coe {< m_pan
= m_pan
+ inc >})
3192 | None
-> m_prev_uioh
3195 method multiclick
_ x y = self#button
1 true x y
3198 match state
.mstate
with
3200 let s = float (max
0 (y - conf
.scrollh
)) /. float state
.winh
in
3201 let first = truncate
(s *. float source#getitemcount
) in
3202 let first = min source#getitemcount
first in
3203 G.postRedisplay "listview motion";
3204 coe {< m_first
= first; m_active
= first >}
3212 method pmotion
x y =
3213 if x < state
.winw
- conf
.scrollbw
3216 match self#elemunder
y with
3217 | None
-> Wsi.setcursor
Wsi.CURSOR_INHERIT
; m_active
3218 | Some
n -> Wsi.setcursor
Wsi.CURSOR_INFO
; n
3222 then (G.postRedisplay "listview pmotion"; {< m_active
= n >})
3227 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
3231 method infochanged
_ = ()
3233 method scrollpw
= (0, 0.0, 0.0)
3235 let nfs = fstate
.fontsize
+ 1 in
3236 let y = m_first
* nfs in
3237 let itemcount = source#getitemcount
in
3238 let maxi = max
0 (itemcount - fstate
.maxrows
) in
3239 let maxy = maxi * nfs in
3240 let p, h = scrollph y maxy in
3243 method modehash
= modehash
3244 method eformsgs
= false
3245 method alwaysscrolly
= true
3248 class outlinelistview ~zebra ~source
=
3249 let settext autonarrow
s =
3252 let ss = source#statestr
in
3256 else "{" ^
ss ^
"} [" ^
s ^
"]"
3257 else state
.text <- s
3263 ~source
:(source
:> lvsource
)
3265 ~modehash
:(findkeyhash conf
"outline")
3268 val m_autonarrow
= false
3270 method! key key mask
=
3272 if emptystr state
.text
3274 else fstate
.maxrows - 2
3276 let calcfirst first active =
3279 let rows = active - first in
3280 if rows > maxrows then active - maxrows else first
3284 let active = m_active
+ incr in
3285 let active = bound
active 0 (source#getitemcount
- 1) in
3286 let first = calcfirst m_first
active in
3287 G.postRedisplay "outline navigate";
3288 coe {< m_active
= active; m_first
= first >}
3290 let navscroll first =
3292 let dist = m_active
- first in
3298 else first + maxrows
3301 G.postRedisplay "outline navscroll";
3302 coe {< m_first
= first; m_active
= active >}
3304 let ctrl = Wsi.withctrl mask
in
3309 then (source#denarrow
; E.s)
3311 let pattern = source#renarrow
in
3312 if nonemptystr m_qsearch
3313 then (source#narrow m_qsearch
; m_qsearch
)
3317 settext (not m_autonarrow
) text;
3318 G.postRedisplay "toggle auto narrowing";
3319 coe {< m_first
= 0; m_active
= 0; m_autonarrow
= not m_autonarrow
>}
3321 | @slash
when emptystr m_qsearch
&& not m_autonarrow
->
3323 G.postRedisplay "toggle auto narrowing";
3324 coe {< m_first
= 0; m_active
= 0; m_autonarrow
= true >}
3327 source#narrow m_qsearch
;
3329 then source#add_narrow_pattern m_qsearch
;
3330 G.postRedisplay "outline ctrl-n";
3331 coe {< m_first
= 0; m_active
= 0 >}
3334 let active = source#calcactive
(getanchor
()) in
3335 let first = firstof m_first
active in
3336 G.postRedisplay "outline ctrl-s";
3337 coe {< m_first
= first; m_active
= active >}
3340 G.postRedisplay "outline ctrl-u";
3341 if m_autonarrow
&& nonemptystr m_qsearch
3343 ignore
(source#renarrow
);
3344 settext m_autonarrow
E.s;
3345 coe {< m_first
= 0; m_active
= 0; m_qsearch
= E.s >}
3348 source#del_narrow_pattern
;
3349 let pattern = source#renarrow
in
3351 if emptystr
pattern then E.s else "Narrowed to " ^
pattern
3353 settext m_autonarrow
text;
3354 coe {< m_first
= 0; m_active
= 0; m_qsearch
= E.s >}
3358 let first = max
0 (m_active
- (fstate
.maxrows / 2)) in
3359 G.postRedisplay "outline ctrl-l";
3360 coe {< m_first
= first >}
3362 | @tab
when m_autonarrow
->
3363 if nonemptystr m_qsearch
3365 G.postRedisplay "outline list view tab";
3366 source#add_narrow_pattern m_qsearch
;
3368 coe {< m_qsearch
= E.s >}
3372 | @escape
when m_autonarrow
->
3373 if nonemptystr m_qsearch
3374 then source#add_narrow_pattern m_qsearch
;
3377 | @enter
| @kpenter
when m_autonarrow
->
3378 if nonemptystr m_qsearch
3379 then source#add_narrow_pattern m_qsearch
;
3382 | key when m_autonarrow
&& (key != 0 && key land 0xff00 != 0xff00) ->
3383 let pattern = m_qsearch ^ toutf8
key in
3384 G.postRedisplay "outlinelistview autonarrow add";
3385 source#narrow
pattern;
3386 settext true pattern;
3387 coe {< m_first
= 0; m_active
= 0; m_qsearch
= pattern >}
3389 | key when m_autonarrow
&& key = @backspace
->
3390 if emptystr m_qsearch
3393 let pattern = withoutlastutf8 m_qsearch
in
3394 G.postRedisplay "outlinelistview autonarrow backspace";
3395 ignore
(source#renarrow
);
3396 source#narrow
pattern;
3397 settext true pattern;
3398 coe {< m_first
= 0; m_active
= 0; m_qsearch
= pattern >}
3400 | @delete
| @kpdelete
->
3401 source#remove m_active
;
3402 G.postRedisplay "outline delete";
3403 let active = max
0 (m_active
-1) in
3404 coe {< m_first
= firstof m_first
active;
3405 m_active
= active >}
3407 | @up
| @kpup
when ctrl ->
3408 navscroll (max
0 (m_first
- 1))
3410 | @down
| @kpdown
when ctrl ->
3411 navscroll (min
(source#getitemcount
- 1) (m_first
+ 1))
3413 | @up
| @kpup
-> navigate ~
-1
3414 | @down
| @kpdown
-> navigate 1
3415 | @prior
| @kpprior
-> navigate ~
-(fstate
.maxrows)
3416 | @next | @kpnext
-> navigate fstate
.maxrows
3418 | @right
| @kpright
->
3422 G.postRedisplay "outline ctrl right";
3423 {< m_pan
= m_pan
+ 1 >}
3425 else self#updownlevel
1
3429 | @left | @kpleft
->
3433 G.postRedisplay "outline ctrl left";
3434 {< m_pan
= m_pan
- 1 >}
3436 else self#updownlevel ~
-1
3440 | @home
| @kphome
->
3441 G.postRedisplay "outline home";
3442 coe {< m_first
= 0; m_active
= 0 >}
3445 let active = source#getitemcount
- 1 in
3446 let first = max
0 (active - fstate
.maxrows) in
3447 G.postRedisplay "outline end";
3448 coe {< m_active
= active; m_first
= first >}
3450 | _ -> super#
key key mask
3453 let genhistoutlines =
3454 let order ty
(p1
, c1
, _, _, _) (p2
, c2
, _, _, _) =
3456 | `lastvisit
-> compare c1
.lastvisit c2
.lastvisit
3457 | `path
-> compare p2 p1
3458 | `file
-> compare
(Filename.basename p2
) (Filename.basename p1
)
3460 let e1 = emptystr c1
.title
3461 and e2
= emptystr c2
.title
in
3463 then compare
(Filename.basename p2
) (Filename.basename p1
)
3466 else compare c1
.title c2
.title
3468 let showfullpath = ref false in
3471 let s = if orderty
= t
then "[@Uradical] " ^
s else "[ ] " ^
s in
3472 s, 0, Oaction
(fun () -> Config.historder
:= t
; reeenterhist := true)
3474 let list = ref [] in
3475 if Config.gethist
list
3479 (fun accu (path
, c, b, x, a) ->
3480 let hist = (path
, (c, b, x, a)) in
3481 let s = if !showfullpath then path
else Filename.basename path
in
3482 let base = mbtoutf8
s in
3483 (base ^
"\000" ^
c.title
, 1, Ohistory
hist) :: accu
3485 [ setorty "Sort by time of last visit" `lastvisit
;
3486 setorty "Sort by file name" `file
;
3487 setorty "Sort by path" `path
;
3488 setorty "Sort by title" `title
;
3489 (if !showfullpath then "@Uradical "
3490 else " ") ^
"Show full path", 0, Oaction
(fun () ->
3491 showfullpath := not
!showfullpath; reeenterhist := true)
3492 ] (List.sort
(order orderty
) !list)
3498 let gotohist (path
, (c, bookmarks
, x, anchor)) =
3499 Config.save
leavebirdseye;
3500 state
.anchor <- anchor;
3502 state
.bookmarks
<- bookmarks
;
3503 state
.origin
<- E.s;
3505 let x0, y0, x1, y1 = conf
.trimfuzz
in
3506 wcmd "trimset %d %d %d %d %d" (btod conf
.trimmargins
) x0 y0 x1 y1;
3510 let makecheckers () =
3511 (* Based on lablGL-1.04/LablGlut/examples/lablGL/checker.ml which had
3513 converted by Issac Trotts. July 25, 2002 *)
3514 let image = GlPix.create `ubyte ~format
:`luminance ~width
:2 ~height
:2 in
3515 Raw.sets_string
(GlPix.to_raw
image) ~
pos:0 "\255\200\200\255";
3516 let id = GlTex.gen_texture
() in
3517 GlTex.bind_texture ~target
:`texture_2d
id;
3518 GlPix.store
(`unpack_alignment
1);
3519 GlTex.image2d
image;
3520 List.iter
(GlTex.parameter ~target
:`texture_2d
)
3521 [ `mag_filter `nearest
; `min_filter `nearest
];
3525 let setcheckers enabled
=
3526 match state
.checkerstexid
with
3528 if enabled
then state
.checkerstexid
<- Some
(makecheckers ())
3530 | Some checkerstexid
->
3533 GlTex.delete_texture checkerstexid
;
3534 state
.checkerstexid
<- None
;
3538 let describe_location () =
3539 let fn = page_of_y state
.y in
3540 let ln = page_of_y
(state
.y + state
.winh
- hscrollh () - 1) in
3541 let maxy = state
.maxy - (if conf
.maxhfit
then state
.winh
else 0) in
3545 else (100. *. (float state
.y /. float maxy))
3549 Printf.sprintf
"page %d of %d [%.2f%%]"
3550 (fn+1) state
.pagecount
percent
3553 "pages %d-%d of %d [%.2f%%]"
3554 (fn+1) (ln+1) state
.pagecount
percent
3557 let setpresentationmode v
=
3558 let n = page_of_y state
.y in
3559 state
.anchor <- (n, 0.0, 1.0);
3560 conf
.presentation
<- v
;
3561 if conf
.fitmodel
= FitPage
3562 then reqlayout conf
.angle conf
.fitmodel
;
3567 let btos b = if b then "@Uradical" else E.s in
3568 let showextended = ref false in
3569 let leave mode
_ = state
.mode
<- mode
in
3572 val mutable m_first_time
= true
3573 val mutable m_l
= []
3574 val mutable m_a
= E.a
3575 val mutable m_prev_uioh
= nouioh
3576 val mutable m_prev_mode
= View
3578 inherit lvsourcebase
3580 method reset prev_mode prev_uioh
=
3581 m_a
<- Array.of_list
(List.rev m_l
);
3583 m_prev_mode
<- prev_mode
;
3584 m_prev_uioh
<- prev_uioh
;
3588 if n >= Array.length m_a
3592 | _, _, _, Action
_ -> m_active
<- n
3593 | _, _, _, Noaction
-> loop (n+1)
3596 m_first_time
<- false;
3599 method int name get
set =
3601 (name
, `
int get
, 1, Action
(
3604 try set (int_of_string
s)
3606 state
.text <- Printf.sprintf
"bad integer `%s': %s"
3610 let te = name ^
": ", E.s, None
, intentry, ondone, true in
3611 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3615 method int_with_suffix name get
set =
3617 (name
, `intws get
, 1, Action
(
3620 try set (int_of_string_with_suffix
s)
3622 state
.text <- Printf.sprintf
"bad integer `%s': %s"
3627 name ^
": ", E.s, None
, intentry_with_suffix, ondone, true
3629 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3633 method bool ?
(offset
=1) ?
(btos=btos) name get
set =
3635 (name
, `
bool (btos, get
), offset
, Action
(
3642 method color name get
set =
3644 (name
, `color get
, 1, Action
(
3646 let invalid = (nan
, nan
, nan
) in
3649 try color_of_string
s
3651 state
.text <- Printf.sprintf
"bad color `%s': %s"
3658 let te = name ^
": ", E.s, None
, textentry, ondone, true in
3659 state
.text <- color_to_string
(get
());
3660 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3664 method string name get
set =
3666 (name
, `
string get
, 1, Action
(
3668 let ondone s = set s in
3669 let te = name ^
": ", E.s, None
, textentry, ondone, true in
3670 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3674 method colorspace name get
set =
3676 (name
, `
string get
, 1, Action
(
3680 inherit lvsourcebase
3683 m_active
<- CSTE.to_int conf
.colorspace
;
3686 method getitemcount
=
3687 Array.length
CSTE.names
3690 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3691 ignore
(uioh
, first, pan
);
3692 if not cancel
then set active;
3694 method hasaction
_ = true
3698 let modehash = findkeyhash conf
"info" in
3699 coe (new listview ~zebra
:false ~helpmode
:false
3700 ~
source ~trusted
:true ~
modehash)
3703 method paxmark name get
set =
3705 (name
, `
string get
, 1, Action
(
3709 inherit lvsourcebase
3712 m_active
<- MTE.to_int conf
.paxmark
;
3715 method getitemcount
= Array.length
MTE.names
3716 method getitem
n = (MTE.names
.(n), 0)
3717 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3718 ignore
(uioh
, first, pan
);
3719 if not cancel
then set active;
3721 method hasaction
_ = true
3725 let modehash = findkeyhash conf
"info" in
3726 coe (new listview ~zebra
:false ~helpmode
:false
3727 ~
source ~trusted
:true ~
modehash)
3730 method fitmodel name get
set =
3732 (name
, `
string get
, 1, Action
(
3736 inherit lvsourcebase
3739 m_active
<- FMTE.to_int conf
.fitmodel
;
3742 method getitemcount
= Array.length
FMTE.names
3743 method getitem
n = (FMTE.names
.(n), 0)
3744 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3745 ignore
(uioh
, first, pan
);
3746 if not cancel
then set active;
3748 method hasaction
_ = true
3752 let modehash = findkeyhash conf
"info" in
3753 coe (new listview ~zebra
:false ~helpmode
:false
3754 ~
source ~trusted
:true ~
modehash)
3757 method caption
s offset
=
3758 m_l
<- (s, `empty
, offset
, Noaction
) :: m_l
3760 method caption2
s f offset
=
3761 m_l
<- (s, `
string f, offset
, Noaction
) :: m_l
3763 method getitemcount
= Array.length m_a
3766 let tostr = function
3767 | `
int f -> string_of_int
(f ())
3768 | `intws
f -> string_with_suffix_of_int
(f ())
3770 | `color
f -> color_to_string
(f ())
3771 | `
bool (btos, f) -> btos (f ())
3774 let name, t
, offset
, _ = m_a
.(n) in
3775 ((let s = tostr t
in
3777 then Printf.sprintf
"%s\t%s" name s
3781 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3786 match m_a
.(active) with
3787 | _, _, _, Action
f -> f uioh
3788 | _, _, _, Noaction
-> uioh
3799 method hasaction
n =
3801 | _, _, _, Action
_ -> true
3802 | _, _, _, Noaction
-> false
3805 let rec fillsrc prevmode prevuioh
=
3806 let sep () = src#caption
E.s 0 in
3807 let colorp name get
set =
3809 (fun () -> color_to_string
(get
()))
3812 let c = color_of_string
v in
3815 state
.text <- Printf.sprintf
"bad color `%s': %s" v (exntos exn
)
3818 let oldmode = state
.mode
in
3819 let birdseye = isbirdseye state
.mode
in
3821 src#caption
(if birdseye then "Setup (Bird's eye)" else "Setup") 0;
3823 src#
bool "presentation mode"
3824 (fun () -> conf
.presentation
)
3825 (fun v -> setpresentationmode v);
3827 src#
bool "ignore case in searches"
3828 (fun () -> conf
.icase
)
3829 (fun v -> conf
.icase
<- v);
3832 (fun () -> conf
.preload)
3833 (fun v -> conf
.preload <- v);
3835 src#
bool "highlight links"
3836 (fun () -> conf
.hlinks
)
3837 (fun v -> conf
.hlinks
<- v);
3839 src#
bool "under info"
3840 (fun () -> conf
.underinfo
)
3841 (fun v -> conf
.underinfo
<- v);
3843 src#
bool "persistent bookmarks"
3844 (fun () -> conf
.savebmarks
)
3845 (fun v -> conf
.savebmarks
<- v);
3847 src#fitmodel
"fit model"
3848 (fun () -> FMTE.to_string conf
.fitmodel
)
3849 (fun v -> reqlayout conf
.angle
(FMTE.of_int
v));
3851 src#
bool "trim margins"
3852 (fun () -> conf
.trimmargins
)
3853 (fun v -> settrim v conf
.trimfuzz
; fillsrc prevmode prevuioh
);
3855 src#
bool "persistent location"
3856 (fun () -> conf
.jumpback
)
3857 (fun v -> conf
.jumpback
<- v);
3860 src#
int "inter-page space"
3861 (fun () -> conf
.interpagespace
)
3863 conf
.interpagespace
<- n;
3864 docolumns conf
.columns
;
3866 match state
.layout with
3871 state
.maxy <- calcheight
();
3872 let y = getpagey
pageno in
3877 (fun () -> conf
.pagebias
)
3878 (fun v -> conf
.pagebias
<- v);
3880 src#
int "scroll step"
3881 (fun () -> conf
.scrollstep
)
3882 (fun n -> conf
.scrollstep
<- n);
3884 src#
int "horizontal scroll step"
3885 (fun () -> conf
.hscrollstep
)
3886 (fun v -> conf
.hscrollstep
<- v);
3888 src#
int "auto scroll step"
3890 match state
.autoscroll
with
3892 | _ -> conf
.autoscrollstep
)
3894 let n = boundastep state
.winh
n in
3895 if state
.autoscroll
<> None
3896 then state
.autoscroll
<- Some
n;
3897 conf
.autoscrollstep
<- n);
3900 (fun () -> truncate
(conf
.zoom *. 100.))
3901 (fun v -> setzoom ((float v) /. 100.));
3904 (fun () -> conf
.angle
)
3905 (fun v -> reqlayout v conf
.fitmodel
);
3907 src#
int "scroll bar width"
3908 (fun () -> conf
.scrollbw
)
3911 reshape state
.winw state
.winh
;
3914 src#
int "scroll handle height"
3915 (fun () -> conf
.scrollh
)
3916 (fun v -> conf
.scrollh
<- v;);
3918 src#
int "thumbnail width"
3919 (fun () -> conf
.thumbw
)
3921 conf
.thumbw
<- min
4096 v;
3924 leavebirdseye beye
false;
3931 let mode = state
.mode in
3932 src#
string "columns"
3934 match conf
.columns
with
3936 | Cmulti
(multi
, _) -> multicolumns_to_string multi
3937 | Csplit
(count
, _) -> "-" ^ string_of_int count
3940 let n, a, b = multicolumns_of_string
v in
3941 setcolumns mode n a b);
3944 src#caption
"Pixmap cache" 0;
3945 src#int_with_suffix
"size (advisory)"
3946 (fun () -> conf
.memlimit
)
3947 (fun v -> conf
.memlimit
<- v);
3950 (fun () -> Printf.sprintf
"%s bytes, %d tiles"
3951 (string_with_suffix_of_int state
.memused
)
3952 (Hashtbl.length state
.tilemap
)) 1;
3955 src#caption
"Layout" 0;
3956 src#caption2
"Dimension"
3958 Printf.sprintf
"%dx%d (virtual %dx%d)"
3959 state
.winw state
.winh
3964 src#caption2
"Position" (fun () ->
3965 Printf.sprintf
"%dx%d" state
.x state
.y
3968 src#caption2
"Position" (fun () -> describe_location ()) 1
3972 src#
bool ~offset
:0 ~
btos:(fun v -> if v then "(on)" else "(off)")
3973 "Save these parameters as global defaults at exit"
3974 (fun () -> conf
.bedefault
)
3975 (fun v -> conf
.bedefault
<- v)
3979 let btos b = if b then "@Ulguillemet" else "@Urguillemet" in
3980 src#
bool ~offset
:0 ~
btos "Extended parameters"
3981 (fun () -> !showextended)
3982 (fun v -> showextended := v; fillsrc prevmode prevuioh
);
3986 (fun () -> conf
.checkers
)
3987 (fun v -> conf
.checkers
<- v; setcheckers v);
3988 src#
bool "update cursor"
3989 (fun () -> conf
.updatecurs
)
3990 (fun v -> conf
.updatecurs
<- v);
3991 src#
bool "scroll-bar on the left"
3992 (fun () -> conf
.leftscroll
)
3993 (fun v -> conf
.leftscroll
<- v);
3995 (fun () -> conf
.verbose
)
3996 (fun v -> conf
.verbose
<- v);
3997 src#
bool "invert colors"
3998 (fun () -> conf
.invert
)
3999 (fun v -> conf
.invert
<- v);
4001 (fun () -> conf
.maxhfit
)
4002 (fun v -> conf
.maxhfit
<- v);
4003 src#
bool "redirect stderr"
4004 (fun () -> conf
.redirectstderr)
4005 (fun v -> conf
.redirectstderr <- v; redirectstderr ());
4007 (fun () -> conf
.pax
!= None
)
4010 then conf
.pax
<- Some
(ref (now
(), 0, 0))
4011 else conf
.pax
<- None
);
4012 src#
string "uri launcher"
4013 (fun () -> conf
.urilauncher
)
4014 (fun v -> conf
.urilauncher
<- v);
4015 src#
string "path launcher"
4016 (fun () -> conf
.pathlauncher
)
4017 (fun v -> conf
.pathlauncher
<- v);
4018 src#
string "tile size"
4019 (fun () -> Printf.sprintf
"%dx%d" conf
.tilew conf
.tileh
)
4022 let w, h = Scanf.sscanf
v "%dx%d" (fun w h -> w, h) in
4023 conf
.tilew
<- max
64 w;
4024 conf
.tileh
<- max
64 h;
4027 state
.text <- Printf.sprintf
"bad tile size `%s': %s"
4030 src#
int "texture count"
4031 (fun () -> conf
.texcount
)
4034 then conf
.texcount
<- v
4035 else showtext '
!'
" Failed to set texture count please retry later"
4037 src#
int "slice height"
4038 (fun () -> conf
.sliceheight
)
4040 conf
.sliceheight
<- v;
4041 wcmd "sliceh %d" conf
.sliceheight
;
4043 src#
int "anti-aliasing level"
4044 (fun () -> conf
.aalevel
)
4046 conf
.aalevel
<- bound
v 0 8;
4047 state
.anchor <- getanchor
();
4048 opendoc state
.path state
.password;
4050 src#
string "page scroll scaling factor"
4051 (fun () -> string_of_float conf
.pgscale)
4054 let s = float_of_string
v in
4057 state
.text <- Printf.sprintf
4058 "bad page scroll scaling factor `%s': %s" v (exntos exn
)
4061 src#
int "ui font size"
4062 (fun () -> fstate
.fontsize
)
4063 (fun v -> setfontsize (bound
v 5 100));
4064 src#
int "hint font size"
4065 (fun () -> conf
.hfsize
)
4066 (fun v -> conf
.hfsize
<- bound
v 5 100);
4067 colorp "background color"
4068 (fun () -> conf
.bgcolor
)
4069 (fun v -> conf
.bgcolor
<- v);
4070 src#
bool "crop hack"
4071 (fun () -> conf
.crophack
)
4072 (fun v -> conf
.crophack
<- v);
4073 src#
string "trim fuzz"
4074 (fun () -> irect_to_string conf
.trimfuzz
)
4077 conf
.trimfuzz
<- irect_of_string
v;
4079 then settrim true conf
.trimfuzz
;
4081 state
.text <- Printf.sprintf
"bad irect `%s': %s" v (exntos exn
)
4083 src#
string "throttle"
4085 match conf
.maxwait
with
4086 | None
-> "show place holder if page is not ready"
4089 then "wait for page to fully render"
4091 "wait " ^ string_of_float
time
4092 ^
" seconds before showing placeholder"
4096 let f = float_of_string
v in
4098 then conf
.maxwait
<- None
4099 else conf
.maxwait
<- Some
f
4101 state
.text <- Printf.sprintf
"bad time `%s': %s" v (exntos exn
)
4103 src#
string "ghyll scroll"
4105 match conf
.ghyllscroll
with
4107 | Some nab
-> ghyllscroll_to_string nab
4110 try conf
.ghyllscroll
<- ghyllscroll_of_string
v
4112 state
.text <- Printf.sprintf
"bad ghyll `%s': %s" v (exntos exn
)
4114 src#
string "selection command"
4115 (fun () -> conf
.selcmd
)
4116 (fun v -> conf
.selcmd
<- v);
4117 src#
string "synctex command"
4118 (fun () -> conf
.stcmd
)
4119 (fun v -> conf
.stcmd
<- v);
4120 src#
string "pax command"
4121 (fun () -> conf
.paxcmd
)
4122 (fun v -> conf
.paxcmd
<- v);
4123 src#
string "ask password command"
4124 (fun () -> conf
.passcmd)
4125 (fun v -> conf
.passcmd <- v);
4126 src#
string "save path command"
4127 (fun () -> conf
.savecmd
)
4128 (fun v -> conf
.savecmd
<- v);
4129 src#colorspace
"color space"
4130 (fun () -> CSTE.to_string conf
.colorspace
)
4132 conf
.colorspace
<- CSTE.of_int
v;
4136 src#paxmark
"pax mark method"
4137 (fun () -> MTE.to_string conf
.paxmark
)
4138 (fun v -> conf
.paxmark
<- MTE.of_int
v);
4142 (fun () -> conf
.usepbo
)
4143 (fun v -> conf
.usepbo
<- v);
4144 src#
bool "mouse wheel scrolls pages"
4145 (fun () -> conf
.wheelbypage
)
4146 (fun v -> conf
.wheelbypage
<- v);
4147 src#
bool "open remote links in a new instance"
4148 (fun () -> conf
.riani
)
4149 (fun v -> conf
.riani
<- v);
4153 src#caption
"Document" 0;
4154 List.iter
(fun (_, s) -> src#caption
s 1) state
.docinfo
;
4155 src#caption2
"Pages"
4156 (fun () -> string_of_int state
.pagecount
) 1;
4157 src#caption2
"Dimensions"
4158 (fun () -> string_of_int
(List.length state
.pdims
)) 1;
4162 src#caption
"Trimmed margins" 0;
4163 src#caption2
"Dimensions"
4164 (fun () -> string_of_int
(List.length state
.pdims
)) 1;
4168 src#caption
"OpenGL" 0;
4169 src#caption
(Printf.sprintf
"Vendor\t%s" (GlMisc.get_string `vendor
)) 1;
4170 src#caption
(Printf.sprintf
"Renderer\t%s" (GlMisc.get_string `renderer
)) 1;
4173 src#caption
"Location" 0;
4174 if nonemptystr state
.origin
4175 then src#caption
("Orign\t" ^ mbtoutf8 state
.origin
) 1;
4176 src#caption
("Path\t" ^ mbtoutf8 state
.path
) 1;
4178 src#reset prevmode prevuioh
;
4183 let prevmode = state
.mode
4184 and prevuioh
= state
.uioh in
4185 fillsrc prevmode prevuioh
;
4186 let source = (src :> lvsource
) in
4187 let modehash = findkeyhash conf
"info" in
4188 state
.uioh <- coe (object (self)
4189 inherit listview ~zebra
:false ~helpmode
:false
4190 ~
source ~trusted
:true ~
modehash as super
4191 val mutable m_prevmemused
= 0
4192 method! infochanged
= function
4194 if m_prevmemused
!= state
.memused
4196 m_prevmemused
<- state
.memused
;
4197 G.postRedisplay "memusedchanged";
4199 | Pdim
-> G.postRedisplay "pdimchanged"
4200 | Docinfo
-> fillsrc prevmode prevuioh
4202 method! key key mask
=
4203 if not
(Wsi.withctrl mask
)
4206 | @left | @kpleft
-> coe (self#updownlevel ~
-1)
4207 | @right
| @kpright
-> coe (self#updownlevel
1)
4208 | _ -> super#
key key mask
4209 else super#
key key mask
4211 G.postRedisplay "info";
4217 inherit lvsourcebase
4218 method getitemcount
= Array.length state
.help
4220 let s, l, _ = state
.help
.(n) in
4223 method exit ~
uioh ~cancel ~
active ~
first ~pan
=
4227 match state
.help
.(active) with
4228 | _, _, Action
f -> Some
(f uioh)
4229 | _, _, Noaction
-> Some
uioh
4238 method hasaction
n =
4239 match state
.help
.(n) with
4240 | _, _, Action
_ -> true
4241 | _, _, Noaction
-> false
4247 let modehash = findkeyhash conf
"help" in
4249 state
.uioh <- coe (new listview
4250 ~zebra
:false ~helpmode
:true
4251 ~
source ~trusted
:true ~
modehash);
4252 G.postRedisplay "help";
4258 inherit lvsourcebase
4259 val mutable m_items
= E.a
4261 method getitemcount
= 1 + Array.length m_items
4266 else m_items
.(n-1), 0
4268 method exit ~
uioh ~cancel ~
active ~
first ~pan
=
4273 then Buffer.clear state
.errmsgs
;
4280 method hasaction
n =
4284 state
.newerrmsgs
<- false;
4285 let l = Str.split newlinere
(Buffer.contents state
.errmsgs
) in
4286 m_items
<- Array.of_list
l
4295 let source = (msgsource :> lvsource
) in
4296 let modehash = findkeyhash conf
"listview" in
4297 state
.uioh <- coe (object
4298 inherit listview ~zebra
:false ~helpmode
:false
4299 ~
source ~trusted
:false ~
modehash as super
4302 then msgsource#reset
;
4305 G.postRedisplay "msgs";
4308 let enterannotmode opaque slinkindex
=
4311 inherit lvsourcebase
4312 val mutable m_text
= E.s
4313 val mutable m_items
= E.a
4315 method getitemcount
= 2 + Array.length m_items
4318 if n = Array.length m_items
4319 then "[Copy text to the clipboard]", 0
4321 if n = Array.length m_items
+ 1
4322 then "[Delete annotation]", 0
4325 method exit ~
uioh ~cancel ~
active ~
first ~pan
=
4326 ignore
(uioh, first, pan
);
4329 if active = Array.length m_items
4330 then selstring m_text
4332 if active = Array.length m_items
+ 1
4334 delannot
opaque slinkindex
;
4335 wcmd "freepage %s" (~
> opaque);
4337 Hashtbl.fold (fun key opaque'
accu ->
4338 if opaque'
= opaque'
4339 then key :: accu else accu) state
.pagemap
[]
4341 List.iter
(Hashtbl.remove state
.pagemap
) keys;
4348 method hasaction
_ = true
4351 let rec split accu b i
=
4353 if p = String.length
s
4354 then String.sub
s b (p-b) :: accu
4356 if (i
> 70 && s.[p] = ' '
) || s.[p] = '
\r'
|| s.[p] = '
\n'
4358 let ss = if i
= 0 then E.s else String.sub
s b i
in
4359 split (ss::accu) (p+1) 0
4364 m_items
<- split [] 0 0 |> List.rev
|> Array.of_list
4371 let s = getannotcontents
opaque slinkindex
in
4374 let source = (msgsource :> lvsource
) in
4375 let modehash = findkeyhash conf
"listview" in
4376 state
.uioh <- coe (object
4377 inherit listview ~zebra
:false ~helpmode
:false
4378 ~
source ~trusted
:false ~
modehash
4380 G.postRedisplay "enterannotmode";
4383 let gotounder under =
4384 let getpath filename
=
4386 if nonemptystr filename
4388 if Filename.is_relative filename
4390 let dir = Filename.dirname state
.path in
4392 if Filename.is_implicit
dir
4393 then Filename.concat
(Sys.getcwd
()) dir
4396 Filename.concat
dir filename
4400 if Sys.file_exists
path
4405 | Ulinkgoto
(pageno, top) ->
4409 gotopage1 pageno top;
4415 | Uremote
(filename
, pageno) ->
4416 let path = getpath filename
in
4421 let command = Printf.sprintf
"%s -page %d %S" !selfexec pageno path in
4422 try addpid @@ popen
command []
4424 Printf.eprintf
"failed to execute `%s': %s\n" command (exntos exn
);
4427 let anchor = getanchor
() in
4428 let ranchor = state
.path, state
.password, anchor, state
.origin
in
4429 state
.origin
<- E.s;
4430 state
.anchor <- (pageno, 0.0, 0.0);
4431 state
.ranchors
<- ranchor :: state
.ranchors
;
4434 else showtext '
!'
("Could not find " ^ filename
)
4436 | Uremotedest
(filename
, destname
) ->
4437 let path = getpath filename
in
4442 let command = !selfexec ^
" " ^
path ^
" -dest " ^ destname
in
4443 try addpid @@ popen
command []
4446 "failed to execute `%s': %s\n" command (exntos exn
);
4449 let anchor = getanchor
() in
4450 let ranchor = state
.path, state
.password, anchor, state
.origin
in
4451 state
.origin
<- E.s;
4452 state
.nameddest
<- destname
;
4453 state
.ranchors
<- ranchor :: state
.ranchors
;
4456 else showtext '
!'
("Could not find " ^ filename
)
4458 | Uunexpected
_ | Ulaunch
_ | Unamed
_ | Utext
_ | Unone
-> ()
4459 | Uannotation
(opaque, slinkindex
) -> enterannotmode opaque slinkindex
4462 let gotooutline (_, _, kind
) =
4466 let (pageno, y, _) = anchor in
4468 (if conf
.presentation
then (pageno, y, 1.0) else anchor)
4472 | Ouri
uri -> gotounder (Ulinkuri
uri)
4473 | Olaunch cmd
-> gotounder (Ulaunch cmd
)
4474 | Oremote remote
-> gotounder (Uremote remote
)
4475 | Ohistory
hist -> gotohist hist
4476 | Oremotedest remotedest
-> gotounder (Uremotedest remotedest
)
4480 let outlinesource sourcetype
=
4482 inherit lvsourcebase
4483 val mutable m_items
= E.a
4484 val mutable m_minfo
= E.a
4485 val mutable m_orig_items
= E.a
4486 val mutable m_orig_minfo
= E.a
4487 val mutable m_narrow_patterns
= []
4488 val mutable m_hadremovals
= false
4489 val mutable m_gen
= -1
4491 method getitemcount
=
4492 Array.length m_items
+ (if m_hadremovals
then 1 else 0)
4495 if n == Array.length m_items
&& m_hadremovals
4497 ("[Confirm removal]", 0)
4499 let s, n, _ = m_items
.(n) in
4502 method exit ~
uioh ~cancel ~
active ~
first ~pan
=
4503 ignore
(uioh, first);
4504 let confrimremoval = m_hadremovals
&& active = Array.length m_items
in
4506 if m_narrow_patterns
= []
4507 then m_orig_items
, m_orig_minfo
4508 else m_items
, m_minfo
4512 if not
confrimremoval
4514 gotooutline m_items
.(active);
4519 state
.bookmarks
<- Array.to_list m_items
;
4520 m_orig_items
<- m_items
;
4521 m_orig_minfo
<- m_minfo
;
4531 method hasaction
_ = true
4534 if Array.length m_items
!= Array.length m_orig_items
4537 match m_narrow_patterns
with
4539 | many
-> String.concat
"@Uellipsis" (List.rev many
)
4541 "Narrowed to " ^
s ^
" (ctrl-u to restore)"
4545 match m_narrow_patterns
with
4548 | head
:: _ -> "@Uellipsis" ^ head
4550 method narrow
pattern =
4551 let reopt = try Some
(Str.regexp_case_fold
pattern) with _ -> None
in
4555 let rec loop accu minfo n =
4558 m_items
<- Array.of_list
accu;
4559 m_minfo
<- Array.of_list
minfo;
4562 let (s, _, t
) as o = m_items
.(n) in
4565 | Oaction
_ -> o :: accu, (0, 0) :: minfo
4566 | Onone
| Oanchor
_ | Ouri
_ | Olaunch
_
4567 | Oremote
_ | Oremotedest
_ | Ohistory
_ ->
4569 try Str.search_forward
re s 0
4570 with Not_found
-> -1
4573 then o :: accu, (first, Str.match_end
()) :: minfo
4576 loop accu minfo (n-1)
4578 loop [] [] (Array.length m_items
- 1)
4580 method! getminfo
= m_minfo
4584 match sourcetype
with
4585 | `bookmarks
-> Array.of_list state
.bookmarks
4586 | `outlines
-> state
.outlines
4587 | `history
-> genhistoutlines !Config.historder
4589 m_minfo
<- m_orig_minfo
;
4590 m_items
<- m_orig_items
4593 if sourcetype
= `bookmarks
4595 if m >= 0 && m < Array.length m_items
4597 m_hadremovals
<- true;
4598 m_items
<- Array.init
(Array.length m_items
- 1) (fun n ->
4599 let n = if n >= m then n+1 else n in
4604 method add_narrow_pattern
pattern =
4605 m_narrow_patterns
<- pattern :: m_narrow_patterns
4607 method del_narrow_pattern
=
4608 match m_narrow_patterns
with
4609 | _ :: rest
-> m_narrow_patterns
<- rest
4614 match m_narrow_patterns
with
4615 | pattern :: [] -> self#narrow
pattern; pattern
4617 List.fold_left
(fun accu pattern ->
4618 self#narrow
pattern;
4619 pattern ^
"@Uellipsis" ^
accu) E.s list
4621 method calcactive
anchor =
4622 let rely = getanchory anchor in
4623 let rec loop n best bestd
=
4624 if n = Array.length m_items
4627 let _, _, kind
= m_items
.(n) in
4630 let orely = getanchory anchor in
4631 let d = abs
(orely - rely) in
4634 else loop (n+1) best bestd
4635 | Onone
| Oremote
_ | Olaunch
_
4636 | Oremotedest
_ | Ouri
_ | Ohistory
_ | Oaction
_ ->
4637 loop (n+1) best bestd
4641 method reset
anchor items =
4642 m_hadremovals
<- false;
4643 if state
.gen
!= m_gen
4645 m_orig_items
<- items;
4647 m_narrow_patterns
<- [];
4649 m_orig_minfo
<- E.a;
4653 if items != m_orig_items
4655 m_orig_items
<- items;
4656 if m_narrow_patterns
== []
4657 then m_items
<- items;
4660 let active = self#calcactive
anchor in
4662 m_first
<- firstof m_first
active
4666 let enterselector sourcetype
=
4668 let source = outlinesource sourcetype
in
4671 match sourcetype
with
4672 | `bookmarks
-> Array.of_list state
.bookmarks
4673 | `
outlines -> state
.outlines
4674 | `history
-> genhistoutlines !Config.historder
4676 if Array.length
outlines = 0
4678 showtext ' ' errmsg
;
4681 state
.text <- source#greetmsg
;
4682 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
4683 let anchor = getanchor
() in
4684 source#reset
anchor outlines;
4686 coe (new outlinelistview ~zebra
:(sourcetype
=`history
) ~
source);
4687 G.postRedisplay "enter selector";
4691 let enteroutlinemode =
4692 let f = enterselector `
outlines in
4693 fun () -> f "Document has no outline";
4696 let enterbookmarkmode =
4697 let f = enterselector `bookmarks
in
4698 fun () -> f "Document has no bookmarks (yet)";
4701 let enterhistmode () = enterselector `history
"No history (yet)";;
4703 let quickbookmark ?title
() =
4704 match state
.layout with
4710 let tm = Unix.localtime
(now
()) in
4711 Printf.sprintf
"Quick (page %d) (bookmarked at %d/%d/%d %d:%d)"
4715 (tm.Unix.tm_year
+ 1900)
4718 | Some
title -> title
4720 state
.bookmarks
<- (title, 0, Oanchor
(getanchor1
l)) :: state
.bookmarks
4723 let setautoscrollspeed step goingdown
=
4724 let incr = max
1 ((abs step
) / 2) in
4725 let incr = if goingdown
then incr else -incr in
4726 let astep = boundastep state
.winh
(step
+ incr) in
4727 state
.autoscroll
<- Some
astep;
4731 match conf
.columns
with
4733 | Csingle
_ | Cmulti
_ -> state
.x != 0 || conf
.zoom > 1.0
4736 let panbound x = bound
x (-state
.w) (wadjsb () + state
.winw
);;
4738 let existsinrow pageno (columns
, coverA
, coverB
) p =
4739 let last = ((pageno - coverA
) mod columns
) + columns
in
4740 let rec any = function
4743 if l.pageno = coverA
- 1 || l.pageno = state
.pagecount
- coverB
4747 then (if l.pageno = last then false else any rest
)
4755 match state
.layout with
4757 let pageno = page_of_y state
.y in
4758 gotoghyll (getpagey
(pageno+1))
4760 match conf
.columns
with
4762 if conf
.presentation
&& rest
== [] && l.pageh
> l.pagey + l.pagevh
4764 let y = clamp (pgscale state
.winh
) in
4767 let pageno = min
(l.pageno+1) (state
.pagecount
-1) in
4768 gotoghyll (getpagey
pageno)
4769 | Cmulti
((c, _, _) as cl, _) ->
4770 if conf
.presentation
4771 && (existsinrow l.pageno cl
4772 (fun l -> l.pageh
> l.pagey + l.pagevh))
4774 let y = clamp (pgscale state
.winh
) in
4777 let pageno = min
(l.pageno+c) (state
.pagecount
-1) in
4778 gotoghyll (getpagey
pageno)
4780 if l.pageno < state
.pagecount
- 1 || l.pagecol
< n - 1
4782 let pagey, pageh
= getpageyh
l.pageno in
4783 let pagey = pagey + pageh
* l.pagecol
in
4784 let ips = if l.pagecol
= 0 then 0 else conf
.interpagespace
in
4785 gotoghyll (pagey + pageh
+ ips)
4789 match state
.layout with
4791 let pageno = page_of_y state
.y in
4792 gotoghyll (getpagey
(pageno-1))
4794 match conf
.columns
with
4796 if conf
.presentation
&& l.pagey != 0
4798 gotoghyll (clamp (pgscale ~
-(state
.winh
)))
4800 let pageno = max
0 (l.pageno-1) in
4801 gotoghyll (getpagey
pageno)
4802 | Cmulti
((c, _, coverB
) as cl, _) ->
4803 if conf
.presentation
&&
4804 (existsinrow l.pageno cl (fun l -> l.pagey != 0))
4806 gotoghyll (clamp (pgscale ~
-(state
.winh
)))
4809 if l.pageno = state
.pagecount
- coverB
4813 let pageno = max
0 (l.pageno-decr) in
4814 gotoghyll (getpagey
pageno)
4822 let pageno = max
0 (l.pageno-1) in
4823 let pagey, pageh
= getpageyh
pageno in
4826 let pagey, pageh
= getpageyh
l.pageno in
4827 pagey + pageh
* (l.pagecol
-1) - conf
.interpagespace
4833 if emptystr conf
.savecmd
4834 then error
"don't know where to save modified document"
4836 let command = Str.global_replace percentsre state
.path conf
.savecmd
in
4837 match Unix.open_process_in
command with
4838 | (exception exn
) ->
4840 (Printf.sprintf
"savecmd open_process_in failed: %s"
4843 let path = try input_line ic
with End_of_file
-> E.s in
4845 match Unix.close_process_in ic
with
4846 | (exception exn
) ->
4847 error
"error obtaining save path: %s" (exntos exn
)
4850 let tmp = path ^
".tmp" in
4852 Unix.rename
tmp path;
4855 let viewkeyboard key mask
=
4857 let mode = state
.mode in
4858 state
.mode <- Textentry
(te, fun _ -> state
.mode <- mode);
4861 G.postRedisplay "view:enttext"
4863 let ctrl = Wsi.withctrl mask
in
4865 if key >= 0xffb0 && key < 0xffb9 then key - 0xffb0 + 48 else key
4871 if hasunsavedchanges
()
4875 if conf
.angle
mod 360 = 0 && not
(isbirdseye state
.mode)
4877 state
.mode <- LinkNav
(Ltgendir
0);
4880 else showtext '
!'
"Keyboard link navigation does not work under rotation"
4883 begin match state
.mstate
with
4886 G.postRedisplay "kill rect";
4889 | Mscrolly
| Mscrollx
4892 begin match state
.mode with
4895 G.postRedisplay "esc leave linknav"
4899 match state
.ranchors
with
4901 | (path, password, anchor, origin
) :: rest
->
4902 state
.ranchors
<- rest
;
4903 state
.anchor <- anchor;
4904 state
.origin
<- origin
;
4905 state
.nameddest
<- E.s;
4906 opendoc path password
4911 gotoghyll (getnav ~
-1)
4922 Hashtbl.iter
(fun _ opaque -> clearmark
opaque) state
.pagemap
;
4923 G.postRedisplay "dehighlight";
4925 | @slash
| @question
->
4926 let ondone isforw
s =
4927 cbput state
.hists
.pat
s;
4928 state
.searchpattern
<- s;
4931 let s = String.make
1 (Char.chr
key) in
4932 enttext (s, E.s, Some
(onhist state
.hists
.pat
),
4933 textentry, ondone (key = @slash
), true)
4935 | @plus
| @kpplus
| @equals
when ctrl ->
4936 let incr = if conf
.zoom +. 0.01 > 0.1 then 0.1 else 0.01 in
4937 setzoom (conf
.zoom +. incr)
4939 | @plus
| @kpplus
->
4942 try int_of_string
s with exc
->
4943 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
);
4949 state
.text <- "page bias is now " ^ string_of_int
n;
4952 enttext ("page bias: ", E.s, None
, intentry, ondone, true)
4954 | @minus
| @kpminus
when ctrl ->
4955 let decr = if conf
.zoom -. 0.1 < 0.1 then 0.01 else 0.1 in
4956 setzoom (max
0.01 (conf
.zoom -. decr))
4958 | @minus
| @kpminus
->
4959 let ondone msg
= state
.text <- msg
in
4961 "option [acfhilpstvxACFPRSZTISM]: ", E.s, None
,
4962 optentry state
.mode, ondone, true
4973 | (@1 | @2) when ctrl && conf
.fitmodel
!= FitPage
-> (* ctrl-1/2 *)
4975 match conf
.columns
with
4976 | Csingle
_ | Cmulti
_ -> 1
4977 | Csplit
(n, _) -> n
4979 let h = state
.winh
-
4980 conf
.interpagespace
lsl (if conf
.presentation
then 1 else 0)
4982 let zoom = zoomforh state
.winw
h (vscrollw ()) cols in
4983 if zoom > 0.0 && (key = 50 || zoom < 1.0)
4988 match conf
.fitmodel
with
4989 | FitWidth
-> FitProportional
4990 | FitProportional
-> FitPage
4991 | FitPage
-> FitWidth
4993 state
.text <- "fit model: " ^
FMTE.to_string
fm;
4994 reqlayout conf
.angle
fm
5002 | (48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57)
5003 when not
ctrl -> (* 0..9 *)
5006 try int_of_string
s with exc
->
5007 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
);
5013 cbput state
.hists
.pag
(string_of_int
n);
5014 gotopage1 (n + conf
.pagebias
- 1) 0;
5017 let pageentry text key =
5018 match Char.unsafe_chr
key with
5019 | '
g'
-> TEdone
text
5020 | _ -> intentry text key
5022 let text = String.make
1 (Char.chr
key) in
5023 enttext (":", text, Some
(onhist state
.hists
.pag
),
5024 pageentry, ondone, true)
5027 conf
.scrollb
<- if conf
.scrollb
= 0 then (scrollbvv
lor scrollbhv
) else 0;
5028 reshape state
.winw state
.winh
;
5031 state
.bzoom
<- not state
.bzoom
;
5033 showtext ' '
("block zoom " ^
if state
.bzoom
then "on" else "off")
5036 conf
.hlinks
<- not conf
.hlinks
;
5037 state
.text <- "highlightlinks " ^
if conf
.hlinks
then "on" else "off";
5038 G.postRedisplay "toggle highlightlinks";
5041 state
.glinks
<- true;
5042 let mode = state
.mode in
5043 state
.mode <- Textentry
(
5044 (":", E.s, None
, linknentry, linkndone gotounder, false),
5046 state
.glinks
<- false;
5050 G.postRedisplay "view:linkent(F)"
5053 state
.glinks
<- true;
5054 let mode = state
.mode in
5055 state
.mode <- Textentry
(
5057 ":", E.s, None
, linknentry, linkndone (fun under ->
5058 selstring (undertext under);
5062 state
.glinks
<- false;
5066 G.postRedisplay "view:linkent"
5069 begin match state
.autoscroll
with
5071 conf
.autoscrollstep
<- step
;
5072 state
.autoscroll
<- None
5074 if conf
.autoscrollstep
= 0
5075 then state
.autoscroll
<- Some
1
5076 else state
.autoscroll
<- Some conf
.autoscrollstep
5083 setpresentationmode (not conf
.presentation
);
5084 showtext ' '
("presentation mode " ^
5085 if conf
.presentation
then "on" else "off");
5088 if List.mem
Wsi.Fullscreen state
.winstate
5089 then Wsi.reshape conf
.cwinw conf
.cwinh
5090 else Wsi.fullscreen
()
5093 search state
.searchpattern
false
5096 search state
.searchpattern
true
5099 begin match state
.layout with
5102 gotoghyll (getpagey
l.pageno)
5108 | @delete
| @kpdelete
-> (* delete *)
5112 showtext ' '
(describe_location ());
5115 begin match state
.layout with
5118 Wsi.reshape (l.pagew
+ vscrollw ()) l.pageh
;
5123 enterbookmarkmode ()
5131 | @e when Buffer.length state
.errmsgs
> 0 ->
5136 match state
.layout with
5141 (s, 0, Oanchor
(getanchor1
l)) :: state
.bookmarks
5144 enttext ("bookmark: ", E.s, None
, textentry, ondone, true)
5148 showtext ' '
"Quick bookmark added";
5151 begin match state
.layout with
5153 let rect = getpdimrect
l.pagedimno
in
5157 (truncate
(1.8 *. (rect.(1) -. rect.(0))),
5158 truncate
(1.2 *. (rect.(3) -. rect.(0))))
5160 (truncate
(rect.(1) -. rect.(0)),
5161 truncate
(rect.(3) -. rect.(0)))
5163 let w = truncate
((float w)*.conf
.zoom)
5164 and h = truncate
((float h)*.conf
.zoom) in
5167 state
.anchor <- getanchor
();
5168 Wsi.reshape (w + vscrollw ()) (h + conf
.interpagespace
)
5170 G.postRedisplay "z";
5175 | @x -> state
.roam
()
5178 reqlayout (conf
.angle
+
5179 (if key = @Gt
then 30 else -30)) conf
.fitmodel
5183 bound
(conf
.colorscale
+. (if key = 93 then 0.1 else -0.1)) 0.0 1.0
5185 G.postRedisplay "brightness";
5187 | @c when state
.mode = View
->
5192 let m = (wadjsb () + state
.winw
- state
.w) / 2 in
5194 gotoy_and_clear_text state
.y
5198 match state
.prevcolumns
with
5199 | None
-> (1, 0, 0), 1.0
5200 | Some
(columns
, z
) ->
5203 | Csplit
(c, _) -> -c, 0, 0
5204 | Cmulti
((c, a, b), _) -> c, a, b
5205 | Csingle
_ -> 1, 0, 0
5209 setcolumns View
c a b;
5212 | @down
| @up
when ctrl && Wsi.withshift mask
->
5213 let zoom, x = state
.prevzoom
in
5217 | @k
| @up
| @kpup
->
5218 begin match state
.autoscroll
with
5220 begin match state
.mode with
5221 | Birdseye beye
-> upbirdseye 1 beye
5226 then gotoy_and_clear_text (clamp ~
-(state
.winh
/2))
5228 if not
(Wsi.withshift mask
) && conf
.presentation
5230 else gotoghyll1 true (clamp (-conf
.scrollstep
))
5234 setautoscrollspeed n false
5237 | @j
| @down
| @kpdown
->
5238 begin match state
.autoscroll
with
5240 begin match state
.mode with
5241 | Birdseye beye
-> downbirdseye 1 beye
5246 then gotoy_and_clear_text (clamp (state
.winh
/2))
5248 if not
(Wsi.withshift mask
) && conf
.presentation
5250 else gotoghyll1 true (clamp (conf
.scrollstep
))
5254 setautoscrollspeed n true
5257 | @left | @right
| @kpleft
| @kpright
when not
(Wsi.withalt mask
) ->
5263 else conf
.hscrollstep
5265 let dx = if key = @left || key = @kpleft
then dx else -dx in
5266 state
.x <- panbound (state
.x + dx);
5267 gotoy_and_clear_text state
.y
5270 G.postRedisplay "left/right"
5273 | @prior
| @kpprior
->
5277 match state
.layout with
5279 | l :: _ -> state
.y - l.pagey
5281 clamp (pgscale (-state
.winh
))
5285 | @next | @kpnext
->
5289 match List.rev state
.layout with
5291 | l :: _ -> getpagey
l.pageno
5293 clamp (pgscale state
.winh
)
5297 | @g | @home
| @kphome
->
5300 | @G
| @jend
| @kpend
->
5302 gotoghyll (clamp state
.maxy)
5304 | @right
| @kpright
when Wsi.withalt mask
->
5305 gotoghyll (getnav 1)
5306 | @left | @kpleft
when Wsi.withalt mask
->
5307 gotoghyll (getnav ~
-1)
5312 | @v when conf
.debug
->
5315 match getopaque l.pageno with
5318 let x0, y0, x1, y1 = pagebbox
opaque in
5319 let a,b = float x0, float y0 in
5320 let c,d = float x1, float y0 in
5321 let e,f = float x1, float y1 in
5322 let h,j
= float x0, float y1 in
5323 let rect = (a,b,c,d,e,f,h,j
) in
5325 state
.rects
<- (l.pageno, l.pageno mod 3, rect) :: state
.rects
;
5327 G.postRedisplay "v";
5330 let mode = state
.mode in
5331 let cmd = ref E.s in
5332 let onleave = function
5333 | Cancel
-> state
.mode <- mode
5336 match getopaque l.pageno with
5337 | Some
opaque -> pipesel opaque !cmd
5338 | None
-> ()) state
.layout;
5342 cbput state
.hists
.sel
s;
5346 "| ", !cmd, Some
(onhist state
.hists
.sel
), textentry, ondone, true
5348 G.postRedisplay "|";
5349 state
.mode <- Textentry
(te, onleave);
5352 vlog "huh? %s" (Wsi.keyname
key)
5355 let linknavkeyboard key mask
linknav =
5356 let getpage pageno =
5357 let rec loop = function
5359 | l :: _ when l.pageno = pageno -> Some
l
5360 | _ :: rest
-> loop rest
5361 in loop state
.layout
5363 let doexact (pageno, n) =
5364 match getopaque pageno, getpage pageno with
5365 | Some
opaque, Some
l ->
5366 if key = @enter
|| key = @kpenter
5368 let under = getlink
opaque n in
5369 G.postRedisplay "link gotounder";
5376 Some
(findlink
opaque LDfirst
), -1
5379 Some
(findlink
opaque LDlast
), 1
5382 Some
(findlink
opaque (LDleft
n)), -1
5385 Some
(findlink
opaque (LDright
n)), 1
5388 Some
(findlink
opaque (LDup
n)), -1
5391 Some
(findlink
opaque (LDdown
n)), 1
5396 begin match findpwl
l.pageno dir with
5400 state
.mode <- LinkNav
(Ltgendir
dir);
5401 let y, h = getpageyh
pageno in
5404 then y + h - state
.winh
5409 begin match getopaque pageno, getpage pageno with
5410 | Some
opaque, Some
_ ->
5412 let ld = if dir > 0 then LDfirst
else LDlast
in
5415 begin match link with
5417 showlinktype (getlink
opaque m);
5418 state
.mode <- LinkNav
(Ltexact
(pageno, m));
5419 G.postRedisplay "linknav jpage";
5420 | Lnotfound
-> notfound dir
5426 begin match opt with
5427 | Some Lnotfound
-> pwl l dir;
5428 | Some
(Lfound
m) ->
5432 let _, y0, _, y1 = getlinkrect
opaque m in
5434 then gotopage1 l.pageno y0
5436 let d = fstate
.fontsize
+ 1 in
5437 if y1 - l.pagey > l.pagevh - d
5438 then gotopage1 l.pageno (y1 - state
.winh
- hscrollh () + d)
5439 else G.postRedisplay "linknav";
5441 showlinktype (getlink
opaque m);
5442 state
.mode <- LinkNav
(Ltexact
(l.pageno, m));
5445 | None
-> viewkeyboard key mask
5447 | _ -> viewkeyboard key mask
5452 G.postRedisplay "leave linknav"
5456 | Ltgendir
_ | Ltnotready
_ -> viewkeyboard key mask
5457 | Ltexact exact
-> doexact exact
5460 let keyboard key mask
=
5461 if (key = 103 && Wsi.withctrl mask
) && not
(istextentry state
.mode)
5462 then wcmd "interrupt"
5463 else state
.uioh <- state
.uioh#
key key mask
5466 let birdseyekeyboard key mask
5467 ((oconf
, leftx
, pageno, hooverpageno
, anchor) as beye
) =
5469 match conf
.columns
with
5471 | Cmulti
((c, _, _), _) -> c
5472 | Csplit
_ -> failwith
"bird's eye split mode"
5474 let pgh layout = List.fold_left
5475 (fun m l -> max
l.pageh
m) state
.winh
layout in
5477 | @l when Wsi.withctrl mask
->
5478 let y, h = getpageyh
pageno in
5479 let top = (state
.winh
- h) / 2 in
5480 gotoy (max
0 (y - top))
5481 | @enter
| @kpenter
-> leavebirdseye beye
false
5482 | @escape
-> leavebirdseye beye
true
5483 | @up
-> upbirdseye incr beye
5484 | @down
-> downbirdseye incr beye
5485 | @left -> upbirdseye 1 beye
5486 | @right
-> downbirdseye 1 beye
5489 begin match state
.layout with
5493 state
.mode <- Birdseye
(
5494 oconf
, leftx
, l.pageno, hooverpageno
, anchor
5496 gotopage1 l.pageno 0;
5499 let layout = layout (state
.y-state
.winh
) (pgh state
.layout) in
5501 | [] -> gotoy (clamp (-state
.winh
))
5503 state
.mode <- Birdseye
(
5504 oconf
, leftx
, l.pageno, hooverpageno
, anchor
5506 gotopage1 l.pageno 0
5509 | [] -> gotoy (clamp (-state
.winh
))
5513 begin match List.rev state
.layout with
5515 let layout = layout (state
.y + (pgh state
.layout)) state
.winh
in
5516 begin match layout with
5518 let incr = l.pageh
- l.pagevh in
5523 oconf
, leftx
, state
.pagecount
- 1, hooverpageno
, anchor
5525 G.postRedisplay "birdseye pagedown";
5527 else gotoy (clamp (incr + conf
.interpagespace
*2));
5531 Birdseye
(oconf
, leftx
, l.pageno, hooverpageno
, anchor);
5532 gotopage1 l.pageno 0;
5535 | [] -> gotoy (clamp state
.winh
)
5539 state
.mode <- Birdseye
(oconf
, leftx
, 0, hooverpageno
, anchor);
5543 let pageno = state
.pagecount
- 1 in
5544 state
.mode <- Birdseye
(oconf
, leftx
, pageno, hooverpageno
, anchor);
5545 if not
(pagevisible state
.layout pageno)
5548 match List.rev state
.pdims
with
5550 | (_, _, h, _) :: _ -> h
5552 gotoy (max
0 (getpagey
pageno - (state
.winh
- h - conf
.interpagespace
)))
5553 else G.postRedisplay "birdseye end";
5555 | _ -> viewkeyboard key mask
5560 match state
.mode with
5561 | Textentry
_ -> scalecolor 0.4
5563 | View
-> scalecolor 1.0
5564 | Birdseye
(_, _, pageno, hooverpageno
, _) ->
5565 if l.pageno = hooverpageno
5568 if l.pageno = pageno
5570 let c = scalecolor 1.0 in
5572 GlDraw.line_width
3.0;
5573 let dispx = xadjsb () + l.pagedispx in
5575 (float (dispx-1)) (float (l.pagedispy-1))
5576 (float (dispx+l.pagevw+1))
5577 (float (l.pagedispy+l.pagevh+1))
5579 GlDraw.line_width
1.0;
5588 let postdrawpage l linkindexbase
=
5589 match getopaque l.pageno with
5591 if tileready l l.pagex
l.pagey
5593 let x = l.pagedispx - l.pagex
+ xadjsb ()
5594 and y = l.pagedispy - l.pagey in
5596 match conf
.columns
with
5597 | Csingle
_ | Cmulti
_ ->
5598 (if conf
.hlinks
then 1 else 0)
5600 && not
(isbirdseye state
.mode) then 2 else 0)
5604 match state
.mode with
5605 | Textentry
((_, s, _, _, _, _), _) when state
.glinks
-> s
5611 postprocess
opaque hlmask x y (linkindexbase
, s, conf
.hfsize
);
5616 let scrollindicator () =
5617 let sbw, ph
, sh = state
.uioh#
scrollph in
5618 let sbh, pw, sw = state
.uioh#scrollpw
in
5623 else ((state
.winw
- sbw), state
.winw
, 0)
5626 GlDraw.color (0.64, 0.64, 0.64);
5627 filledrect (float x0) 0. (float x1) (float state
.winh
);
5629 (float hx0
) (float (state
.winh
- sbh))
5630 (float (hx0
+ wadjsb () + state
.winw
)) (float state
.winh
)
5632 GlDraw.color (0.0, 0.0, 0.0);
5634 filledrect (float x0) ph
(float x1) (ph
+. sh);
5635 let pw = pw +. float hx0
in
5636 filledrect pw (float (state
.winh
- sbh)) (pw +. sw) (float state
.winh
);
5640 match state
.mstate
with
5641 | Mnone
| Mscrolly
| Mscrollx
| Mpan
_ | Mzoom
_ | Mzoomrect
_ ->
5644 | Msel
((x0, y0), (x1, y1)) ->
5645 let identify opaque l px py = Some
(opaque, l.pageno, px, py) in
5646 let o0,n0
,px0
,py0
= onppundermouse identify x0 y0 (~
< E.s, -1, 0, 0) in
5647 let _o1,n1
,px1
,py1
= onppundermouse identify x1 y1 (~
< E.s, -1, 0, 0) in
5648 if n0
!= -1 && n0
= n1
then seltext
o0 (px0
, py0
, px1
, py1
);
5651 let showrects = function [] -> () | rects
->
5653 GlDraw.color (0.0, 0.0, 1.0) ~
alpha:0.5;
5654 GlFunc.blend_func ~
src:`src_alpha ~dst
:`one_minus_src_alpha
;
5656 (fun (pageno, c, (x0, y0, x1, y1, x2
, y2
, x3
, y3
)) ->
5658 if l.pageno = pageno
5660 let dx = float (l.pagedispx - l.pagex
) in
5661 let dy = float (l.pagedispy - l.pagey) in
5662 GlDraw.color (0.0, 0.0, 1.0 /. float c) ~
alpha:0.5;
5663 Raw.sets_float state
.vraw ~
pos:0
5668 GlArray.vertex `two state
.vraw
;
5669 GlArray.draw_arrays `triangle_strip ~
first:0 ~count
:4;
5678 GlClear.color (scalecolor2 conf
.bgcolor
);
5679 GlClear.clear
[`
color];
5680 List.iter
drawpage state
.layout;
5682 match state
.mode with
5683 | LinkNav
(Ltexact
(pageno, linkno
)) ->
5684 begin match getopaque pageno with
5686 let dx = xadjsb () in
5687 let x0, y0, x1, y1 = getlinkrect
opaque linkno
in
5688 let x0 = x0 + dx and x1 = x1 + dx in
5695 | None
-> state
.rects
5697 | LinkNav
(Ltgendir
_) | LinkNav
(Ltnotready
_)
5700 | View
-> state
.rects
5703 let rec postloop linkindexbase
= function
5705 let linkindexbase = linkindexbase + postdrawpage l linkindexbase in
5706 postloop linkindexbase rest
5710 postloop 0 state
.layout;
5712 begin match state
.mstate
with
5713 | Mzoomrect
((x0, y0), (x1, y1)) ->
5715 GlDraw.color (0.3, 0.3, 0.3) ~
alpha:0.5;
5716 GlFunc.blend_func ~
src:`src_alpha ~dst
:`one_minus_src_alpha
;
5717 filledrect (float x0) (float y0) (float x1) (float y1);
5721 | Mscrolly
| Mscrollx
5730 let zoomrect x y x1 y1 =
5733 and y0 = min
y y1 in
5734 gotoy (state
.y + y0);
5735 state
.anchor <- getanchor
();
5736 let zoom = (float state
.w) /. float (x1 - x0) in
5739 let adjw = wadjsb () + state
.winw
in
5741 then (adjw - state
.w) / 2
5744 match conf
.fitmodel
with
5745 | FitWidth
| FitProportional
-> simple ()
5747 match conf
.columns
with
5749 onppundermouse (fun _ l _ _ -> Some
l.pagedispx) x0 y0 x0
5750 | Cmulti
_ | Csingle
_ -> simple ()
5752 state
.x <- (state
.x + margin) - x0;
5757 let filecontents path =
5758 let ic = open_in
path in
5759 let b = Buffer.create
(in_channel_length
ic) in
5761 match input_line
ic with
5762 | (exception End_of_file
) -> Buffer.contents
b
5764 if Buffer.length
b > 0
5765 then Buffer.add_char
b '
\n'
;
5766 Buffer.add_string
b line
;
5772 let getusertext () =
5773 let editor = getenvwithdef
"EDITOR" E.s in
5777 let tmppath = Filename.temp_file
"llpp" "note" in
5778 let execstr = editor ^
" " ^
tmppath in
5780 match Unix.system
execstr with
5781 | (exception exn
) ->
5783 Printf.sprintf
"Unix.system(%S) failed: %s" execstr (exntos exn
);
5785 | Unix.WEXITED
0 -> filecontents tmppath
5788 Printf.sprintf
"editor process(%s) exited abnormally: %d"
5791 | Unix.WSIGNALED
n ->
5793 Printf.sprintf
"editor process(%s) was killed by signal %d"
5796 | Unix.WSTOPPED
n ->
5798 Printf.sprintf
"editor(%s) process was stopped by signal %d"
5802 match Unix.unlink
tmppath with
5803 | (exception exn
) ->
5805 Printf.sprintf
"failed to ulink %S: %s"
5806 tmppath (exntos exn
);
5811 let annot inline
x y =
5812 match unproject x y with
5813 | Some
(opaque, n, ux
, uy
) ->
5815 addannot
opaque ux uy
text;
5816 wcmd "freepage %s" (~
> opaque);
5817 Hashtbl.remove state
.pagemap
(n, state
.gen
);
5823 let ondone s = add s in
5824 let mode = state
.mode in
5825 state
.mode <- Textentry
(
5826 ("annotation: ", E.s, None
, textentry, ondone, true),
5827 fun _ -> state
.mode <- mode);
5830 G.postRedisplay "annot"
5833 let s = getusertext () in
5834 let l = Str.split newlinere
s in
5842 let g opaque l px py =
5843 match rectofblock
opaque px py with
5845 let x0 = a.(0) -. 20. in
5846 let x1 = a.(1) +. 20. in
5847 let y0 = a.(2) -. 20. in
5848 let zoom = (float state
.w) /. (x1 -. x0) in
5849 let pagey = getpagey
l.pageno in
5850 gotoy_and_clear_text (pagey + truncate
y0);
5851 state
.anchor <- getanchor
();
5852 let margin = (state
.w - l.pagew
)/2 in
5853 state
.x <- -truncate
x0 - margin;
5858 match conf
.columns
with
5860 showtext '
!'
"block zooming does not work properly in split columns mode"
5861 | Cmulti
_ | Csingle
_ -> onppundermouse g x y ()
5865 let winw = wadjsb () + state
.winw - 1 in
5866 let s = float x /. float winw in
5867 let destx = truncate
(float (state
.w + winw) *. s) in
5868 state
.x <- winw - destx;
5869 gotoy_and_clear_text state
.y;
5870 state
.mstate
<- Mscrollx
;
5874 let s = float y /. float state
.winh
in
5875 let desty = truncate
(float (state
.maxy - state
.winh
) *. s) in
5876 gotoy_and_clear_text desty;
5877 state
.mstate
<- Mscrolly
;
5880 let viewmulticlick clicks
x y mask
=
5881 let g opaque l px py =
5889 if markunder
opaque px py mark
5893 match getopaque l.pageno with
5895 | Some
opaque -> pipesel opaque cmd
5897 state
.roam
<- (fun () -> dopipe conf
.paxcmd
);
5898 if not
(Wsi.withctrl mask
) then dopipe conf
.selcmd
;
5903 G.postRedisplay "viewmulticlick";
5904 onppundermouse g x y (fun () -> showtext '
!'
"Nothing to select") ();
5908 match conf
.columns
with
5910 | Csingle
_ | Cmulti
_ -> conf
.angle
mod 360 = 0
5913 let viewmouse button down
x y mask
=
5915 | n when (n == 4 || n == 5) && not down
->
5916 if Wsi.withctrl mask
5918 match state
.mstate
with
5919 | Mzoom
(oldn
, i
) ->
5927 if conf
.zoom +. 0.01 > 0.1 then 0.1 else 0.01
5929 if conf
.zoom -. 0.1 < 0.1 then -0.01 else -0.1
5931 let zoom = conf
.zoom -. incr in
5933 state
.mstate
<- Mzoom
(n, 0);
5935 state
.mstate
<- Mzoom
(n, i
+1);
5937 else state
.mstate
<- Mzoom
(n, 0)
5941 | Mscrolly
| Mscrollx
5943 | Mnone
-> state
.mstate
<- Mzoom
(n, 0)
5946 match state
.autoscroll
with
5947 | Some step
-> setautoscrollspeed step
(n=4)
5949 if conf
.wheelbypage
|| conf
.presentation
5958 then -conf
.scrollstep
5959 else conf
.scrollstep
5961 let incr = incr * 2 in
5962 let y = clamp incr in
5963 gotoy_and_clear_text y
5966 | n when (n = 6 || n = 7) && not down
&& canpan () ->
5968 panbound (state
.x + (if n = 7 then -2 else 2) * conf
.hscrollstep
);
5969 gotoy_and_clear_text state
.y
5971 | 1 when Wsi.withshift mask
->
5972 state
.mstate
<- Mnone
;
5975 match unproject x y with
5976 | Some
(_, pageno, ux
, uy
) ->
5977 let cmd = Printf.sprintf
5979 conf
.stcmd state
.path pageno ux uy
5981 addpid @@ popen
cmd []
5985 | 1 when Wsi.withctrl mask
->
5988 Wsi.setcursor
Wsi.CURSOR_CROSSHAIR
;
5989 state
.mstate
<- Mpan
(x, y)
5992 state
.mstate
<- Mnone
5997 if Wsi.withshift mask
5999 annot (not
(Wsi.withctrl mask
)) x y;
6000 G.postRedisplay "addannot"
6004 Wsi.setcursor
Wsi.CURSOR_CYCLE
;
6005 state
.mstate
<- Mzoomrect
(p, p)
6008 match state
.mstate
with
6009 | Mzoomrect
((x0, y0), _) ->
6010 if abs
(x-x0) > 10 && abs
(y - y0) > 10
6011 then zoomrect x0 y0 x y
6014 G.postRedisplay "kill accidental zoom rect";
6018 | Mscrolly
| Mscrollx
6024 | 1 when x > state
.winw - vscrollw () ->
6027 let _, position, sh = state
.uioh#
scrollph in
6028 if y > truncate
position && y < truncate
(position +. sh)
6029 then state
.mstate
<- Mscrolly
6032 state
.mstate
<- Mnone
6034 | 1 when y > state
.winh
- hscrollh () ->
6037 let _, position, sw = state
.uioh#scrollpw
in
6038 if x > truncate
position && x < truncate
(position +. sw)
6039 then state
.mstate
<- Mscrollx
6042 state
.mstate
<- Mnone
6044 | 1 when state
.bzoom
-> if not down
then zoomblock x y
6047 let dest = if down
then getunder x y else Unone
in
6048 begin match dest with
6051 | Uremote
_ | Uremotedest
_
6052 | Uunexpected
_ | Ulaunch
_ | Unamed
_ ->
6055 | Unone
when down
->
6056 Wsi.setcursor
Wsi.CURSOR_CROSSHAIR
;
6057 state
.mstate
<- Mpan
(x, y);
6059 | Uannotation
(opaque, slinkindex
) -> enterannotmode opaque slinkindex
6061 | Unone
| Utext
_ ->
6066 state
.mstate
<- Msel
((x, y), (x, y));
6067 G.postRedisplay "mouse select";
6071 match state
.mstate
with
6074 | Mzoom
_ | Mscrollx
| Mscrolly
->
6075 state
.mstate
<- Mnone
6077 | Mzoomrect
((x0, y0), _) ->
6081 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
6082 state
.mstate
<- Mnone
6084 | Msel
((x0, y0), (x1, y1)) ->
6085 let rec loop = function
6089 let a0 = l.pagedispy in
6090 let a1 = a0 + l.pagevh in
6091 let b0 = l.pagedispx in
6092 let b1 = b0 + l.pagevw in
6093 ((y0 >= a0 && y0 <= a1) || (y1 >= a0 && y1 <= a1))
6094 && ((x0 >= b0 && x0 <= b1) || (x1 >= b0 && x1 <= b1))
6098 match getopaque l.pageno with
6101 match Unix.pipe
() with
6105 "can not create sel pipe: %s"
6109 Ne.clo fd
(fun msg
->
6110 dolog
"%s close failed: %s" what msg
)
6113 try popen
cmd [r, 0; w, -1]
6115 dolog
"can not execute %S: %s"
6123 G.postRedisplay "copysel";
6125 else clo "Msel pipe/w" w;
6126 clo "Msel pipe/r" r;
6128 dosel conf
.selcmd
();
6129 state
.roam
<- dosel conf
.paxcmd
;
6141 let birdseyemouse button down
x y mask
6142 (conf
, leftx
, _, hooverpageno
, anchor) =
6145 let rec loop = function
6148 if y > l.pagedispy && y < l.pagedispy + l.pagevh
6149 && x > l.pagedispx && x < l.pagedispx + l.pagevw
6151 leavebirdseye (conf
, leftx
, l.pageno, hooverpageno
, anchor) false;
6157 | _ -> viewmouse button down
x y mask
6163 method key key mask
=
6164 begin match state
.mode with
6165 | Textentry
textentry -> textentrykeyboard key mask
textentry
6166 | Birdseye
birdseye -> birdseyekeyboard key mask
birdseye
6167 | View
-> viewkeyboard key mask
6168 | LinkNav
linknav -> linknavkeyboard key mask
linknav
6172 method button button bstate
x y mask
=
6173 begin match state
.mode with
6175 | View
-> viewmouse button bstate
x y mask
6176 | Birdseye beye
-> birdseyemouse button bstate
x y mask beye
6181 method multiclick clicks
x y mask
=
6182 begin match state
.mode with
6184 | View
-> viewmulticlick clicks
x y mask
6191 begin match state
.mode with
6193 | View
| Birdseye
_ | LinkNav
_ ->
6194 match state
.mstate
with
6195 | Mzoom
_ | Mnone
-> ()
6200 state
.mstate
<- Mpan
(x, y);
6202 then state
.x <- panbound (state
.x + dx);
6204 gotoy_and_clear_text y
6207 state
.mstate
<- Msel
(a, (x, y));
6208 G.postRedisplay "motion select";
6211 let y = min state
.winh
(max
0 y) in
6215 let x = min state
.winw (max
0 x) in
6218 | Mzoomrect
(p0
, _) ->
6219 state
.mstate
<- Mzoomrect
(p0
, (x, y));
6220 G.postRedisplay "motion zoomrect";
6224 method pmotion
x y =
6225 begin match state
.mode with
6226 | Birdseye
(conf
, leftx
, pageno, hooverpageno
, anchor) ->
6227 let rec loop = function
6229 if hooverpageno
!= -1
6231 state
.mode <- Birdseye
(conf
, leftx
, pageno, -1, anchor);
6232 G.postRedisplay "pmotion birdseye no hoover";
6235 if y > l.pagedispy && y < l.pagedispy + l.pagevh
6236 && x > l.pagedispx && x < l.pagedispx + l.pagevw
6238 state
.mode <- Birdseye
(conf
, leftx
, pageno, l.pageno, anchor);
6239 G.postRedisplay "pmotion birdseye hoover";
6249 match state
.mstate
with
6250 | Mpan
_ | Msel
_ | Mzoom
_ | Mscrolly
| Mscrollx
| Mzoomrect
_ -> ()
6258 let past, _, _ = !r in
6260 let delta = now -. past in
6263 else r := (now, x, y)
6267 method infochanged
_ = ()
6270 let maxy = state
.maxy - (if conf
.maxhfit
then state
.winh
else 0) in
6273 then 0.0, float state
.winh
6274 else scrollph state
.y maxy
6279 let winw = wadjsb () + state
.winw in
6280 let fwinw = float winw in
6282 let sw = fwinw /. float state
.w in
6283 let sw = fwinw *. sw in
6284 max
sw (float conf
.scrollh
)
6287 let maxx = state
.w + winw in
6288 let x = winw - state
.x in
6289 let percent = float x /. float maxx in
6290 (fwinw -. sw) *. percent
6292 hscrollh (), position, sw
6296 match state
.mode with
6297 | LinkNav
_ -> "links"
6298 | Textentry
_ -> "textentry"
6299 | Birdseye
_ -> "birdseye"
6302 findkeyhash conf
modename
6304 method eformsgs
= true
6305 method alwaysscrolly
= false
6308 let adderrmsg src msg
=
6309 Buffer.add_string state
.errmsgs msg
;
6310 state
.newerrmsgs
<- true;
6314 let adderrfmt src fmt
=
6315 Format.ksprintf
(fun s -> adderrmsg src s) fmt
;
6319 let cl = splitatspace cmds
in
6321 try Scanf.sscanf
s fmt
f
6323 adderrfmt "remote exec"
6324 "error processing '%S': %s\n" cmds
(exntos exn
)
6327 | "reload" :: [] -> reload ()
6328 | "goto" :: args
:: [] ->
6329 scan args
"%u %f %f"
6331 let cmd, _ = state
.geomcmds
in
6333 then gotopagexy pageno x y
6336 gotopagexy pageno x y;
6339 state
.reprf
<- f state
.reprf
6341 | "goto1" :: args
:: [] -> scan args
"%u %f" gotopage
6342 | "gotor" :: args
:: [] ->
6344 (fun filename
pageno -> gotounder (Uremote
(filename
, pageno)))
6345 | "gotord" :: args
:: [] ->
6347 (fun filename
dest -> gotounder (Uremotedest
(filename
, dest)))
6348 | "rect" :: args
:: [] ->
6349 scan args
"%u %u %f %f %f %f"
6350 (fun pageno color x0 y0 x1 y1 ->
6351 onpagerect pageno (fun w h ->
6352 let _,w1,h1
,_ = getpagedim
pageno in
6353 let sw = float w1 /. float w
6354 and sh = float h1
/. float h in
6358 and y1s
= y1 *. sh in
6359 let rect = (x0s,y0s
,x1s
,y0s
,x1s
,y1s
,x0s,y1s
) in
6361 state
.rects <- (pageno, color, rect) :: state
.rects;
6362 G.postRedisplay "rect";
6365 | "activatewin" :: [] -> Wsi.activatewin
()
6366 | "quit" :: [] -> raise Quit
6368 adderrfmt "remote command"
6369 "error processing remote command: %S\n" cmds
;
6373 let scratch = Bytes.create
80 in
6374 let buf = Buffer.create
80 in
6377 try Some
(Unix.read fd
scratch 0 80)
6379 | Unix.Unix_error
(Unix.EAGAIN
, _, _) -> None
6380 | Unix.Unix_error
(Unix.EINTR
, _, _) -> tempfr ()
6383 match tempfr () with
6389 if Buffer.length
buf > 0
6391 let s = Buffer.contents
buf in
6401 let pos = Bytes.index_from
scratch ppos '
\n'
in
6402 if pos >= n then -1 else pos
6403 with Not_found
-> -1
6407 Buffer.add_subbytes
buf scratch ppos
(nlpos-ppos
);
6408 let s = Buffer.contents
buf in
6414 Buffer.add_subbytes
buf scratch ppos
(n-ppos
);
6420 let remoteopen path =
6421 try Some
(Unix.openfile
path [Unix.O_NONBLOCK
; Unix.O_RDONLY
] 0o0)
6423 adderrfmt "remoteopen" "error opening %S: %s" path (exntos exn
);
6428 let gcconfig = ref E.s in
6429 let trimcachepath = ref E.s in
6430 let rcmdpath = ref E.s in
6431 let pageno = ref None
in
6432 let rootwid = ref 0 in
6433 let openlast = ref false in
6434 let nofc = ref false in
6435 selfexec := Sys.executable_name
;
6438 [("-p", Arg.String
(fun s -> state
.password <- s),
6439 "<password> Set password");
6443 Config.fontpath
:= s;
6444 selfexec := !selfexec ^
" -f " ^
Filename.quote
s;
6446 "<path> Set path to the user interface font");
6450 selfexec := !selfexec ^
" -c " ^
Filename.quote
s;
6451 Config.confpath
:= s),
6452 "<path> Set path to the configuration file");
6454 ("-last", Arg.Set
openlast, " Open last document");
6456 ("-page", Arg.Int
(fun pageno1
-> pageno := Some
(pageno1
-1)),
6457 "<page-number> Jump to page");
6459 ("-tcf", Arg.String
(fun s -> trimcachepath := s),
6460 "<path> Set path to the trim cache file");
6462 ("-dest", Arg.String
(fun s -> state
.nameddest
<- s),
6463 "<named-destination> Set named destination");
6465 ("-wtmode", Arg.Set
wtmode, " Operate in wt mode");
6466 ("-cxack", Arg.Set
cxack, " Cut corners");
6468 ("-remote", Arg.String
(fun s -> rcmdpath := s),
6469 "<path> Set path to the remote commands source");
6471 ("-origin", Arg.String
(fun s -> state
.origin
<- s),
6472 "<original-path> Set original path");
6474 ("-gc", Arg.Set_string
gcconfig,
6475 "<script-path> Collect garbage with the help of a script");
6477 ("-nofc", Arg.Set
nofc, " Do not use fontconfig");
6479 ("-v", Arg.Unit
(fun () ->
6481 "%s\nconfiguration path: %s\n"
6485 exit
0), " Print version and exit");
6487 ("-embed", Arg.Set_int
rootwid,
6488 "<window-id> Embed into window")
6491 (fun s -> state
.path <- s)
6492 ("Usage: " ^
Sys.argv
.(0) ^
" [options] some.pdf\nOptions:")
6495 then selfexec := !selfexec ^
" -wtmode";
6497 let histmode = emptystr state
.path && not
!openlast in
6499 if not
(Config.load !openlast)
6500 then prerr_endline
"failed to load configuration";
6501 begin match !pageno with
6502 | Some
pageno -> state
.anchor <- (pageno, 0.0, 0.0)
6506 if not
(emptystr
!gcconfig)
6509 match Unix.socketpair
Unix.PF_UNIX
Unix.SOCK_STREAM
0 with
6511 error
"gc socketpair failed: %s" (exntos exn
)
6514 match addpid @@ popen
!gcconfig [(c, 0); (c, 1)] with
6516 error
"failed to popen gc script: %s" (exntos exn
);
6522 let wsfd, winw, winh
= Wsi.init
(object (self)
6523 val mutable m_clicks
= 0
6524 val mutable m_click_x
= 0
6525 val mutable m_click_y
= 0
6526 val mutable m_lastclicktime
= infinity
6528 method private cleanup
=
6529 state
.roam
<- noroam
;
6530 Hashtbl.iter
(fun _ opaque -> clearmark
opaque) state
.pagemap
6531 method expose
= G.postRedisplay"expose"
6535 | Wsi.Unobscured
-> "unobscured"
6536 | Wsi.PartiallyObscured
-> "partiallyobscured"
6537 | Wsi.FullyObscured
-> "fullyobscured"
6539 vlog "visibility change %s" name
6540 method display = display ()
6541 method map mapped
= vlog "mappped %b" mapped
6542 method reshape w h =
6545 method mouse
b d x y m =
6546 if d && canselect ()
6548 (* http://blogs.msdn.com/b/oldnewthing/archive/2004/10/18/243925.aspx *)
6554 if abs
x - m_click_x
> 10
6555 || abs
y - m_click_y
> 10
6556 || abs_float
(t -. m_lastclicktime
) > 0.3
6558 m_clicks
<- m_clicks
+ 1;
6559 m_lastclicktime
<- t;
6563 G.postRedisplay "cleanup";
6564 state
.uioh <- state
.uioh#button
b d x y m;
6566 else state
.uioh <- state
.uioh#multiclick m_clicks
x y m
6571 m_lastclicktime
<- infinity
;
6572 state
.uioh <- state
.uioh#button
b d x y m
6576 state
.uioh <- state
.uioh#button
b d x y m
6579 state
.mpos
<- (x, y);
6580 state
.uioh <- state
.uioh#motion
x y
6581 method pmotion
x y =
6582 state
.mpos
<- (x, y);
6583 state
.uioh <- state
.uioh#pmotion
x y
6585 let mascm = m land (
6586 Wsi.altmask
+ Wsi.shiftmask
+ Wsi.ctrlmask
+ Wsi.metamask
6589 let x = state
.x and y = state
.y in
6591 if x != state
.x || y != state
.y then self#cleanup
6593 match state
.keystate
with
6595 let km = k
, mascm in
6598 let modehash = state
.uioh#
modehash in
6599 try Hashtbl.find modehash km
6601 try Hashtbl.find (findkeyhash conf
"global") km
6602 with Not_found
-> KMinsrt
(k
, m)
6604 | KMinsrt
(k
, m) -> keyboard k
m
6605 | KMinsrl
l -> List.iter
(fun (k
, m) -> keyboard k
m) l
6606 | KMmulti
(l, r) -> state
.keystate
<- KSinto
(l, r)
6608 | KSinto
((k'
, m'
) :: [], insrt
) when k'
=k
&& m'
land mascm = m'
->
6609 List.iter
(fun (k
, m) -> keyboard k
m) insrt
;
6610 state
.keystate
<- KSnone
6611 | KSinto
((k'
, m'
) :: keys, insrt
) when k'
=k
&& m'
land mascm = m'
->
6612 state
.keystate
<- KSinto
(keys, insrt
)
6613 | KSinto
_ -> state
.keystate
<- KSnone
6616 state
.mpos
<- (x, y);
6617 state
.uioh <- state
.uioh#pmotion
x y
6618 method leave = state
.mpos
<- (-1, -1)
6619 method winstate wsl
= state
.winstate
<- wsl
6620 method quit
= raise Quit
6621 end) !rootwid conf
.cwinw conf
.cwinh platform
in
6626 List.exists
GlMisc.check_extension
6627 [ "GL_ARB_texture_rectangle"
6628 ; "GL_EXT_texture_recangle"
6629 ; "GL_NV_texture_rectangle" ]
6631 then (prerr_endline
"OpenGL does not suppport rectangular textures"; exit
1);
6634 let r = GlMisc.get_string `renderer
in
6635 let p = "Mesa DRI Intel(" in
6636 let l = String.length
p in
6637 String.length
r > l && String.sub
r 0 l = p
6640 defconf
.sliceheight
<- 1024;
6641 defconf
.texcount
<- 32;
6642 defconf
.usepbo
<- true;
6646 match Unix.socketpair
Unix.PF_UNIX
Unix.SOCK_STREAM
0 with
6648 Printf.eprintf
"socketpair failed: %s" (exntos exn
);
6656 setcheckers conf
.checkers
;
6658 if conf
.redirectstderr
6662 (Buffer.to_bytes state
.errmsgs
)
6663 (match state
.errfd
with
6665 let s = Bytes.create
(80*24) in
6668 let r, _, _ = Unix.select
[fd
] [] [] 0.0 in
6670 then Unix.read fd
s 0 (Bytes.length
s)
6676 else Bytes.sub
s 0 n
6680 try ignore
(Unix.write state
.stderr
s 0 (Bytes.length
s))
6681 with exn
-> print_endline
(exntos exn
)
6686 conf
.angle
, conf
.fitmodel
, (conf
.trimmargins
, conf
.trimfuzz
),
6687 conf
.texcount
, conf
.sliceheight
, conf
.mustoresize
, conf
.colorspace
,
6688 !Config.fontpath
, !trimcachepath,
6689 GlMisc.check_extension
"GL_ARB_pixel_buffer_object",
6692 List.iter
GlArray.enable
[`texture_coord
; `vertex
];
6698 Wsi.settitle
"llpp (history)";
6702 state
.text <- "Opening " ^
(mbtoutf8 state
.path);
6703 opendoc state
.path state
.password;
6708 Sys.set_signal
Sys.sighup
(Sys.Signal_handle
(fun _ -> reload ()));
6711 if nonemptystr
!rcmdpath
6712 then remoteopen !rcmdpath
6717 let rec loop deadline
=
6719 if pidcount
.contents
> 0
6721 match Unix.wait
() with
6722 | (exception exn
) -> dolog
"Unix.wait: %s" @@ exntos exn
6729 match state
.errfd
with
6730 | None
-> [state
.ss; state
.wsfd]
6731 | Some fd
-> [state
.ss; state
.wsfd; fd
]
6736 | Some fd
-> fd
:: r
6740 state
.redisplay
<- false;
6747 if deadline
= infinity
6749 else max
0.0 (deadline
-. now)
6754 try Unix.select
r [] [] timeout
6755 with Unix.Unix_error
(Unix.EINTR
, _, _) -> [], [], []
6761 if state
.ghyll
== noghyll
6763 match state
.autoscroll
with
6764 | Some step
when step
!= 0 ->
6765 let y = state
.y + step
in
6769 else if y >= state
.maxy then 0 else y
6772 if state
.mode = View
6773 then state
.text <- E.s;
6776 else deadline
+. 0.01
6781 let rec checkfds = function
6783 | fd
:: rest
when fd
= state
.ss ->
6784 let cmd = readcmd state
.ss in
6788 | fd
:: rest
when fd
= state
.wsfd ->
6792 | fd
:: rest
when Some fd
= !optrfd ->
6793 begin match remote fd
with
6794 | None
-> optrfd := remoteopen !rcmdpath;
6795 | opt -> optrfd := opt
6800 let s = Bytes.create
80 in
6801 let n = tempfailureretry
(Unix.read fd
s 0) 80 in
6802 if conf
.redirectstderr
6804 Buffer.add_substring state
.errmsgs
(Bytes.to_string
s) 0 n;
6805 state
.newerrmsgs
<- true;
6806 state
.redisplay
<- true;
6809 prerr_string
(String.sub
(Bytes.to_string
s) 0 n);
6815 if !reeenterhist then (
6817 reeenterhist := false;
6821 if deadline
= infinity
6825 match state
.autoscroll
with
6826 | Some step
when step
!= 0 -> deadline1
6827 | _ -> if state
.ghyll
== noghyll
then infinity
else deadline1
6835 Config.save leavebirdseye;
6836 if hasunsavedchanges
()