6 type pipe
= (Unix.file_descr
* Unix.file_descr
);;
8 external init
: pipe
-> params
-> unit = "ml_init";;
9 external seltext
: opaque
-> (int * int * int * int) -> unit = "ml_seltext";;
10 external hassel
: opaque
-> bool = "ml_hassel";;
11 external copysel
: Unix.file_descr
-> opaque
-> unit = "ml_copysel";;
12 external getpdimrect
: int -> float array
= "ml_getpdimrect";;
13 external whatsunder
: opaque
-> int -> int -> under
= "ml_whatsunder";;
14 external markunder
: opaque
-> int -> int -> mark
-> bool = "ml_markunder";;
15 external clearmark
: opaque
-> unit = "ml_clearmark";;
16 external zoomforh
: int -> int -> int -> int -> float = "ml_zoom_for_height";;
17 external drawstr
: int -> int -> int -> string -> float = "ml_draw_string";;
18 external measurestr
: int -> string -> float = "ml_measure_string";;
19 external postprocess
:
20 opaque
-> int -> int -> int -> (int * string * int) -> int
22 external pagebbox
: opaque
-> (int * int * int * int) = "ml_getpagebox";;
23 external setaalevel
: int -> unit = "ml_setaalevel";;
24 external realloctexts
: int -> bool = "ml_realloctexts";;
25 external findlink
: opaque
-> linkdir
-> link
= "ml_findlink";;
26 external getlink
: opaque
-> int -> under
= "ml_getlink";;
27 external getlinkrect
: opaque
-> int -> irect
= "ml_getlinkrect";;
28 external getlinkcount
: opaque
-> int = "ml_getlinkcount";;
29 external findpwl
: int -> int -> pagewithlinks
= "ml_find_page_with_links"
30 external getpbo
: width
-> height
-> colorspace
-> opaque
= "ml_getpbo";;
31 external freepbo
: opaque
-> unit = "ml_freepbo";;
32 external unmappbo
: opaque
-> unit = "ml_unmappbo";;
33 external pbousable
: unit -> bool = "ml_pbo_usable";;
34 external unproject
: opaque
-> int -> int -> (int * int) option
36 external drawtile
: tileparams
-> opaque
-> unit = "ml_drawtile";;
37 external rectofblock
: opaque
-> int -> int -> float array
option
39 external begintiles
: unit -> unit = "ml_begintiles";;
40 external endtiles
: unit -> unit = "ml_endtiles";;
42 let reeenterhist = ref false;;
43 let selfexec = ref E.s
;;
45 let drawstring size x y s
=
47 Gl.enable `texture_2d
;
48 GlFunc.blend_func `src_alpha `one_minus_src_alpha
;
49 ignore
(drawstr size x y s
);
51 Gl.disable `texture_2d
;
54 let drawstring1 size x y s
=
58 let drawstring2 size x y fmt
=
59 Printf.kprintf
(drawstring size
(x
+1) (y
+size
+1)) fmt
63 dolog
"l %d dim=%d {" l
.pageno l
.pagedimno
;
64 dolog
" WxH %dx%d" l
.pagew l
.pageh
;
65 dolog
" vWxH %dx%d" l
.pagevw l
.pagevh
;
66 dolog
" pagex,y %d,%d" l
.pagex l
.pagey
;
67 dolog
" dispx,y %d,%d" l
.pagedispx l
.pagedispy
;
68 dolog
" column %d" l
.pagecol
;
72 let debugrect (x0
, y0
, x1
, y1
, x2
, y2
, x3
, y3
) =
74 dolog
" x0,y0=(% f, % f)" x0 y0
;
75 dolog
" x1,y1=(% f, % f)" x1 y1
;
76 dolog
" x2,y2=(% f, % f)" x2 y2
;
77 dolog
" x3,y3=(% f, % f)" x3 y3
;
81 let isbirdseye = function Birdseye _
-> true | _
-> false;;
82 let istextentry = function Textentry _
-> true | _
-> false;;
84 let wtmode = ref false;;
85 let cxack = ref false;;
87 let pgscale h
= truncate
(float h
*. conf
.pgscale);;
90 if (conf
.scrollb
land scrollbhv
= 0)
91 || (state
.x
= 0 && state
.w
<= state
.winw
- conf
.scrollbw
)
97 if (conf
.scrollb
land scrollbvv
= 0)
102 let wadjsb w
= w
- vscrollw ();;
103 let xadjsb x
= if conf
.leftscroll
then x
+ vscrollw () else x
;;
106 fstate
.fontsize
<- n
;
107 fstate
.wwidth
<- measurestr fstate
.fontsize
"w";
108 fstate
.maxrows
<- (state
.winh
- fstate
.fontsize
- 1) / (fstate
.fontsize
+ 1);
114 Printf.kprintf prerr_endline fmt
116 Printf.kprintf ignore fmt
120 if emptystr conf
.pathlauncher
121 then print_endline state
.path
123 let re = Str.regexp
"%s" in
124 let command = Str.global_replace
re state
.path conf
.pathlauncher
in
127 Printf.eprintf
"failed to execute `%s': %s\n" command (exntos exn
);
133 type 'a t
= | Res
of 'a
| Exn
of exn
;;
141 try tempfailureretry
Unix.close fd
142 with exn
-> f
(exntos exn
)
146 try Res
(tempfailureretry
Unix.dup fd
)
151 try Res
(tempfailureretry
(Unix.dup2 fd1
) fd2
)
156 let redirectstderr () =
157 let clofail what errmsg
= dolog
"failed to close %s: %s" what errmsg
in
158 if conf
.redirectstderr
160 match Ne.res Unix.pipe
with
162 dolog
"failed to create stderr redirection pipes: %s" (exntos exn
)
165 begin match Ne.dup Unix.stderr
with
167 dolog
"failed to dup stderr: %s" (exntos exn
);
168 Ne.clo r
(clofail "pipe/r");
169 Ne.clo w
(clofail "pipe/w");
171 | Ne.Res dupstderr
->
172 begin match Ne.dup2 w
Unix.stderr
with
174 dolog
"failed to dup2 to stderr: %s" (exntos exn
);
175 Ne.clo dupstderr
(clofail "stderr duplicate");
176 Ne.clo r
(clofail "redir pipe/r");
177 Ne.clo w
(clofail "redir pipe/w");
180 state
.stderr
<- dupstderr
;
181 state
.errfd
<- Some r
;
185 state
.newerrmsgs
<- false;
186 begin match state
.errfd
with
188 begin match Ne.dup2 state
.stderr
Unix.stderr
with
190 dolog
"failed to dup2 original stderr: %s" (exntos exn
)
192 Ne.clo fd
(clofail "dup of stderr");
197 prerr_string
(Buffer.contents state
.errmsgs
);
199 Buffer.clear state
.errmsgs
;
205 let postRedisplay who
=
207 then prerr_endline
("redisplay for " ^ who
);
208 state
.redisplay
<- true;
212 let getopaque pageno
=
213 try Some
(Hashtbl.find state
.pagemap
(pageno
, state
.gen
))
214 with Not_found
-> None
217 let putopaque pageno opaque
=
218 Hashtbl.replace state
.pagemap
(pageno
, state
.gen
) opaque
221 let pagetranslatepoint l x y
=
222 let dy = y
- l
.pagedispy
in
223 let y = dy + l
.pagey
in
224 let dx = x
- l
.pagedispx
in
225 let x = dx + l
.pagex
in
229 let onppundermouse g
x y d
=
232 begin match getopaque l
.pageno
with
234 let x0 = l
.pagedispx
in
235 let x1 = x0 + l
.pagevw
in
236 let y0 = l
.pagedispy
in
237 let y1 = y0 + l
.pagevh
in
238 if y >= y0 && y <= y1 && x >= x0 && x <= x1
240 let px, py
= pagetranslatepoint l
x y in
241 match g opaque l
px py
with
254 let g opaque l
px py
=
257 match rectofblock opaque
px py
with
259 let rect = (a
.(0),a
.(2),a
.(1),a
.(2),a
.(1),a
.(3),a
.(0),a
.(3)) in
260 state
.rects
<- [l
.pageno
, l
.pageno
mod 3, rect];
261 G.postRedisplay "getunder";
264 match whatsunder opaque
px py
with
266 | under
-> Some under
268 onppundermouse g x y Unone
273 match unproject opaque
x y with
274 | Some
(x, y) -> Some
(Some
(l
.pageno
, x, y))
277 onppundermouse g x y None
;
281 state
.text
<- Printf.sprintf
"%c%s" c s
;
282 G.postRedisplay "showtext";
285 let pipesel opaque cmd
=
288 match Ne.res Unix.pipe
with
291 (Printf.sprintf
"pipesel can not create pipe: %s" (exntos exn
));
293 let doclose what fd
=
294 Ne.clo fd
(fun msg
-> dolog
"%s close failed: %s" what msg
)
297 try popen cmd
[r
, 0; w
, -1]; true
299 dolog
"can not execute %S: %s" cmd
(exntos exn
);
305 G.postRedisplay "pipesel";
307 else doclose "pipesel pipe/w" w
;
308 doclose "pipesel pipe/r" r
;
312 let g opaque l
px py
=
313 if markunder opaque
px py conf
.paxmark
316 match getopaque l
.pageno
with
318 | Some opaque
-> pipesel opaque conf
.paxcmd
323 G.postRedisplay "paxunder";
324 if conf
.paxmark
= Mark_page
327 match getopaque l
.pageno
with
329 | Some opaque
-> clearmark opaque
) state
.layout
;
331 onppundermouse g x y (fun () -> showtext '
!'
"Whoopsie daisy");
335 match Ne.res Unix.pipe
with
337 showtext '
!'
(Printf.sprintf
"pipe failed: %s" (exntos exn
))
340 Ne.clo fd
(fun msg
->
341 showtext '
!'
(Printf.sprintf
"failed to close %s: %s" cap msg
)
345 try popen conf
.selcmd
[r
, 0; w
, -1]; true
348 (Printf.sprintf
"failed to execute %s: %s"
349 conf
.selcmd
(exntos exn
));
355 let l = String.length s
in
356 let n = tempfailureretry
(Unix.write w s
0) l in
361 "failed to write %d characters to sel pipe, wrote %d"
366 (Printf.sprintf
"failed to write to sel pipe: %s"
371 clo "selstring pipe/r" r
;
372 clo "selstring pipe/w" w
;
375 let undertext = function
378 | Ulinkgoto
(pageno
, _
) -> Printf.sprintf
"%s: page %d" state
.path
(pageno
+1)
379 | Utext s
-> "font: " ^ s
380 | Uunexpected s
-> "unexpected: " ^ s
381 | Ulaunch s
-> "launch: " ^ s
382 | Unamed s
-> "named: " ^ s
383 | Uremote
(filename
, pageno
) ->
384 Printf.sprintf
"%s: page %d" filename
(pageno
+1)
385 | Uremotedest
(filename
, destname
) ->
386 Printf.sprintf
"%s: destination %S" filename destname
389 let updateunder x y =
390 match getunder x y with
391 | Unone
-> Wsi.setcursor
Wsi.CURSOR_INHERIT
393 if conf
.underinfo
then showtext 'u'
("ri: " ^ uri
);
394 Wsi.setcursor
Wsi.CURSOR_INFO
395 | Ulinkgoto
(pageno
, _
) ->
397 then showtext 'p'
("age: " ^ string_of_int
(pageno
+1));
398 Wsi.setcursor
Wsi.CURSOR_INFO
400 if conf
.underinfo
then showtext '
f'
("ont: " ^ s
);
401 Wsi.setcursor
Wsi.CURSOR_TEXT
403 if conf
.underinfo
then showtext 'u'
("nexpected: " ^ s
);
404 Wsi.setcursor
Wsi.CURSOR_INHERIT
406 if conf
.underinfo
then showtext '
l'
("aunch: " ^ s
);
407 Wsi.setcursor
Wsi.CURSOR_INHERIT
409 if conf
.underinfo
then showtext '
n'
("amed: " ^ s
);
410 Wsi.setcursor
Wsi.CURSOR_INHERIT
411 | Uremote
(filename
, pageno
) ->
412 if conf
.underinfo
then showtext 'r'
413 (Printf.sprintf
"emote: %s (%d)" filename
(pageno
+1));
414 Wsi.setcursor
Wsi.CURSOR_INFO
415 | Uremotedest
(filename
, destname
) ->
416 if conf
.underinfo
then showtext 'r'
417 (Printf.sprintf
"emote destination: %s (%S)" filename destname
);
418 Wsi.setcursor
Wsi.CURSOR_INFO
421 let showlinktype under
=
427 let s = undertext under
in
432 let b = Buffer.create
(String.length
s + 1) in
433 Buffer.add_string
b s;
438 let intentry_with_suffix text key
=
440 if key
>= 32 && key
< 127
444 match Char.lowercase
c with
446 let text = addchar text c in
450 let text = addchar text c in
454 state
.text <- Printf.sprintf
"invalid char (%d, `%c')" key
c;
460 let n = tempfailureretry
(Unix.read fd
s 0) 4 in
461 if n != 4 then error
"incomplete read(len) = %d" n;
463 lor (Char.code
s.[0] lsl 24)
464 lor (Char.code
s.[1] lsl 16)
465 lor (Char.code
s.[2] lsl 8)
466 lor (Char.code
s.[3] lsl 0)
468 let s = String.create
len in
469 let n = tempfailureretry
(Unix.read fd
s 0) len in
470 if n != len then error
"incomplete read(data) %d vs %d" n len;
474 let btod b = if b then 1 else 0;;
477 let b = Buffer.create
16 in
478 Buffer.add_string
b "llll";
481 let s = Buffer.contents
b in
482 let n = String.length
s in
484 (* dolog "wcmd %S" (String.sub s 4 len); *)
485 s.[0] <- Char.chr
((len lsr 24) land 0xff);
486 s.[1] <- Char.chr
((len lsr 16) land 0xff);
487 s.[2] <- Char.chr
((len lsr 8) land 0xff);
488 s.[3] <- Char.chr
(len land 0xff);
489 let n'
= tempfailureretry
(Unix.write state
.sw
s 0) n in
490 if n'
!= n then error
"write failed %d vs %d" n'
n;
494 let nogeomcmds cmds
=
496 | s, [] -> emptystr
s
500 let layoutN ((columns
, coverA
, coverB
), b) y sh
=
501 let sh = sh - (hscrollh ()) in
502 let rec fold accu
n =
503 if n = Array.length
b
506 let pdimno, dx, vy
, (_
, w
, h
, xoff
) = b.(n) in
509 || n = state
.pagecount
- coverB
510 || (n - coverA
) mod columns
= columns
- 1)
516 let pagey = max
0 (y - vy
) in
517 let pagedispy = if pagey > 0 then 0 else vy
- y in
518 let pagedispx, pagex
=
520 if n = coverA
- 1 || n = state
.pagecount
- coverB
521 then state
.x + (wadjsb state
.winw
- w
) / 2
522 else dx + xoff
+ state
.x
529 let vw = wadjsb state
.winw
- pagedispx in
530 let pw = w
- pagex
in
533 let pagevh = min
(h
- pagey) (sh - pagedispy) in
534 if pagevw > 0 && pagevh > 0
545 ; pagedispx = pagedispx
546 ; pagedispy = pagedispy
558 if Array.length
b = 0
560 else List.rev
(fold [] (page_of_y
y))
563 let layoutS (columns
, b) y sh =
564 let sh = sh - hscrollh () in
565 let rec fold accu n =
566 if n = Array.length
b
569 let pdimno, px, vy
, (_
, pagew
, pageh
, xoff
) = b.(n) in
576 let x = xoff
+ state
.x in
577 let pagey = max
0 (y - vy
) in
578 let pagedispy = if pagey > 0 then 0 else vy
- y in
579 let pagedispx, pagex
=
593 let pagecolw = pagew
/columns
in
595 if pagecolw < state
.winw
596 then pagedispx + ((wadjsb state
.winw
- pagecolw) / 2)
600 let vw = wadjsb state
.winw
- pagedispx in
601 let pw = pagew
- pagex
in
604 let pagevw = min
pagevw pagecolw in
605 let pagevh = min
(pageh
- pagey) (sh - pagedispy) in
606 if pagevw > 0 && pagevh > 0
617 ; pagedispx = pagedispx
618 ; pagedispy = pagedispy
619 ; pagecol
= n mod columns
634 if nogeomcmds state
.geomcmds
636 match conf
.columns
with
637 | Csingle
b -> layoutN ((1, 0, 0), b) y sh
638 | Cmulti
c -> layoutN c y sh
639 | Csplit
s -> layoutS s y sh
644 let y = state
.y + incr
in
646 let y = min
y (state
.maxy
- (if conf
.maxhfit
then state
.winh
else 0)) in
651 let tilex = l.pagex
mod conf
.tilew
in
652 let tiley = l.pagey mod conf
.tileh
in
654 let col = l.pagex
/ conf
.tilew
in
655 let row = l.pagey / conf
.tileh
in
657 let rec rowloop row y0 dispy h
=
661 let dh = conf
.tileh
- y0 in
663 let rec colloop col x0 dispx w
=
667 let dw = conf
.tilew
- x0 in
669 let dispx'
= xadjsb dispx in
670 f col row dispx' dispy
x0 y0 dw dh;
671 colloop (col+1) 0 (dispx+dw) (w
-dw)
674 colloop col tilex l.pagedispx l.pagevw;
675 rowloop (row+1) 0 (dispy
+dh) (h
-dh)
678 if l.pagevw > 0 && l.pagevh > 0
679 then rowloop row tiley l.pagedispy l.pagevh;
682 let gettileopaque l col row =
684 l.pageno
, state
.gen
, conf
.colorspace
, conf
.angle
, l.pagew
, l.pageh
, col, row
686 try Some
(Hashtbl.find state
.tilemap
key)
687 with Not_found
-> None
690 let puttileopaque l col row gen colorspace angle opaque size elapsed
=
691 let key = l.pageno
, gen
, colorspace
, angle
, l.pagew
, l.pageh
, col, row in
692 Hashtbl.add state
.tilemap
key (opaque
, size
, elapsed
)
695 let filledrect x0 y0 x1 y1 =
696 GlArray.disable `texture_coord
;
697 Raw.sets_float state
.vraw ~pos
:0 [| x0; y0; x0; y1; x1; y0; x1; y1 |];
698 GlArray.vertex `two state
.vraw
;
699 GlArray.draw_arrays `triangle_strip
0 4;
700 GlArray.enable `texture_coord
;
703 let linerect x0 y0 x1 y1 =
704 GlArray.disable `texture_coord
;
705 Raw.sets_float state
.vraw ~pos
:0 [| x0; y0; x0; y1; x1; y1; x1; y0 |];
706 GlArray.vertex `two state
.vraw
;
707 GlArray.draw_arrays `line_loop
0 4;
708 GlArray.enable `texture_coord
;
711 let drawtiles l color
=
714 let f col row x y tilex tiley w h
=
715 match gettileopaque l col row with
716 | Some
(opaque
, _
, t
) ->
717 let params = x, y, w
, h
, tilex, tiley in
719 then GlTex.env
(`mode `blend
);
720 drawtile
params opaque
;
722 then GlTex.env
(`mode `modulate
);
726 let s = Printf.sprintf
730 let w = measurestr fstate
.fontsize
s in
731 GlDraw.color
(0.0, 0.0, 0.0);
732 filledrect (float (x-2))
735 (float (y + fstate
.fontsize
+ 2));
736 GlDraw.color
(1.0, 1.0, 1.0);
737 drawstring fstate
.fontsize
x (y + fstate
.fontsize
- 1) s;
747 let lw = wadjsb state
.winw
- x in
750 let lh = state
.winh
- y in
754 then GlTex.env
(`mode `blend
);
755 begin match state
.checkerstexid
with
757 Gl.enable `texture_2d
;
758 GlTex.bind_texture `texture_2d id
;
762 and y1 = float (y+h
) in
764 let tw = float w /. 16.0
765 and th
= float h
/. 16.0 in
766 let tx0 = float tilex /. 16.0
767 and ty0
= float tiley /. 16.0 in
769 and ty1
= ty0
+. th
in
770 Raw.sets_float state
.vraw ~pos
:0
771 [| x0; y0; x0; y1; x1; y0; x1; y1 |];
772 Raw.sets_float state
.traw ~pos
:0
773 [| tx0; ty0
; tx0; ty1
; tx1; ty0
; tx1; ty1
|];
774 GlArray.vertex `two state
.vraw
;
775 GlArray.tex_coord `two state
.traw
;
776 GlArray.draw_arrays `triangle_strip
0 4;
777 Gl.disable `texture_2d
;
780 GlDraw.color
(1.0, 1.0, 1.0);
781 filledrect (float x) (float y) (float (x+w)) (float (y+h
));
784 then GlTex.env
(`mode `modulate
);
785 if w > 128 && h
> fstate
.fontsize
+ 10
787 let c = if conf
.invert
then 1.0 else 0.0 in
788 GlDraw.color
(c, c, c);
791 then (col*conf
.tilew
, row*conf
.tileh
)
794 drawstring2 fstate
.fontsize
x y "Loading %d [%d,%d]" l.pageno
c r
;
803 let pagevisible layout n = List.exists
(fun l -> l.pageno
= n) layout;;
805 let tilevisible1 l x y =
807 and ax1
= l.pagex
+ l.pagevw
809 and ay1
= l.pagey + l.pagevh in
813 let bx1 = min
(bx0 + conf
.tilew
) l.pagew
814 and by1
= min
(by0
+ conf
.tileh
) l.pageh
in
816 let rx0 = max
ax0 bx0
817 and ry0
= max ay0 by0
818 and rx1
= min ax1
bx1
819 and ry1
= min ay1 by1
in
821 let nonemptyintersection = rx1
> rx0 && ry1
> ry0
in
825 let tilevisible layout n x y =
826 let rec findpageinlayout m
= function
827 | l :: rest
when l.pageno
= n ->
828 tilevisible1 l x y || (
829 match conf
.columns
with
830 | Csplit
(c, _
) when c > m
-> findpageinlayout (m
+1) rest
833 | _
:: rest
-> findpageinlayout 0 rest
836 findpageinlayout 0 layout;
839 let tileready l x y =
840 tilevisible1 l x y &&
841 gettileopaque l (x/conf
.tilew
) (y/conf
.tileh
) != None
844 let tilepage n p
layout =
845 let rec loop = function
849 let f col row _ _ _ _ _ _
=
850 if state
.currently
= Idle
852 match gettileopaque l col row with
855 let x = col*conf
.tilew
856 and y = row*conf
.tileh
in
858 let w = l.pagew
- x in
862 let h = l.pageh
- y in
867 then getpbo
w h conf
.colorspace
870 wcmd "tile %s %d %d %d %d %s"
871 (~
> p
) x y w h (~
> pbo);
874 l, p
, conf
.colorspace
, conf
.angle
,
875 state
.gen
, col, row, conf
.tilew
, conf
.tileh
884 if nogeomcmds state
.geomcmds
888 let preloadlayout y =
889 let y = if y < state
.winh
then 0 else y - state
.winh
in
890 let h = state
.winh
*3 in
896 if state
.currently
!= Idle
901 begin match getopaque l.pageno
with
903 wcmd "page %d %d" l.pageno
l.pagedimno
;
904 state
.currently
<- Loading
(l, state
.gen
);
906 tilepage l.pageno opaque pages
;
911 if nogeomcmds state
.geomcmds
917 if conf
.preload && state
.currently
= Idle
918 then load (preloadlayout state
.y);
921 let layoutready layout =
922 let rec fold all ls
=
925 let seen = ref false in
926 let allvisible = ref true in
927 let foo col row _ _ _ _ _ _
=
929 allvisible := !allvisible &&
930 begin match gettileopaque l col row with
936 fold (!seen && !allvisible) rest
939 let alltilesvisible = fold true layout in
944 let y = bound
y 0 state
.maxy
in
945 let y, layout, proceed
=
946 match conf
.maxwait
with
947 | Some time
when state
.ghyll
== noghyll
->
948 begin match state
.throttle
with
950 let layout = layout y state
.winh
in
951 let ready = layoutready layout in
955 state
.throttle
<- Some
(layout, y, now
());
957 else G.postRedisplay "gotoy showall (None)";
959 | Some
(_
, _
, started
) ->
960 let dt = now
() -. started
in
963 state
.throttle
<- None
;
964 let layout = layout y state
.winh
in
966 G.postRedisplay "maxwait";
973 let layout = layout y state
.winh
in
974 if not
!wtmode || layoutready layout
975 then G.postRedisplay "gotoy ready";
981 state
.layout <- layout;
982 begin match state
.mode
with
983 | LinkNav
(Ltexact
(pageno
, linkno
)) ->
984 let rec loop = function
986 state
.mode
<- LinkNav
(Ltgendir
0)
987 | l :: _
when l.pageno
= pageno
->
988 begin match getopaque pageno
with
990 state
.mode
<- LinkNav
(Ltgendir
0)
992 let x0, y0, x1, y1 = getlinkrect opaque linkno
in
993 if not
(x0 >= l.pagex
&& x1 <= l.pagex
+ l.pagevw
994 && y0 >= l.pagey && y1 <= l.pagey + l.pagevh)
995 then state
.mode
<- LinkNav
(Ltgendir
0)
997 | _
:: rest
-> loop rest
1002 begin match state
.mode
with
1003 | Birdseye
(conf
, leftx
, pageno
, hooverpageno
, anchor
) ->
1004 if not
(pagevisible layout pageno
)
1006 match state
.layout with
1009 state
.mode
<- Birdseye
(
1010 conf
, leftx
, l.pageno
, hooverpageno
, anchor
1013 | LinkNav
(Ltgendir dir
as lt
) ->
1015 let rec loop = function
1018 match getopaque l.pageno
with
1024 then LDfirstvisible
(l.pagex
, l.pagey, dir
)
1026 if dir
> 0 then LDfirst
else LDlast
1032 | Lnotfound
-> loop rest
1034 showlinktype (getlink opaque
n);
1035 Ltexact
(l.pageno
, n)
1039 state
.mode
<- LinkNav
linknav
1044 state
.ghyll
<- noghyll
;
1047 let mx, my
= state
.mpos
in
1052 let conttiling pageno opaque
=
1053 tilepage pageno opaque
1054 (if conf
.preload then preloadlayout state
.y else state
.layout)
1057 let gotoy_and_clear_text y =
1058 if not conf
.verbose
then state
.text <- E.s;
1062 let getanchory (n, top
, dtop
) =
1063 let y, h = getpageyh
n in
1064 if conf
.presentation
1066 let ips = calcips
h in
1067 y + truncate
(top
*.float h -. dtop
*.float ips) + ips;
1069 y + truncate
(top
*.float h -. dtop
*.float conf
.interpagespace
)
1072 let gotoanchor anchor
=
1073 gotoy (getanchory anchor
);
1077 cbput state
.hists
.nav
(getanchor
());
1081 let anchor = cbgetc state
.hists
.nav dir
in
1085 let gotoghyll1 single
y =
1086 let scroll f n a
b =
1087 (* http://devmaster.net/forums/topic/9796-ease-in-ease-out-algorithm/ *)
1089 let s x = 3.0*.x**2.0 -. 2.0*.x**3.0 in
1091 then s (float f /. float a
)
1094 then 1.0 -. s ((float (f-b) /. float (n-b)))
1100 let ins = float a
*. 0.5
1101 and outs
= float (n-b) *. 0.5 in
1103 ins +. outs
+. float ones
1105 let rec set nab
y sy
=
1106 let (_N
, _A
, _B
), y =
1109 let scl = if y > sy
then 2 else -2 in
1110 let _N, _
, _
= nab
in
1111 (_N,0,_N), y+conf
.scrollstep
*scl
1113 let sum = summa
_N _A _B
in
1114 let dy = float (y - sy
) in
1118 then state
.ghyll
<- noghyll
1121 let s = scroll n _N _A _B
in
1122 let y1 = y1 +. ((s *. dy) /. sum) in
1123 gotoy_and_clear_text (truncate
y1);
1124 state
.ghyll
<- gf (n+1) y1;
1128 | Some
y'
when single
-> set nab
y' state
.y
1129 | Some
y'
-> set (_N/2, 1, 1) y' state
.y
1131 gf 0 (float state
.y)
1134 match conf
.ghyllscroll
with
1135 | Some nab
when not conf
.presentation
->
1136 if state
.ghyll
== noghyll
1137 then set nab
y state
.y
1138 else state
.ghyll
(Some
y)
1140 gotoy_and_clear_text y
1143 let gotoghyll = gotoghyll1 false;;
1145 let gotopage n top
=
1146 let y, h = getpageyh
n in
1147 let y = y + (truncate
(top
*. float h)) in
1151 let gotopage1 n top
=
1152 let y = getpagey
n in
1157 let invalidate s f =
1162 match state
.geomcmds
with
1163 | ps
, [] when emptystr ps
->
1165 state
.geomcmds
<- s, [];
1168 state
.geomcmds
<- ps
, [s, f];
1170 | ps
, (s'
, _
) :: rest
when s'
= s ->
1171 state
.geomcmds
<- ps
, ((s, f) :: rest
);
1174 state
.geomcmds
<- ps
, ((s, f) :: cmds
);
1178 Hashtbl.iter
(fun _ opaque
->
1179 wcmd "freepage %s" (~
> opaque
);
1181 Hashtbl.clear state
.pagemap
;
1185 if not
(Queue.is_empty state
.tilelru
)
1187 Queue.iter
(fun (k
, p
, s) ->
1188 wcmd "freetile %s" (~
> p
);
1189 state
.memused
<- state
.memused
- s;
1190 Hashtbl.remove state
.tilemap k
;
1192 state
.uioh#infochanged Memused
;
1193 Queue.clear state
.tilelru
;
1199 let h = truncate
(float h*.conf
.zoom
) in
1200 let d = conf
.interpagespace
lsl (if conf
.presentation
then 1 else 0) in
1204 let opendoc path password
=
1206 state
.password
<- password
;
1207 state
.gen
<- state
.gen
+ 1;
1208 state
.docinfo
<- [];
1211 setaalevel conf
.aalevel
;
1213 if emptystr state
.origin
1217 Wsi.settitle
("llpp " ^
(mbtoutf8
(Filename.basename
titlepath)));
1218 wcmd "open %d %d %s\000%s\000" (btod !wtmode) (btod !cxack) path password
;
1219 invalidate "reqlayout"
1221 wcmd "reqlayout %d %d %d %s\000"
1222 conf
.angle
(FMTE.to_int conf
.fitmodel
)
1223 (stateh state
.winh
) state
.nameddest
1228 state
.anchor <- getanchor
();
1229 opendoc state
.path state
.password
;
1233 let c = c *. conf
.colorscale
in
1237 let scalecolor2 (r
, g, b) =
1238 (r
*. conf
.colorscale
, g *. conf
.colorscale
, b *. conf
.colorscale
);
1241 let docolumns = function
1243 let a = Array.make state
.pagecount
(-1, -1, -1, (-1, -1, -1, -1)) in
1244 let rec loop pageno
pdimno pdim
y ph pdims
=
1245 if pageno
= state
.pagecount
1248 let pdimno, ((_
, w, h, xoff
) as pdim
), pdims
=
1250 | ((pageno'
, _
, _
, _
) as pdim
) :: rest
when pageno'
= pageno
->
1251 pdimno+1, pdim
, rest
1255 let x = max
0 (((wadjsb state
.winw
- w) / 2) - xoff
) in
1257 (if conf
.presentation
1258 then (if pageno
= 0 then calcips
h else calcips ph
+ calcips
h)
1259 else (if pageno
= 0 then 0 else conf
.interpagespace
)
1262 a.(pageno
) <- (pdimno, x, y, pdim
);
1263 loop (pageno
+1) pdimno pdim
(y + h) h pdims
1265 loop 0 ~
-1 (-1,-1,-1,-1) 0 0 state
.pdims
;
1266 conf
.columns
<- Csingle
a;
1268 | Cmulti
((columns
, coverA
, coverB
), _
) ->
1269 let a = Array.make state
.pagecount
(-1, -1, -1, (-1, -1, -1, -1)) in
1270 let rec loop pageno
pdimno pdim
x y rowh pdims
=
1271 let rec fixrow m
= if m
= pageno
then () else
1272 let (pdimno, x, y, ((_
, _
, h, _
) as pdim
)) = a.(m
) in
1275 let y = y + (rowh
- h) / 2 in
1276 a.(m
) <- (pdimno, x, y, pdim
);
1280 if pageno
= state
.pagecount
1281 then fixrow (((pageno
- 1) / columns
) * columns
)
1283 let pdimno, ((_
, w, h, xoff
) as pdim
), pdims
=
1285 | ((pageno'
, _
, _
, _
) as pdim
) :: rest
when pageno'
= pageno
->
1286 pdimno+1, pdim
, rest
1291 if pageno
= coverA
- 1 || pageno
= state
.pagecount
- coverB
1293 let x = (wadjsb state
.winw
- w) / 2 in
1295 if conf
.presentation
then calcips
h else conf
.interpagespace
in
1296 x, y + ips + rowh
, h
1299 if (pageno
- coverA
) mod columns
= 0
1301 let x = max
0 (wadjsb state
.winw
- state
.w) / 2 in
1303 if conf
.presentation
1305 let ips = calcips
h in
1306 y + (if pageno
= 0 then 0 else calcips rowh
+ ips)
1308 y + (if pageno
= 0 then 0 else conf
.interpagespace
)
1312 else x, y, max rowh
h
1316 if pageno
> 1 && (pageno
- coverA
) mod columns
= 0
1319 if pageno
= columns
&& conf
.presentation
1321 let ips = calcips rowh
in
1322 for i
= 0 to pred columns
1324 let (pdimno, x, y, pdim
) = a.(i
) in
1325 a.(i
) <- (pdimno, x, y+ips, pdim
)
1331 fixrow (pageno
- columns
);
1336 a.(pageno
) <- (pdimno, x, y, pdim
);
1337 let x = x + w + xoff
*2 + conf
.interpagespace
in
1338 loop (pageno
+1) pdimno pdim
x y rowh' pdims
1340 loop 0 ~
-1 (-1,-1,-1,-1) 0 0 0 state
.pdims
;
1341 conf
.columns
<- Cmulti
((columns
, coverA
, coverB
), a);
1344 let a = Array.make
(state
.pagecount
*c) (-1, -1, -1, (-1, -1, -1, -1)) in
1345 let rec loop pageno
pdimno pdim
y pdims
=
1346 if pageno
= state
.pagecount
1349 let pdimno, ((_
, w, h, _
) as pdim
), pdims
=
1351 | ((pageno'
, _
, _
, _
) as pdim
) :: rest
when pageno'
= pageno
->
1352 pdimno+1, pdim
, rest
1357 let rec loop1 n x y =
1358 if n = c then y else (
1359 a.(pageno
*c + n) <- (pdimno, x, y, pdim
);
1360 loop1 (n+1) (x+cw) (y + h + conf
.interpagespace
)
1363 let y = loop1 0 0 y in
1364 loop (pageno
+1) pdimno pdim
y pdims
1366 loop 0 ~
-1 (-1,-1,-1,-1) 0 state
.pdims
;
1367 conf
.columns
<- Csplit
(c, a);
1371 docolumns conf
.columns
;
1372 state
.maxy
<- calcheight
();
1373 if state
.reprf
== noreprf
1375 match state
.mode
with
1376 | Birdseye
(_
, _
, pageno
, _
, _
) ->
1377 let y, h = getpageyh pageno
in
1378 let top = (state
.winh
- h) / 2 in
1379 gotoy (max
0 (y - top))
1380 | _
-> gotoanchor state
.anchor
1384 state
.reprf
<- noreprf
;
1389 GlDraw.viewport
0 0 w h;
1390 let firsttime = state
.geomcmds
== firstgeomcmds
in
1391 if not
firsttime && nogeomcmds state
.geomcmds
1392 then state
.anchor <- getanchor
();
1395 let w = wadjsb (truncate
(float w *. conf
.zoom
)) in
1398 setfontsize fstate
.fontsize
;
1399 GlMat.mode `modelview
;
1400 GlMat.load_identity
();
1402 GlMat.mode `projection
;
1403 GlMat.load_identity
();
1404 GlMat.rotate ~
x:1.0 ~angle
:180.0 ();
1405 GlMat.translate ~
x:~
-.1.0 ~
y:~
-.1.0 ();
1406 GlMat.scale3
(2.0 /. float state
.winw
, 2.0 /. float state
.winh
, 1.0);
1411 else float state
.x /. float state
.w
1413 invalidate "geometry"
1417 then state
.x <- truncate
(relx *. float w);
1419 match conf
.columns
with
1421 | Cmulti
((c, _
, _
), _
) -> (w - (c-1)*conf
.interpagespace
) / c
1422 | Csplit
(c, _
) -> w * c
1424 wcmd "geometry %d %d %d"
1425 w (stateh h) (FMTE.to_int conf
.fitmodel
)
1430 let len = String.length state
.text in
1431 let x0 = xadjsb 0 in
1434 match state
.mode
with
1435 | Textentry _
| View
| LinkNav _
->
1436 let h, _
, _
= state
.uioh#scrollpw
in
1441 filledrect x (float (state
.winh
- (fstate
.fontsize
+ 4) - hscrollh))
1442 (x+.w) (float (state
.winh
- hscrollh))
1445 let w = float (wadjsb state
.winw
- 1) in
1446 if state
.progress
>= 0.0 && state
.progress
< 1.0
1448 GlDraw.color
(0.3, 0.3, 0.3);
1449 let w1 = w *. state
.progress
in
1451 GlDraw.color
(0.0, 0.0, 0.0);
1452 rect (float x0+.w1) (float x0+.w-.w1)
1455 GlDraw.color
(0.0, 0.0, 0.0);
1459 GlDraw.color
(1.0, 1.0, 1.0);
1460 drawstring fstate
.fontsize
1461 (if conf
.leftscroll
then x0 else x0 + if len > 0 then 8 else 2)
1462 (state
.winh
- hscrollh - 5) s;
1465 match state
.mode
with
1466 | Textentry
((prefix
, text, _
, _
, _
, _
), _
) ->
1470 Printf.sprintf
"%s%s_ [%s]" prefix
text state
.text
1472 Printf.sprintf
"%s%s_" prefix
text
1481 if not
(istextentry state
.mode
) && state
.uioh#eformsgs
1483 let s1 = "(press 'e' to review error messasges)" in
1484 if nonemptystr
s then s ^
" " ^
s1 else s1
1494 let len = Queue.length state
.tilelru
in
1496 match state
.throttle
with
1499 then preloadlayout state
.y
1501 | Some
(layout, _
, _
) ->
1505 if state
.memused
<= conf
.memlimit
1510 let (k
, p
, s) as lruitem
= Queue.pop state
.tilelru
in
1511 let n, gen
, colorspace
, angle
, pagew
, pageh
, col, row = k
in
1512 let (_
, pw, ph
, _
) = getpagedim
n in
1515 && colorspace
= conf
.colorspace
1516 && angle
= conf
.angle
1520 let x = col*conf
.tilew
1521 and y = row*conf
.tileh
in
1522 tilevisible (Lazy.force_val
layout) n x y
1524 then Queue.push lruitem state
.tilelru
1527 wcmd "freetile %s" (~
> p
);
1528 state
.memused
<- state
.memused
- s;
1529 state
.uioh#infochanged Memused
;
1530 Hashtbl.remove state
.tilemap k
;
1538 let logcurrently = function
1539 | Idle
-> dolog
"Idle"
1540 | Loading
(l, gen
) ->
1541 dolog
"Loading %d gen=%d curgen=%d" l.pageno gen state
.gen
1542 | Tiling
(l, pageopaque
, colorspace
, angle
, gen
, col, row, tilew
, tileh
) ->
1544 "Tiling %d[%d,%d] page=%s cs=%s angle"
1545 l.pageno
col row (~
> pageopaque
)
1546 (CSTE.to_string colorspace
)
1548 dolog
"gen=(%d,%d) (%d,%d) tile=(%d,%d) (%d,%d)"
1549 angle gen conf
.angle state
.gen
1551 conf
.tilew conf
.tileh
1558 let r = Str.regexp
" " in
1559 fun s -> Str.bounded_split
r s 2;
1562 let onpagerect pageno
f =
1564 match conf
.columns
with
1565 | Cmulti
(_
, b) -> b
1567 | Csplit
(_
, b) -> b
1569 if pageno
>= 0 && pageno
< Array.length
b
1571 let (_
, _
, _
, (w, h, _
, _
)) = b.(pageno
) in
1575 let gotopagexy1 pageno
x y =
1576 let _,w1,h1
,leftx
= getpagedim pageno
in
1577 let top = y /. (float h1
) in
1578 let left = x /. (float w1) in
1579 let py, w, h = getpageywh pageno
in
1580 let wh = state
.winh
- hscrollh () in
1581 let x = left *. (float w) in
1582 let x = leftx
+ state
.x + truncate
x in
1584 if x < 0 || x >= wadjsb state
.winw
1588 let pdy = truncate
(top *. float h) in
1589 let y'
= py + pdy in
1590 let dy = y'
- state
.y in
1592 if x != state
.x || not
(dy > 0 && dy < wh)
1594 if conf
.presentation
1596 if abs
(py - y'
) > wh
1603 if state
.x != sx || state
.y != sy
1608 let ww = wadjsb state
.winw
in
1610 and qy
= pdy / wh in
1612 and y = py + qy
* wh in
1613 let x = if -x + ww > w1 then -(w1-ww) else x
1614 and y'
= if y + wh > state
.maxy
then state
.maxy
- wh else y in
1616 if conf
.presentation
1618 if abs
(py - y'
) > wh
1628 gotoy_and_clear_text y;
1630 else gotoy_and_clear_text state
.y;
1633 let gotopagexy pageno
x y =
1634 match state
.mode
with
1635 | Birdseye
_ -> gotopage pageno
0.0
1636 | _ -> gotopagexy1 pageno
x y
1640 (* dolog "%S" cmds; *)
1641 let cl = splitatspace cmds
in
1643 try Scanf.sscanf
s fmt
f
1645 dolog
"error processing '%S': %s" cmds
(exntos exn
);
1648 let addoutline outline
=
1649 match state
.currently
with
1650 | Outlining outlines
->
1651 state
.currently
<- Outlining
(outline
:: outlines
)
1652 | Idle
-> state
.currently
<- Outlining
[outline
]
1654 dolog
"invalid outlining state";
1655 logcurrently currently
1659 state
.uioh#infochanged Pdim
;
1662 | "clearrects" :: [] ->
1663 state
.rects
<- state
.rects1
;
1664 G.postRedisplay "clearrects";
1666 | "continue" :: args
:: [] ->
1667 let n = scan args
"%u" (fun n -> n) in
1668 state
.pagecount
<- n;
1669 begin match state
.currently
with
1671 state
.currently
<- Idle
;
1672 state
.outlines
<- Array.of_list
(List.rev
l)
1676 let cur, cmds
= state
.geomcmds
in
1678 then failwith
"umpossible";
1680 begin match List.rev cmds
with
1682 state
.geomcmds
<- E.s, [];
1683 state
.throttle
<- None
;
1687 state
.geomcmds
<- s, List.rev rest
;
1689 if conf
.maxwait
= None
&& not
!wtmode
1690 then G.postRedisplay "continue";
1692 | "title" :: args
:: [] ->
1696 | "msg" :: args
:: [] ->
1699 | "vmsg" :: args
:: [] ->
1701 then showtext ' ' args
1703 | "emsg" :: args
:: [] ->
1704 Buffer.add_string state
.errmsgs args
;
1705 state
.newerrmsgs
<- true;
1706 G.postRedisplay "error message"
1708 | "progress" :: args
:: [] ->
1709 let progress, text =
1712 f, String.sub args pos
(String.length args
- pos
))
1715 state
.progress <- progress;
1716 G.postRedisplay "progress"
1718 | "firstmatch" :: args
:: [] ->
1719 let pageno, c, x0, y0, x1, y1, x2
, y2
, x3
, y3
=
1720 scan args
"%u %d %f %f %f %f %f %f %f %f"
1721 (fun p
c x0 y0 x1 y1 x2 y2 x3 y3
->
1722 (p
, c, x0, y0, x1, y1, x2
, y2
, x3
, y3
))
1724 let xoff = float (xadjsb 0) in
1728 and x3
= x3
+. xoff in
1729 let y = (getpagey
pageno) + truncate
y0 in
1732 state
.rects1
<- [pageno, c, (x0, y0, x1, y1, x2
, y2
, x3
, y3
)]
1734 | "match" :: args
:: [] ->
1735 let pageno, c, x0, y0, x1, y1, x2
, y2
, x3
, y3
=
1736 scan args
"%u %d %f %f %f %f %f %f %f %f"
1737 (fun p
c x0 y0 x1 y1 x2 y2 x3 y3
->
1738 (p
, c, x0, y0, x1, y1, x2
, y2
, x3
, y3
))
1740 let xoff = float (xadjsb 0) in
1744 and x3
= x3
+. xoff in
1746 (pageno, c, (x0, y0, x1, y1, x2
, y2
, x3
, y3
)) :: state
.rects1
1748 | "page" :: args
:: [] ->
1749 let pageopaques, t
= scan args
"%s %f" (fun p t
-> p
, t
) in
1750 let pageopaque = ~
< pageopaques in
1751 begin match state
.currently
with
1752 | Loading
(l, gen
) ->
1753 vlog "page %d took %f sec" l.pageno t
;
1754 Hashtbl.replace state
.pagemap
(l.pageno, gen
) pageopaque;
1755 begin match state
.throttle
with
1757 let preloadedpages =
1759 then preloadlayout state
.y
1764 List.fold_left
(fun s l -> IntSet.add
l.pageno s)
1765 IntSet.empty
preloadedpages
1768 Hashtbl.fold (fun ((pageno, _) as key) opaque
accu ->
1769 if not
(IntSet.mem
pageno set)
1771 wcmd "freepage %s" (~
> opaque
);
1777 List.iter
(Hashtbl.remove state
.pagemap
) evictedpages;
1780 state
.currently
<- Idle
;
1783 tilepage l.pageno pageopaque state
.layout;
1785 load preloadedpages;
1786 if pagevisible state
.layout l.pageno
1787 && layoutready state
.layout
1788 then G.postRedisplay "page";
1791 | Some
(layout, _, _) ->
1792 state
.currently
<- Idle
;
1793 tilepage l.pageno pageopaque layout;
1798 dolog
"Inconsistent loading state";
1799 logcurrently state
.currently
;
1803 | "tile" :: args
:: [] ->
1804 let (x, y, opaques
, size
, t
) =
1805 scan args
"%u %u %s %u %f"
1806 (fun x y p size t
-> (x, y, p
, size
, t
))
1808 let opaque = ~
< opaques
in
1809 begin match state
.currently
with
1810 | Tiling
(l, pageopaque, cs
, angle
, gen
, col, row, tilew
, tileh
) ->
1811 vlog "tile %d [%d,%d] took %f sec" l.pageno col row t
;
1814 if tilew
!= conf
.tilew
|| tileh
!= conf
.tileh
1816 wcmd "freetile %s" (~
> opaque);
1817 state
.currently
<- Idle
;
1821 puttileopaque l col row gen cs angle
opaque size t
;
1822 state
.memused
<- state
.memused
+ size
;
1823 state
.uioh#infochanged Memused
;
1825 Queue.push
((l.pageno, gen
, cs
, angle
, l.pagew
, l.pageh
, col, row),
1826 opaque, size
) state
.tilelru
;
1829 match state
.throttle
with
1830 | None
-> state
.layout
1831 | Some
(layout, _, _) -> layout
1834 state
.currently
<- Idle
;
1836 && conf
.colorspace
= cs
1837 && conf
.angle
= angle
1838 && tilevisible layout l.pageno x y
1839 then conttiling l.pageno pageopaque;
1841 begin match state
.throttle
with
1843 preload state
.layout;
1845 && conf
.colorspace
= cs
1846 && conf
.angle
= angle
1847 && tilevisible state
.layout l.pageno x y
1848 && (not
!wtmode || layoutready state
.layout)
1849 then G.postRedisplay "tile nothrottle";
1851 | Some
(layout, y, _) ->
1852 let ready = layoutready layout in
1856 state
.layout <- layout;
1857 state
.throttle
<- None
;
1858 G.postRedisplay "throttle";
1865 dolog
"Inconsistent tiling state";
1866 logcurrently state
.currently
;
1870 | "pdim" :: args
:: [] ->
1871 let (n, w, h, _) as pdim
=
1872 scan args
"%u %u %u %u" (fun n w h x -> n, w, h, x)
1875 match conf
.fitmodel
, conf
.columns
with
1876 | (FitPage
| FitProportional
), Csplit
_ -> (n, w, h, 0)
1879 state
.uioh#infochanged Pdim
;
1880 state
.pdims
<- pdim :: state
.pdims
1882 | "o" :: args
:: [] ->
1883 let (l, n, t
, h, pos
) =
1884 scan args
"%u %u %d %u %n"
1885 (fun l n t
h pos
-> l, n, t
, h, pos
)
1887 let s = String.sub args pos
(String.length args
- pos
) in
1888 addoutline (s, l, Oanchor
(n, float t
/. float h, 0.0))
1890 | "ou" :: args
:: [] ->
1891 let (l, len, pos
) = scan args
"%u %u %n" (fun l len pos
-> l, len, pos
) in
1892 let s = String.sub args pos
len in
1893 let pos2 = pos
+ len + 1 in
1894 let uri = String.sub args
pos2 (String.length args
- pos2) in
1895 addoutline (s, l, Ouri
uri)
1897 | "on" :: args
:: [] ->
1898 let (l, pos
) = scan args
"%u %n" (fun l pos
-> l, pos
) in
1899 let s = String.sub args pos
(String.length args
- pos
) in
1900 addoutline (s, l, Onone
)
1902 | "a" :: args
:: [] ->
1904 scan args
"%u %d %d" (fun n l t
-> n, l, t
)
1906 state
.reprf
<- (fun () -> gotopagexy n (float l) (float t
))
1908 | "info" :: args
:: [] ->
1909 state
.docinfo
<- (1, args
) :: state
.docinfo
1911 | "infoend" :: [] ->
1912 state
.uioh#infochanged Docinfo
;
1913 state
.docinfo
<- List.rev state
.docinfo
1916 error
"unknown cmd `%S'" cmds
1921 let action = function
1922 | HCprev
-> cbget cb ~
-1
1923 | HCnext
-> cbget cb
1
1924 | HCfirst
-> cbget cb ~
-(cb
.rc)
1925 | HClast
-> cbget cb
(cb
.len - 1 - cb
.rc)
1926 and cancel
() = cb
.rc <- rc
1930 let search pattern forward
=
1931 match conf
.columns
with
1933 showtext '
!'
"searching does not work properly in split columns mode"
1935 if nonemptystr pattern
1938 match state
.layout with
1941 l.pageno, (l.pagey + if forward
then 0 else 0*l.pagevh)
1943 wcmd "search %d %d %d %d,%s\000"
1944 (btod conf
.icase
) pn py (btod forward
) pattern
;
1947 let intentry text key =
1949 if key >= 32 && key < 127
1955 let text = addchar text c in
1959 state
.text <- Printf.sprintf
"invalid char (%d, `%c')" key c;
1963 let linknentry text key =
1965 if key >= 32 && key < 127
1971 let text = addchar text c in
1975 state
.text <- Printf.sprintf
"invalid char (%d, `%c')" key c;
1983 let l = String.length
s in
1984 let rec loop pos
n = if pos
= l then n else
1985 let m = Char.code
s.[pos
] - (if pos
= 0 && l > 1 then 96 else 97) in
1986 loop (pos
+1) (n*26 + m)
1989 let rec loop n = function
1992 match getopaque l.pageno with
1993 | None
-> loop n rest
1995 let m = getlinkcount
opaque in
1998 let under = getlink
opaque n in
2001 else loop (n-m) rest
2003 loop n state
.layout;
2007 let textentry text key =
2008 if key land 0xff00 = 0xff00
2010 else TEcont
(text ^ toutf8
key)
2013 let reqlayout angle fitmodel
=
2014 match state
.throttle
with
2016 if nogeomcmds state
.geomcmds
2017 then state
.anchor <- getanchor
();
2018 conf
.angle
<- angle
mod 360;
2021 match state
.mode
with
2022 | LinkNav
_ -> state
.mode
<- View
2025 conf
.fitmodel
<- fitmodel
;
2026 invalidate "reqlayout"
2028 wcmd "reqlayout %d %d %d"
2029 conf
.angle
(FMTE.to_int conf
.fitmodel
) (stateh state
.winh
)
2034 let settrim trimmargins trimfuzz
=
2035 if nogeomcmds state
.geomcmds
2036 then state
.anchor <- getanchor
();
2037 conf
.trimmargins
<- trimmargins
;
2038 conf
.trimfuzz
<- trimfuzz
;
2039 let x0, y0, x1, y1 = trimfuzz
in
2040 invalidate "settrim"
2042 wcmd "settrim %d %d %d %d %d" (btod conf
.trimmargins
) x0 y0 x1 y1);
2047 match state
.throttle
with
2049 let zoom = max
0.0001 zoom in
2050 if zoom <> conf
.zoom
2052 state
.prevzoom
<- (conf
.zoom, state
.x);
2054 reshape state
.winw state
.winh
;
2055 state
.text <- Printf.sprintf
"zoom is now %-5.2f" (zoom *. 100.0);
2058 | Some
(layout, y, started
) ->
2060 match conf
.maxwait
with
2064 let dt = now
() -. started
in
2072 let setcolumns mode columns coverA coverB
=
2073 state
.prevcolumns
<- Some
(conf
.columns
, conf
.zoom);
2077 then showtext '
!'
"split mode doesn't work in bird's eye"
2079 conf
.columns
<- Csplit
(-columns
, E.a);
2087 conf
.columns
<- Csingle
E.a;
2092 conf
.columns
<- Cmulti
((columns
, coverA
, coverB
), E.a);
2096 reshape state
.winw state
.winh
;
2099 let resetmstate () =
2100 state
.mstate
<- Mnone
;
2101 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
2104 let enterbirdseye () =
2105 let zoom = float conf
.thumbw
/. float state
.winw
in
2106 let birdseyepageno =
2107 let cy = state
.winh
/ 2 in
2111 let rec fold best
= function
2114 let d = cy - (l.pagedispy + l.pagevh/2)
2115 and dbest
= cy - (best
.pagedispy + best
.pagevh/2) in
2116 if abs
d < abs dbest
2123 state
.mode
<- Birdseye
(
2124 { conf
with zoom = conf
.zoom }, state
.x, birdseyepageno, -1, getanchor
()
2128 conf
.presentation
<- false;
2129 conf
.interpagespace
<- 10;
2130 conf
.hlinks
<- false;
2131 conf
.fitmodel
<- FitProportional
;
2133 conf
.maxwait
<- None
;
2135 match conf
.beyecolumns
with
2138 Cmulti
((c, 0, 0), E.a)
2139 | None
-> Csingle
E.a
2143 state
.text <- Printf.sprintf
"birds eye mode on (zoom %3.1f%%)"
2148 reshape state
.winw state
.winh
;
2151 let leavebirdseye (c, leftx
, pageno, _, anchor) goback
=
2153 conf
.zoom <- c.zoom;
2154 conf
.presentation
<- c.presentation
;
2155 conf
.interpagespace
<- c.interpagespace
;
2156 conf
.maxwait
<- c.maxwait
;
2157 conf
.hlinks
<- c.hlinks
;
2158 conf
.fitmodel
<- c.fitmodel
;
2159 conf
.beyecolumns
<- (
2160 match conf
.columns
with
2161 | Cmulti
((c, _, _), _) -> Some
c
2163 | Csplit
_ -> failwith
"leaving bird's eye split mode"
2166 match c.columns
with
2167 | Cmulti
(c, _) -> Cmulti
(c, E.a)
2168 | Csingle
_ -> Csingle
E.a
2169 | Csplit
(c, _) -> Csplit
(c, E.a)
2173 state
.text <- Printf.sprintf
"birds eye mode off (zoom %3.1f%%)"
2176 reshape state
.winw state
.winh
;
2177 state
.anchor <- if goback
then anchor else (pageno, 0.0, 1.0);
2181 let togglebirdseye () =
2182 match state
.mode
with
2183 | Birdseye vals
-> leavebirdseye vals
true
2184 | View
-> enterbirdseye ()
2188 let upbirdseye incr
(conf
, leftx
, pageno, hooverpageno
, anchor) =
2189 let pageno = max
0 (pageno - incr
) in
2190 let rec loop = function
2191 | [] -> gotopage1 pageno 0
2192 | l :: _ when l.pageno = pageno ->
2193 if l.pagedispy >= 0 && l.pagey = 0
2194 then G.postRedisplay "upbirdseye"
2195 else gotopage1 pageno 0
2196 | _ :: rest
-> loop rest
2199 state
.mode
<- Birdseye
(conf
, leftx
, pageno, hooverpageno
, anchor)
2202 let downbirdseye incr
(conf
, leftx
, pageno, hooverpageno
, anchor) =
2203 let pageno = min
(state
.pagecount
- 1) (pageno + incr
) in
2204 state
.mode
<- Birdseye
(conf
, leftx
, pageno, hooverpageno
, anchor);
2205 let rec loop = function
2207 let y, h = getpageyh
pageno in
2208 let dy = (y - state
.y) - (state
.winh
- h - conf
.interpagespace
) in
2210 | l :: _ when l.pageno = pageno ->
2211 if l.pagevh != l.pageh
2212 then gotoy (clamp (l.pageh
- l.pagevh + conf
.interpagespace
))
2213 else G.postRedisplay "downbirdseye"
2214 | _ :: rest
-> loop rest
2219 let boundastep h step
=
2221 then bound step ~
-h 0
2225 let optentry mode
_ key =
2226 let btos b = if b then "on" else "off" in
2227 if key >= 32 && key < 127
2229 let c = Char.chr
key in
2233 try conf
.scrollstep
<- int_of_string
s with exc
->
2234 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2236 TEswitch
("scroll step: ", E.s, None
, intentry, ondone, true)
2241 conf
.autoscrollstep
<- boundastep state
.winh
(int_of_string
s);
2242 if state
.autoscroll
<> None
2243 then state
.autoscroll
<- Some conf
.autoscrollstep
2245 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2247 TEswitch
("auto scroll step: ", E.s, None
, intentry, ondone, true)
2252 let n, a, b = multicolumns_of_string
s in
2253 setcolumns mode
n a b;
2255 state
.text <- Printf.sprintf
"bad columns `%s': %s" s (exntos exc
)
2257 TEswitch
("columns: ", E.s, None
, textentry, ondone, true)
2262 let zoom = float (int_of_string
s) /. 100.0 in
2265 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2267 TEswitch
("zoom: ", E.s, None
, intentry, ondone, true)
2272 conf
.thumbw
<- bound
(int_of_string
s) 2 4096;
2274 Printf.sprintf
"thumbnail width is set to %d" conf
.thumbw
;
2275 begin match mode
with
2277 leavebirdseye beye
false;
2282 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2284 TEswitch
("thumbnail width: ", E.s, None
, intentry, ondone, true)
2289 Some
(int_of_string
s)
2291 state
.text <- Printf.sprintf
"bad integer `%s': %s"
2295 | Some angle
-> reqlayout angle conf
.fitmodel
2298 TEswitch
("rotation: ", E.s, None
, intentry, ondone, true)
2301 conf
.icase
<- not conf
.icase
;
2302 TEdone
("case insensitive search " ^
(btos conf
.icase
))
2305 conf
.preload <- not conf
.preload;
2307 TEdone
("preload " ^
(btos conf
.preload))
2310 conf
.verbose
<- not conf
.verbose
;
2311 TEdone
("verbose " ^
(btos conf
.verbose
))
2314 conf
.debug
<- not conf
.debug
;
2315 TEdone
("debug " ^
(btos conf
.debug
))
2318 conf
.maxhfit
<- not conf
.maxhfit
;
2319 state
.maxy
<- calcheight
();
2320 TEdone
("maxhfit " ^
(btos conf
.maxhfit
))
2323 conf
.crophack
<- not conf
.crophack
;
2324 TEdone
("crophack " ^
btos conf
.crophack
)
2328 match conf
.maxwait
with
2330 conf
.maxwait
<- Some infinity
;
2331 "always wait for page to complete"
2333 conf
.maxwait
<- None
;
2334 "show placeholder if page is not ready"
2339 conf
.underinfo
<- not conf
.underinfo
;
2340 TEdone
("underinfo " ^
btos conf
.underinfo
)
2343 conf
.savebmarks
<- not conf
.savebmarks
;
2344 TEdone
("persistent bookmarks " ^
btos conf
.savebmarks
)
2350 match state
.layout with
2355 conf
.interpagespace
<- int_of_string
s;
2356 docolumns conf
.columns
;
2357 state
.maxy
<- calcheight
();
2358 let y = getpagey
pageno in
2361 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2363 TEswitch
("vertical margin: ", E.s, None
, intentry, ondone, true)
2367 match conf
.fitmodel
with
2368 | FitProportional
-> FitWidth
2369 | _ -> FitProportional
2371 reqlayout conf
.angle
fm;
2372 TEdone
("proportional display " ^
btos (fm == FitProportional
))
2375 settrim (not conf
.trimmargins
) conf
.trimfuzz
;
2376 TEdone
("trim margins " ^
btos conf
.trimmargins
)
2379 conf
.invert
<- not conf
.invert
;
2380 TEdone
("invert colors " ^
btos conf
.invert
)
2384 cbput state
.hists
.sel
s;
2387 TEswitch
("selection command: ", E.s, Some
(onhist state
.hists
.sel
),
2388 textentry, ondone, true)
2392 then conf
.pax
<- Some
(ref (0.0, 0, 0))
2393 else conf
.pax
<- None
;
2394 TEdone
("PAX " ^
btos (conf
.pax
!= None
))
2397 state
.text <- Printf.sprintf
"bad option %d `%c'" key c;
2403 class type lvsource
= object
2404 method getitemcount
: int
2405 method getitem
: int -> (string * int)
2406 method hasaction
: int -> bool
2414 method getactive
: int
2415 method getfirst
: int
2417 method getminfo
: (int * int) array
2420 class virtual lvsourcebase
= object
2421 val mutable m_active
= 0
2422 val mutable m_first
= 0
2423 val mutable m_pan
= 0
2424 method getactive
= m_active
2425 method getfirst
= m_first
2426 method getpan
= m_pan
2427 method getminfo
: (int * int) array
= E.a
2430 let withoutlastutf8 s =
2431 let len = String.length
s in
2439 let b = Char.code
s.[pos
] in
2440 if b land 0b11000000 = 0b11000000
2445 if Char.code
s.[len-1] land 0x80 = 0
2449 String.sub
s 0 first;
2452 let textentrykeyboard
2453 key _mask
((c, text, opthist
, onkey
, ondone, cancelonempty
), onleave
) =
2455 if key >= 0xffb0 && key <= 0xffb9
2456 then key - 0xffb0 + 48 else key
2459 state
.mode
<- Textentry
(te
, onleave
);
2462 G.postRedisplay "textentrykeyboard enttext";
2464 let histaction cmd
=
2467 | Some
(action, _) ->
2468 state
.mode
<- Textentry
(
2469 (c, action cmd
, opthist
, onkey
, ondone, cancelonempty
), onleave
2471 G.postRedisplay "textentry histaction"
2475 if emptystr
text && cancelonempty
2478 G.postRedisplay "textentrykeyboard after cancel";
2481 let s = withoutlastutf8 text in
2482 enttext (c, s, opthist
, onkey
, ondone, cancelonempty
)
2484 | @enter
| @kpenter
->
2487 G.postRedisplay "textentrykeyboard after confirm"
2489 | @up
| @kpup
-> histaction HCprev
2490 | @down
| @kpdown
-> histaction HCnext
2491 | @home
| @kphome
-> histaction HCfirst
2492 | @jend
| @kpend
-> histaction HClast
2497 begin match opthist
with
2499 | Some
(_, onhistcancel
) -> onhistcancel
()
2503 G.postRedisplay "textentrykeyboard after cancel2"
2506 enttext (c, E.s, opthist
, onkey
, ondone, cancelonempty
)
2509 | @delete
| @kpdelete
-> ()
2512 && key land 0xff00 != 0xff00 (* keyboard *)
2513 && key land 0xfe00 != 0xfe00 (* xkb *)
2514 && key land 0xfd00 != 0xfd00 (* 3270 *)
2516 begin match onkey
text key with
2520 G.postRedisplay "textentrykeyboard after confirm2";
2523 enttext (c, text, opthist
, onkey
, ondone, cancelonempty
);
2527 G.postRedisplay "textentrykeyboard after cancel3"
2530 state
.mode
<- Textentry
(te
, onleave
);
2531 G.postRedisplay "textentrykeyboard switch";
2535 vlog "unhandled key %s" (Wsi.keyname
key)
2538 let firstof first active
=
2539 if first > active
|| abs
(first - active
) > fstate
.maxrows
- 1
2540 then max
0 (active
- (fstate
.maxrows
/2))
2544 let calcfirst first active
=
2547 let rows = active
- first in
2548 if rows > fstate
.maxrows
then active
- fstate
.maxrows
else first
2552 let scrollph y maxy
=
2553 let sh = float (maxy
+ state
.winh
) /. float state
.winh
in
2554 let sh = float state
.winh
/. sh in
2555 let sh = max
sh (float conf
.scrollh
) in
2557 let percent = float y /. float maxy
in
2558 let position = (float state
.winh
-. sh) *. percent in
2561 if position +. sh > float state
.winh
2562 then float state
.winh
-. sh
2568 let coe s = (s :> uioh
);;
2570 class listview ~zebra ~helpmode ~
(source
:lvsource
) ~trusted ~modehash
=
2572 val m_pan
= source#getpan
2573 val m_first
= source#getfirst
2574 val m_active
= source#getactive
2576 val m_prev_uioh
= state
.uioh
2578 method private elemunder
y =
2582 let n = y / (fstate
.fontsize
+1) in
2583 if m_first
+ n < source#getitemcount
2585 if source#hasaction
(m_first
+ n)
2586 then Some
(m_first
+ n)
2593 GlFunc.blend_func `src_alpha `one_minus_src_alpha
;
2594 GlDraw.color
(0., 0., 0.) ~alpha
:0.85;
2595 filledrect 0. 0. (float state
.winw
) (float state
.winh
);
2596 GlDraw.color
(1., 1., 1.);
2597 Gl.enable `texture_2d
;
2598 let fs = fstate
.fontsize
in
2600 let hw = (wadjsb (xadjsb state
.winw
))/3 in
2601 let ww = fstate
.wwidth
in
2602 let tabw = 17.0*.ww in
2603 let itemcount = source#getitemcount
in
2604 let minfo = source#getminfo
in
2607 then float (xadjsb 0), float (state
.winw
- 1)
2608 else 0.0, float (state
.winw
- conf
.scrollbw
- 1)
2611 if (row - m_first
) > fstate
.maxrows
2614 if row >= 0 && row < itemcount
2616 let (s, level
) = source#getitem
row in
2617 let y = (row - m_first
) * nfs in
2619 (if conf
.leftscroll
then float (xadjsb 0) else 5.0)
2620 +. (float (level
+ m_pan
)) *. ww in
2623 (let c = if row land 1 = 0 then 1.0 else 0.92 in (c,c,c));
2627 Gl.disable `texture_2d
;
2628 let alpha = if source#hasaction
row then 0.9 else 0.3 in
2629 GlDraw.color
(1., 1., 1.) ~
alpha;
2630 linerect (x0 +. 1.) (float (y + 1)) (x1) (float (y + fs + 3));
2631 Gl.enable `texture_2d
;
2634 if zebra
&& row land 1 = 1
2638 GlDraw.color
(c,c,c);
2639 let drawtabularstring s =
2641 let x'
= truncate
(x0 +. x) in
2642 let pos = nindex
s '
\000'
in
2644 then drawstring1 fs x'
(y+nfs) s
2646 let s1 = String.sub
s 0 pos
2647 and s2
= String.sub
s (pos+1) (String.length
s - pos - 1) in
2652 let s'
= withoutlastutf8 s in
2653 let s = s' ^
"@Uellipsis" in
2654 let w = measurestr
fs s in
2655 if float x'
+. w +. ww < float (hw + x'
)
2660 if float x'
+. ww +. measurestr
fs s1 > float (hw + x'
)
2664 ignore
(drawstring1 fs x'
(y+nfs) s1);
2665 drawstring1 fs (hw + x'
) (y+nfs) s2
2669 let x = if helpmode
&& row > 0 then x +. ww else x in
2670 let tabpos = nindex
s '
\t'
in
2673 let len = String.length
s - tabpos - 1 in
2674 let s1 = String.sub
s 0 tabpos
2675 and s2
= String.sub
s (tabpos + 1) len in
2676 let nx = drawstr x s1 in
2678 let x = x +. (max
tabw sw) in
2681 let len = String.length
s - 2 in
2682 if len > 0 && s.[0] = '
\xc2'
&& s.[1] = '
\xb7'
2684 let s = String.sub
s 2 len in
2685 let x = if not helpmode
then x +. ww else x in
2686 GlDraw.color
(1.2, 1.2, 1.2);
2687 let vinc = drawstring1 (fs+fs/4)
2688 (truncate
(x -. ww)) (y+nfs) s in
2689 GlDraw.color
(1., 1., 1.);
2690 vinc +. (float fs *. 0.8)
2696 ignore
(drawtabularstring s);
2702 GlDraw.color
(1.0, 1.0, 1.0) ~
alpha:0.5;
2704 if (row - m_first
) > fstate
.maxrows
2707 if row >= 0 && row < itemcount
2709 let (s, level
) = source#getitem
row in
2710 let pos0 = nindex
s '
\000'
in
2711 let y = (row - m_first
) * nfs in
2712 let x = float (level
+ m_pan
) *. ww in
2713 let (first, last
) = minfo.(row) in
2715 if pos0 > 0 && first > pos0
2716 then String.sub
s (pos0+1) (first-pos0-1)
2717 else String.sub
s 0 first
2719 let suffix = String.sub
s first (last
- first) in
2720 let w1 = measurestr fstate
.fontsize
prefix in
2721 let w2 = measurestr fstate
.fontsize
suffix in
2722 let x = x +. if conf
.leftscroll
then float (xadjsb 5) else 5.0 in
2723 let x = if pos0 > 0 && first > pos0 then x +. float hw else x in
2725 and y0 = float (y+2) in
2727 and y1 = float (y+fs+3) in
2728 filledrect x0 y0 x1 y1;
2733 Gl.disable `texture_2d
;
2734 if Array.length
minfo > 0 then loop m_first
;
2737 method updownlevel incr
=
2738 let len = source#getitemcount
in
2740 if m_active
>= 0 && m_active
< len
2741 then snd
(source#getitem m_active
)
2745 if i
= len then i
-1 else if i
= -1 then 0 else
2746 let _, l = source#getitem i
in
2747 if l != curlevel then i
else flow (i
+incr
)
2749 let active = flow m_active
in
2750 let first = calcfirst m_first
active in
2751 G.postRedisplay "outline updownlevel";
2752 {< m_active
= active; m_first
= first >}
2754 method private key1
key mask
=
2755 let set1 active first qsearch
=
2756 coe {< m_active
= active; m_first
= first; m_qsearch
= qsearch
>}
2758 let search active pattern incr
=
2759 let active = if active = -1 then m_first
else active in
2762 if n >= 0 && n < source#getitemcount
2764 let s, _ = source#getitem
n in
2766 (try ignore
(Str.search_forward
re s 0); true
2767 with Not_found
-> false)
2769 else loop (n + incr
)
2776 let re = Str.regexp_case_fold pattern
in
2782 let itemcount = source#getitemcount
in
2783 let find start incr
=
2785 if i
= -1 || i
= itemcount
2788 if source#hasaction i
2790 else find (i
+ incr
)
2795 let set active first =
2796 let first = bound
first 0 (itemcount - fstate
.maxrows
) in
2798 coe {< m_active
= active; m_first
= first; m_qsearch
= E.s >}
2801 let isvisible first n = n >= first && n - first <= fstate
.maxrows
in
2803 let incr1 = if incr
> 0 then 1 else -1 in
2804 if isvisible m_first m_active
2807 let next = m_active
+ incr
in
2809 if next < 0 || next >= itemcount
2811 else find next incr1
2813 if abs
(m_active
- next) > fstate
.maxrows
2819 let first = m_first
+ incr
in
2820 let first = bound
first 0 (itemcount - fstate
.maxrows
) in
2822 let next = m_active
+ incr
in
2823 let next = bound
next 0 (itemcount - 1) in
2830 if isvisible first next
2837 let first = min
next m_first
in
2839 if abs
(next - first) > fstate
.maxrows
2845 let first = m_first
+ incr
in
2846 let first = bound
first 0 (itemcount - 1) in
2848 let next = m_active
+ incr
in
2849 let next = bound
next 0 (itemcount - 1) in
2850 let next = find next incr1 in
2852 if next = -1 || abs
(m_active
- first) > fstate
.maxrows
2854 let active = if m_active
= -1 then next else m_active
in
2859 if isvisible first active
2865 G.postRedisplay "listview navigate";
2869 | (@r|@s) when Wsi.withctrl mask
->
2870 let incr = if key = @r then -1 else 1 in
2872 match search (m_active
+ incr) m_qsearch
incr with
2874 state
.text <- m_qsearch ^
" [not found]";
2877 state
.text <- m_qsearch
;
2878 active, firstof m_first
active
2880 G.postRedisplay "listview ctrl-r/s";
2881 set1 active first m_qsearch
;
2883 | @insert
when Wsi.withctrl mask
->
2884 if m_active
>= 0 && m_active
< source#getitemcount
2886 let s, _ = source#getitem m_active
in
2892 if emptystr m_qsearch
2895 let qsearch = withoutlastutf8 m_qsearch
in
2899 G.postRedisplay "listview empty qsearch";
2900 set1 m_active m_first
E.s;
2904 match search m_active
qsearch ~
-1 with
2906 state
.text <- qsearch ^
" [not found]";
2909 state
.text <- qsearch;
2910 active, firstof m_first
active
2912 G.postRedisplay "listview backspace qsearch";
2913 set1 active first qsearch
2916 | key when (key != 0 && key land 0xff00 != 0xff00) ->
2917 let pattern = m_qsearch ^ toutf8
key in
2919 match search m_active
pattern 1 with
2921 state
.text <- pattern ^
" [not found]";
2924 state
.text <- pattern;
2925 active, firstof m_first
active
2927 G.postRedisplay "listview qsearch add";
2928 set1 active first pattern;
2932 if emptystr m_qsearch
2934 G.postRedisplay "list view escape";
2937 source#exit
(coe self
) true m_active m_first m_pan
2939 | None
-> m_prev_uioh
2944 G.postRedisplay "list view kill qsearch";
2945 coe {< m_qsearch
= E.s >}
2948 | @enter
| @kpenter
->
2950 let self = {< m_qsearch
= E.s >} in
2952 G.postRedisplay "listview enter";
2953 if m_active
>= 0 && m_active
< source#getitemcount
2955 source#exit
(coe self) false m_active m_first m_pan
;
2958 source#exit
(coe self) true m_active m_first m_pan
;
2961 begin match opt with
2962 | None
-> m_prev_uioh
2966 | @delete
| @kpdelete
->
2969 | @up
| @kpup
-> navigate ~
-1
2970 | @down
| @kpdown
-> navigate 1
2971 | @prior
| @kpprior
-> navigate ~
-(fstate
.maxrows
)
2972 | @next | @kpnext
-> navigate fstate
.maxrows
2974 | @right
| @kpright
->
2976 G.postRedisplay "listview right";
2977 coe {< m_pan
= m_pan
- 1 >}
2979 | @left | @kpleft
->
2981 G.postRedisplay "listview left";
2982 coe {< m_pan
= m_pan
+ 1 >}
2984 | @home
| @kphome
->
2985 let active = find 0 1 in
2986 G.postRedisplay "listview home";
2990 let first = max
0 (itemcount - fstate
.maxrows
) in
2991 let active = find (itemcount - 1) ~
-1 in
2992 G.postRedisplay "listview end";
2995 | key when (key = 0 || key land 0xff00 = 0xff00) ->
2999 dolog
"listview unknown key %#x" key; coe self
3001 method key key mask
=
3002 match state
.mode
with
3003 | Textentry te
-> textentrykeyboard key mask te
; coe self
3004 | _ -> self#key1
key mask
3006 method button button down
x y _ =
3009 | 1 when x > state
.winw
- conf
.scrollbw
->
3010 G.postRedisplay "listview scroll";
3013 let _, position, sh = self#
scrollph in
3014 if y > truncate
position && y < truncate
(position +. sh)
3016 state
.mstate
<- Mscrolly
;
3020 let s = float (max
0 (y - conf
.scrollh
)) /. float state
.winh
in
3021 let first = truncate
(s *. float source#getitemcount
) in
3022 let first = min source#getitemcount
first in
3023 Some
(coe {< m_first
= first; m_active
= first >})
3025 state
.mstate
<- Mnone
;
3028 | 1 when not down
->
3029 begin match self#elemunder
y with
3031 G.postRedisplay "listview click";
3032 source#exit
(coe {< m_active
= n >}) false n m_first m_pan
3036 | n when (n == 4 || n == 5) && not down
->
3037 let len = source#getitemcount
in
3039 if n = 5 && m_first
+ fstate
.maxrows
>= len
3043 let first = m_first
+ (if n == 4 then -1 else 1) in
3044 bound
first 0 (len - 1)
3046 G.postRedisplay "listview wheel";
3047 Some
(coe {< m_first
= first >})
3048 | n when (n = 6 || n = 7) && not down
->
3049 let inc = if n = 7 then -1 else 1 in
3050 G.postRedisplay "listview hwheel";
3051 Some
(coe {< m_pan
= m_pan
+ inc >})
3056 | None
-> m_prev_uioh
3059 method multiclick
_ x y = self#button
1 true x y
3062 match state
.mstate
with
3064 let s = float (max
0 (y - conf
.scrollh
)) /. float state
.winh
in
3065 let first = truncate
(s *. float source#getitemcount
) in
3066 let first = min source#getitemcount
first in
3067 G.postRedisplay "listview motion";
3068 coe {< m_first
= first; m_active
= first >}
3071 method pmotion
x y =
3072 if x < state
.winw
- conf
.scrollbw
3075 match self#elemunder
y with
3076 | None
-> Wsi.setcursor
Wsi.CURSOR_INHERIT
; m_active
3077 | Some
n -> Wsi.setcursor
Wsi.CURSOR_INFO
; n
3081 then (G.postRedisplay "listview pmotion"; {< m_active
= n >})
3086 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
3090 method infochanged
_ = ()
3092 method scrollpw
= (0, 0.0, 0.0)
3094 let nfs = fstate
.fontsize
+ 1 in
3095 let y = m_first
* nfs in
3096 let itemcount = source#getitemcount
in
3097 let maxi = max
0 (itemcount - fstate
.maxrows
) in
3098 let maxy = maxi * nfs in
3099 let p, h = scrollph y maxy in
3102 method modehash
= modehash
3103 method eformsgs
= false
3106 class outlinelistview ~zebra ~source
=
3107 let settext autonarrow
s =
3110 let ss = source#statestr
in
3114 else "{" ^
ss ^
"} [" ^
s ^
"]"
3115 else state
.text <- s
3121 ~source
:(source
:> lvsource
)
3123 ~modehash
:(findkeyhash conf
"outline")
3126 val m_autonarrow
= false
3128 method key key mask
=
3130 if emptystr state
.text
3132 else fstate
.maxrows - 2
3134 let calcfirst first active =
3137 let rows = active - first in
3138 if rows > maxrows then active - maxrows else first
3142 let active = m_active
+ incr in
3143 let active = bound
active 0 (source#getitemcount
- 1) in
3144 let first = calcfirst m_first
active in
3145 G.postRedisplay "outline navigate";
3146 coe {< m_active
= active; m_first
= first >}
3148 let navscroll first =
3150 let dist = m_active
- first in
3156 else first + maxrows
3159 G.postRedisplay "outline navscroll";
3160 coe {< m_first
= first; m_active
= active >}
3162 let ctrl = Wsi.withctrl mask
in
3167 then (source#denarrow
; E.s)
3169 let pattern = source#renarrow
in
3170 if nonemptystr m_qsearch
3171 then (source#narrow m_qsearch
; m_qsearch
)
3175 settext (not m_autonarrow
) text;
3176 G.postRedisplay "toggle auto narrowing";
3177 coe {< m_first
= 0; m_active
= 0; m_autonarrow
= not m_autonarrow
>}
3179 | @slash
when emptystr m_qsearch
&& not m_autonarrow
->
3181 G.postRedisplay "toggle auto narrowing";
3182 coe {< m_first
= 0; m_active
= 0; m_autonarrow
= true >}
3185 source#narrow m_qsearch
;
3187 then source#add_narrow_pattern m_qsearch
;
3188 G.postRedisplay "outline ctrl-n";
3189 coe {< m_first
= 0; m_active
= 0 >}
3192 let active = source#calcactive
(getanchor
()) in
3193 let first = firstof m_first
active in
3194 G.postRedisplay "outline ctrl-s";
3195 coe {< m_first
= first; m_active
= active >}
3198 G.postRedisplay "outline ctrl-u";
3199 if m_autonarrow
&& nonemptystr m_qsearch
3201 ignore
(source#renarrow
);
3202 settext m_autonarrow
E.s;
3203 coe {< m_first
= 0; m_active
= 0; m_qsearch
= E.s >}
3206 source#del_narrow_pattern
;
3207 let pattern = source#renarrow
in
3209 if emptystr
pattern then E.s else "Narrowed to " ^
pattern
3211 settext m_autonarrow
text;
3212 coe {< m_first
= 0; m_active
= 0; m_qsearch
= E.s >}
3216 let first = max
0 (m_active
- (fstate
.maxrows / 2)) in
3217 G.postRedisplay "outline ctrl-l";
3218 coe {< m_first
= first >}
3220 | @tab
when m_autonarrow
->
3221 if nonemptystr m_qsearch
3223 G.postRedisplay "outline list view tab";
3224 source#add_narrow_pattern m_qsearch
;
3226 coe {< m_qsearch
= E.s >}
3230 | @escape
when m_autonarrow
->
3231 if nonemptystr m_qsearch
3232 then source#add_narrow_pattern m_qsearch
;
3235 | @enter
| @kpenter
when m_autonarrow
->
3236 if nonemptystr m_qsearch
3237 then source#add_narrow_pattern m_qsearch
;
3240 | key when m_autonarrow
&& (key != 0 && key land 0xff00 != 0xff00) ->
3241 let pattern = m_qsearch ^ toutf8
key in
3242 G.postRedisplay "outlinelistview autonarrow add";
3243 source#narrow
pattern;
3244 settext true pattern;
3245 coe {< m_first
= 0; m_active
= 0; m_qsearch
= pattern >}
3247 | key when m_autonarrow
&& key = @backspace
->
3248 if emptystr m_qsearch
3251 let pattern = withoutlastutf8 m_qsearch
in
3252 G.postRedisplay "outlinelistview autonarrow backspace";
3253 ignore
(source#renarrow
);
3254 source#narrow
pattern;
3255 settext true pattern;
3256 coe {< m_first
= 0; m_active
= 0; m_qsearch
= pattern >}
3258 | @delete
| @kpdelete
->
3259 source#remove m_active
;
3260 G.postRedisplay "outline delete";
3261 let active = max
0 (m_active
-1) in
3262 coe {< m_first
= firstof m_first
active;
3263 m_active
= active >}
3265 | @up
| @kpup
when ctrl ->
3266 navscroll (max
0 (m_first
- 1))
3268 | @down
| @kpdown
when ctrl ->
3269 navscroll (min
(source#getitemcount
- 1) (m_first
+ 1))
3271 | @up
| @kpup
-> navigate ~
-1
3272 | @down
| @kpdown
-> navigate 1
3273 | @prior
| @kpprior
-> navigate ~
-(fstate
.maxrows)
3274 | @next | @kpnext
-> navigate fstate
.maxrows
3276 | @right
| @kpright
->
3280 G.postRedisplay "outline ctrl right";
3281 {< m_pan
= m_pan
+ 1 >}
3283 else self#updownlevel
1
3287 | @left | @kpleft
->
3291 G.postRedisplay "outline ctrl left";
3292 {< m_pan
= m_pan
- 1 >}
3294 else self#updownlevel ~
-1
3298 | @home
| @kphome
->
3299 G.postRedisplay "outline home";
3300 coe {< m_first
= 0; m_active
= 0 >}
3303 let active = source#getitemcount
- 1 in
3304 let first = max
0 (active - fstate
.maxrows) in
3305 G.postRedisplay "outline end";
3306 coe {< m_active
= active; m_first
= first >}
3308 | _ -> super#
key key mask
3311 let gotounder under =
3312 let getpath filename
=
3314 if nonemptystr filename
3316 if Filename.is_relative filename
3318 let dir = Filename.dirname state
.path in
3320 if Filename.is_implicit
dir
3321 then Filename.concat
(Sys.getcwd
()) dir
3324 Filename.concat
dir filename
3328 if Sys.file_exists
path
3333 | Ulinkgoto
(pageno, top) ->
3337 gotopage1 pageno top;
3343 | Uremote
(filename
, pageno) ->
3344 let path = getpath filename
in
3349 let command = Printf.sprintf
"%s -page %d %S" !selfexec pageno path in
3350 try popen
command []
3352 Printf.eprintf
"failed to execute `%s': %s\n" command (exntos exn
);
3355 let anchor = getanchor
() in
3356 let ranchor = state
.path, state
.password
, anchor, state
.origin
in
3357 state
.origin
<- E.s;
3358 state
.anchor <- (pageno, 0.0, 0.0);
3359 state
.ranchors
<- ranchor :: state
.ranchors
;
3362 else showtext '
!'
("Could not find " ^ filename
)
3364 | Uremotedest
(filename
, destname
) ->
3365 let path = getpath filename
in
3370 let command = !selfexec ^
" " ^
path ^
" -dest " ^ destname
in
3371 try popen
command []
3374 "failed to execute `%s': %s\n" command (exntos exn
);
3377 let anchor = getanchor
() in
3378 let ranchor = state
.path, state
.password
, anchor, state
.origin
in
3379 state
.origin
<- E.s;
3380 state
.nameddest
<- destname
;
3381 state
.ranchors
<- ranchor :: state
.ranchors
;
3384 else showtext '
!'
("Could not find " ^ filename
)
3386 | Uunexpected
_ | Ulaunch
_ | Unamed
_ | Utext
_ | Unone
-> ()
3389 let gotohist (path, (c, bookmarks
, x, anchor)) =
3390 Config.save
leavebirdseye;
3391 state
.anchor <- anchor;
3393 state
.bookmarks
<- bookmarks
;
3394 state
.origin
<- E.s;
3399 let gotooutline (_, _, kind
) =
3403 let (pageno, y, _) = anchor in
3405 (if conf
.presentation
then (pageno, y, 1.0) else anchor)
3409 | Ouri
uri -> gotounder (Ulinkuri
uri)
3410 | Olaunch cmd
-> gotounder (Ulaunch cmd
)
3411 | Oremote remote
-> gotounder (Uremote remote
)
3412 | Ohistory hist
-> gotohist hist
3413 | Oremotedest remotedest
-> gotounder (Uremotedest remotedest
)
3417 let genhistoutlines =
3418 let order ty
(p1
, c1
, _, _, _) (p2
, c2
, _, _, _) =
3420 | `lastvisit
-> compare c1
.lastvisit c2
.lastvisit
3421 | `
path -> compare p2 p1
3422 | `file
-> compare
(Filename.basename p2
) (Filename.basename p1
)
3424 let e1 = emptystr c1
.title
3425 and e2
= emptystr c2
.title
in
3427 then compare
(Filename.basename p2
) (Filename.basename p1
)
3430 else compare c1
.title c2
.title
3432 let showfullpath = ref false in
3435 let s = if orderty
= t
then "[@Uradical] " ^
s else "[ ] " ^
s in
3436 s, 0, Oaction
(fun () -> Config.historder
:= t
; reeenterhist := true)
3438 let list = ref [] in
3439 if Config.gethist
list
3443 (fun accu (path, c, b, x, a) ->
3444 let hist = (path, (c, b, x, a)) in
3445 let s = if !showfullpath then path else Filename.basename
path in
3446 let base = mbtoutf8
s in
3447 (base ^
"\000" ^
c.title
, 1, Ohistory
hist) :: accu
3449 [ setorty "Sort by time of last visit" `lastvisit
;
3450 setorty "Sort by file name" `file
;
3451 setorty "Sort by path" `
path;
3452 setorty "Sort by title" `title
;
3453 (if !showfullpath then "@Uradical "
3454 else " ") ^
"Show full path", 0, Oaction
(fun () ->
3455 showfullpath := not
!showfullpath; reeenterhist := true)
3456 ] (List.sort
(order orderty
) !list)
3462 let outlinesource sourcetype
=
3464 inherit lvsourcebase
3465 val mutable m_items
= E.a
3466 val mutable m_minfo
= E.a
3467 val mutable m_orig_items
= E.a
3468 val mutable m_orig_minfo
= E.a
3469 val mutable m_narrow_patterns
= []
3470 val mutable m_hadremovals
= false
3471 val mutable m_gen
= -1
3473 method getitemcount
=
3474 Array.length m_items
+ (if m_hadremovals
then 1 else 0)
3477 if n == Array.length m_items
&& m_hadremovals
3479 ("[Confirm removal]", 0)
3481 let s, n, _ = m_items
.(n) in
3484 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3485 ignore
(uioh
, first);
3486 let confrimremoval = m_hadremovals
&& active = Array.length m_items
in
3488 if m_narrow_patterns
= []
3489 then m_orig_items
, m_orig_minfo
3490 else m_items
, m_minfo
3494 if not
confrimremoval
3496 gotooutline m_items
.(active);
3501 state
.bookmarks
<- Array.to_list m_items
;
3502 m_orig_items
<- m_items
;
3503 m_orig_minfo
<- m_minfo
;
3513 method hasaction
_ = true
3516 if Array.length m_items
!= Array.length m_orig_items
3519 match m_narrow_patterns
with
3521 | many
-> String.concat
"@Uellipsis" (List.rev many
)
3523 "Narrowed to " ^
s ^
" (ctrl-u to restore)"
3527 match m_narrow_patterns
with
3530 | head
:: _ -> "@Uellipsis" ^ head
3532 method narrow
pattern =
3533 let reopt = try Some
(Str.regexp_case_fold
pattern) with _ -> None
in
3537 let rec loop accu minfo n =
3540 m_items
<- Array.of_list
accu;
3541 m_minfo
<- Array.of_list
minfo;
3544 let (s, _, t
) as o = m_items
.(n) in
3547 | Oaction
_ -> o :: accu, (0, 0) :: minfo
3548 | Onone
| Oanchor
_ | Ouri
_ | Olaunch
_
3549 | Oremote
_ | Oremotedest
_ | Ohistory
_ ->
3551 try Str.search_forward
re s 0
3552 with Not_found
-> -1
3555 then o :: accu, (first, Str.match_end
()) :: minfo
3558 loop accu minfo (n-1)
3560 loop [] [] (Array.length m_items
- 1)
3562 method getminfo
= m_minfo
3566 match sourcetype
with
3567 | `bookmarks
-> Array.of_list state
.bookmarks
3568 | `outlines
-> state
.outlines
3569 | `history
-> genhistoutlines !Config.historder
3571 m_minfo
<- m_orig_minfo
;
3572 m_items
<- m_orig_items
3575 if sourcetype
= `bookmarks
3577 if m >= 0 && m < Array.length m_items
3579 m_hadremovals
<- true;
3580 m_items
<- Array.init
(Array.length m_items
- 1) (fun n ->
3581 let n = if n >= m then n+1 else n in
3586 method add_narrow_pattern
pattern =
3587 m_narrow_patterns
<- pattern :: m_narrow_patterns
3589 method del_narrow_pattern
=
3590 match m_narrow_patterns
with
3591 | _ :: rest
-> m_narrow_patterns
<- rest
3596 match m_narrow_patterns
with
3597 | pattern :: [] -> self#narrow
pattern; pattern
3599 List.fold_left
(fun accu pattern ->
3600 self#narrow
pattern;
3601 pattern ^
"@Uellipsis" ^
accu) E.s list
3603 method calcactive
anchor =
3604 let rely = getanchory anchor in
3605 let rec loop n best bestd
=
3606 if n = Array.length m_items
3609 let _, _, kind
= m_items
.(n) in
3612 let orely = getanchory anchor in
3613 let d = abs
(orely - rely) in
3616 else loop (n+1) best bestd
3617 | Onone
| Oremote
_ | Olaunch
_
3618 | Oremotedest
_ | Ouri
_ | Ohistory
_ | Oaction
_ ->
3619 loop (n+1) best bestd
3623 method reset
anchor items =
3624 m_hadremovals
<- false;
3625 if state
.gen
!= m_gen
3627 m_orig_items
<- items;
3629 m_narrow_patterns
<- [];
3631 m_orig_minfo
<- E.a;
3635 if items != m_orig_items
3637 m_orig_items
<- items;
3638 if m_narrow_patterns
== []
3639 then m_items
<- items;
3642 let active = self#calcactive
anchor in
3644 m_first
<- firstof m_first
active
3648 let enterselector sourcetype
=
3650 let source = outlinesource sourcetype
in
3653 match sourcetype
with
3654 | `bookmarks
-> Array.of_list state
.bookmarks
3655 | `
outlines -> state
.outlines
3656 | `history
-> genhistoutlines !Config.historder
3658 if Array.length
outlines = 0
3660 showtext ' ' errmsg
;
3663 state
.text <- source#greetmsg
;
3664 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
3665 let anchor = getanchor
() in
3666 source#reset
anchor outlines;
3668 coe (new outlinelistview ~zebra
:(sourcetype
=`history
) ~
source);
3669 G.postRedisplay "enter selector";
3673 let enteroutlinemode =
3674 let f = enterselector `
outlines in
3675 fun () -> f "Document has no outline";
3678 let enterbookmarkmode =
3679 let f = enterselector `bookmarks
in
3680 fun () -> f "Document has no bookmarks (yet)";
3683 let enterhistmode () = enterselector `history
"No history (yet)";;
3685 let makecheckers () =
3686 (* Based on lablGL-1.04/LablGlut/examples/lablGL/checker.ml which had
3688 converted by Issac Trotts. July 25, 2002 *)
3689 let image = GlPix.create `ubyte ~format
:`luminance ~width
:2 ~height
:2 in
3690 Raw.sets_string
(GlPix.to_raw
image) ~
pos:0 "\255\200\200\255";
3691 let id = GlTex.gen_texture
() in
3692 GlTex.bind_texture `texture_2d
id;
3693 GlPix.store
(`unpack_alignment
1);
3694 GlTex.image2d
image;
3695 List.iter
(GlTex.parameter ~target
:`texture_2d
)
3696 [ `mag_filter `nearest
; `min_filter `nearest
];
3700 let setcheckers enabled
=
3701 match state
.checkerstexid
with
3703 if enabled
then state
.checkerstexid
<- Some
(makecheckers ())
3705 | Some checkerstexid
->
3708 GlTex.delete_texture checkerstexid
;
3709 state
.checkerstexid
<- None
;
3713 let describe_location () =
3714 let fn = page_of_y state
.y in
3715 let ln = page_of_y
(state
.y + state
.winh
- hscrollh () - 1) in
3716 let maxy = state
.maxy - (if conf
.maxhfit
then state
.winh
else 0) in
3720 else (100. *. (float state
.y /. float maxy))
3724 Printf.sprintf
"page %d of %d [%.2f%%]"
3725 (fn+1) state
.pagecount
percent
3728 "pages %d-%d of %d [%.2f%%]"
3729 (fn+1) (ln+1) state
.pagecount
percent
3732 let setpresentationmode v
=
3733 let n = page_of_y state
.y in
3734 state
.anchor <- (n, 0.0, 1.0);
3735 conf
.presentation
<- v
;
3736 if conf
.fitmodel
= FitPage
3737 then reqlayout conf
.angle conf
.fitmodel
;
3742 let btos b = if b then "@Uradical" else E.s in
3743 let showextended = ref false in
3744 let leave mode
= function
3745 | Confirm
-> state
.mode
<- mode
3746 | Cancel
-> state
.mode
<- mode
in
3749 val mutable m_first_time
= true
3750 val mutable m_l
= []
3751 val mutable m_a
= E.a
3752 val mutable m_prev_uioh
= nouioh
3753 val mutable m_prev_mode
= View
3755 inherit lvsourcebase
3757 method reset prev_mode prev_uioh
=
3758 m_a
<- Array.of_list
(List.rev m_l
);
3760 m_prev_mode
<- prev_mode
;
3761 m_prev_uioh
<- prev_uioh
;
3765 if n >= Array.length m_a
3769 | _, _, _, Action
_ -> m_active
<- n
3773 m_first_time
<- false;
3776 method int name get
set =
3778 (name
, `
int get
, 1, Action
(
3781 try set (int_of_string
s)
3783 state
.text <- Printf.sprintf
"bad integer `%s': %s"
3787 let te = name ^
": ", E.s, None
, intentry, ondone, true in
3788 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3792 method int_with_suffix name get
set =
3794 (name
, `intws get
, 1, Action
(
3797 try set (int_of_string_with_suffix
s)
3799 state
.text <- Printf.sprintf
"bad integer `%s': %s"
3804 name ^
": ", E.s, None
, intentry_with_suffix, ondone, true
3806 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3810 method bool ?
(offset
=1) ?
(btos=btos) name get
set =
3812 (name
, `
bool (btos, get
), offset
, Action
(
3819 method color name get
set =
3821 (name
, `color get
, 1, Action
(
3823 let invalid = (nan
, nan
, nan
) in
3826 try color_of_string
s
3828 state
.text <- Printf.sprintf
"bad color `%s': %s"
3835 let te = name ^
": ", E.s, None
, textentry, ondone, true in
3836 state
.text <- color_to_string
(get
());
3837 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3841 method string name get
set =
3843 (name
, `
string get
, 1, Action
(
3845 let ondone s = set s in
3846 let te = name ^
": ", E.s, None
, textentry, ondone, true in
3847 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3851 method colorspace name get
set =
3853 (name
, `
string get
, 1, Action
(
3857 inherit lvsourcebase
3860 m_active
<- CSTE.to_int conf
.colorspace
;
3863 method getitemcount
=
3864 Array.length
CSTE.names
3867 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3868 ignore
(uioh
, first, pan
);
3869 if not cancel
then set active;
3871 method hasaction
_ = true
3875 let modehash = findkeyhash conf
"info" in
3876 coe (new listview ~zebra
:false ~helpmode
:false
3877 ~
source ~trusted
:true ~
modehash)
3880 method paxmark name get
set =
3882 (name
, `
string get
, 1, Action
(
3886 inherit lvsourcebase
3889 m_active
<- MTE.to_int conf
.paxmark
;
3892 method getitemcount
= Array.length
MTE.names
3893 method getitem
n = (MTE.names
.(n), 0)
3894 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3895 ignore
(uioh
, first, pan
);
3896 if not cancel
then set active;
3898 method hasaction
_ = true
3902 let modehash = findkeyhash conf
"info" in
3903 coe (new listview ~zebra
:false ~helpmode
:false
3904 ~
source ~trusted
:true ~
modehash)
3907 method fitmodel name get
set =
3909 (name
, `
string get
, 1, Action
(
3913 inherit lvsourcebase
3916 m_active
<- FMTE.to_int conf
.fitmodel
;
3919 method getitemcount
= Array.length
FMTE.names
3920 method getitem
n = (FMTE.names
.(n), 0)
3921 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3922 ignore
(uioh
, first, pan
);
3923 if not cancel
then set active;
3925 method hasaction
_ = true
3929 let modehash = findkeyhash conf
"info" in
3930 coe (new listview ~zebra
:false ~helpmode
:false
3931 ~
source ~trusted
:true ~
modehash)
3934 method caption
s offset
=
3935 m_l
<- (s, `empty
, offset
, Noaction
) :: m_l
3937 method caption2
s f offset
=
3938 m_l
<- (s, `
string f, offset
, Noaction
) :: m_l
3940 method getitemcount
= Array.length m_a
3943 let tostr = function
3944 | `
int f -> string_of_int
(f ())
3945 | `intws
f -> string_with_suffix_of_int
(f ())
3947 | `color
f -> color_to_string
(f ())
3948 | `
bool (btos, f) -> btos (f ())
3951 let name, t
, offset
, _ = m_a
.(n) in
3952 ((let s = tostr t
in
3954 then Printf.sprintf
"%s\t%s" name s
3958 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3963 match m_a
.(active) with
3964 | _, _, _, Action
f -> f uioh
3976 method hasaction
n =
3978 | _, _, _, Action
_ -> true
3982 let rec fillsrc prevmode prevuioh
=
3983 let sep () = src#caption
E.s 0 in
3984 let colorp name get
set =
3986 (fun () -> color_to_string
(get
()))
3989 let c = color_of_string
v in
3992 state
.text <- Printf.sprintf
"bad color `%s': %s" v (exntos exn
)
3995 let oldmode = state
.mode
in
3996 let birdseye = isbirdseye state
.mode
in
3998 src#caption
(if birdseye then "Setup (Bird's eye)" else "Setup") 0;
4000 src#
bool "presentation mode"
4001 (fun () -> conf
.presentation
)
4002 (fun v -> setpresentationmode v);
4004 src#
bool "ignore case in searches"
4005 (fun () -> conf
.icase
)
4006 (fun v -> conf
.icase
<- v);
4009 (fun () -> conf
.preload)
4010 (fun v -> conf
.preload <- v);
4012 src#
bool "highlight links"
4013 (fun () -> conf
.hlinks
)
4014 (fun v -> conf
.hlinks
<- v);
4016 src#
bool "under info"
4017 (fun () -> conf
.underinfo
)
4018 (fun v -> conf
.underinfo
<- v);
4020 src#
bool "persistent bookmarks"
4021 (fun () -> conf
.savebmarks
)
4022 (fun v -> conf
.savebmarks
<- v);
4024 src#fitmodel
"fit model"
4025 (fun () -> FMTE.to_string conf
.fitmodel
)
4026 (fun v -> reqlayout conf
.angle
(FMTE.of_int
v));
4028 src#
bool "trim margins"
4029 (fun () -> conf
.trimmargins
)
4030 (fun v -> settrim v conf
.trimfuzz
; fillsrc prevmode prevuioh
);
4032 src#
bool "persistent location"
4033 (fun () -> conf
.jumpback
)
4034 (fun v -> conf
.jumpback
<- v);
4037 src#
int "inter-page space"
4038 (fun () -> conf
.interpagespace
)
4040 conf
.interpagespace
<- n;
4041 docolumns conf
.columns
;
4043 match state
.layout with
4048 state
.maxy <- calcheight
();
4049 let y = getpagey
pageno in
4054 (fun () -> conf
.pagebias
)
4055 (fun v -> conf
.pagebias
<- v);
4057 src#
int "scroll step"
4058 (fun () -> conf
.scrollstep
)
4059 (fun n -> conf
.scrollstep
<- n);
4061 src#
int "horizontal scroll step"
4062 (fun () -> conf
.hscrollstep
)
4063 (fun v -> conf
.hscrollstep
<- v);
4065 src#
int "auto scroll step"
4067 match state
.autoscroll
with
4069 | _ -> conf
.autoscrollstep
)
4071 let n = boundastep state
.winh
n in
4072 if state
.autoscroll
<> None
4073 then state
.autoscroll
<- Some
n;
4074 conf
.autoscrollstep
<- n);
4077 (fun () -> truncate
(conf
.zoom *. 100.))
4078 (fun v -> setzoom ((float v) /. 100.));
4081 (fun () -> conf
.angle
)
4082 (fun v -> reqlayout v conf
.fitmodel
);
4084 src#
int "scroll bar width"
4085 (fun () -> conf
.scrollbw
)
4088 reshape state
.winw state
.winh
;
4091 src#
int "scroll handle height"
4092 (fun () -> conf
.scrollh
)
4093 (fun v -> conf
.scrollh
<- v;);
4095 src#
int "thumbnail width"
4096 (fun () -> conf
.thumbw
)
4098 conf
.thumbw
<- min
4096 v;
4101 leavebirdseye beye
false;
4106 let mode = state
.mode in
4107 src#
string "columns"
4109 match conf
.columns
with
4111 | Cmulti
(multi
, _) -> multicolumns_to_string multi
4112 | Csplit
(count
, _) -> "-" ^ string_of_int count
4115 let n, a, b = multicolumns_of_string
v in
4116 setcolumns mode n a b);
4119 src#caption
"Pixmap cache" 0;
4120 src#int_with_suffix
"size (advisory)"
4121 (fun () -> conf
.memlimit
)
4122 (fun v -> conf
.memlimit
<- v);
4125 (fun () -> Printf.sprintf
"%s bytes, %d tiles"
4126 (string_with_suffix_of_int state
.memused
)
4127 (Hashtbl.length state
.tilemap
)) 1;
4130 src#caption
"Layout" 0;
4131 src#caption2
"Dimension"
4133 Printf.sprintf
"%dx%d (virtual %dx%d)"
4134 state
.winw state
.winh
4139 src#caption2
"Position" (fun () ->
4140 Printf.sprintf
"%dx%d" state
.x state
.y
4143 src#caption2
"Position" (fun () -> describe_location ()) 1
4147 src#
bool ~offset
:0 ~
btos:(fun v -> if v then "(on)" else "(off)")
4148 "Save these parameters as global defaults at exit"
4149 (fun () -> conf
.bedefault
)
4150 (fun v -> conf
.bedefault
<- v)
4154 let btos b = if b then "@Ulguillemet" else "@Urguillemet" in
4155 src#
bool ~offset
:0 ~
btos "Extended parameters"
4156 (fun () -> !showextended)
4157 (fun v -> showextended := v; fillsrc prevmode prevuioh
);
4161 (fun () -> conf
.checkers
)
4162 (fun v -> conf
.checkers
<- v; setcheckers v);
4163 src#
bool "update cursor"
4164 (fun () -> conf
.updatecurs
)
4165 (fun v -> conf
.updatecurs
<- v);
4166 src#
bool "scroll-bar on the left"
4167 (fun () -> conf
.leftscroll
)
4168 (fun v -> conf
.leftscroll
<- v);
4170 (fun () -> conf
.verbose
)
4171 (fun v -> conf
.verbose
<- v);
4172 src#
bool "invert colors"
4173 (fun () -> conf
.invert
)
4174 (fun v -> conf
.invert
<- v);
4176 (fun () -> conf
.maxhfit
)
4177 (fun v -> conf
.maxhfit
<- v);
4178 src#
bool "redirect stderr"
4179 (fun () -> conf
.redirectstderr)
4180 (fun v -> conf
.redirectstderr <- v; redirectstderr ());
4182 (fun () -> conf
.pax
!= None
)
4185 then conf
.pax
<- Some
(ref (now
(), 0, 0))
4186 else conf
.pax
<- None
);
4187 src#
string "uri launcher"
4188 (fun () -> conf
.urilauncher
)
4189 (fun v -> conf
.urilauncher
<- v);
4190 src#
string "path launcher"
4191 (fun () -> conf
.pathlauncher
)
4192 (fun v -> conf
.pathlauncher
<- v);
4193 src#
string "tile size"
4194 (fun () -> Printf.sprintf
"%dx%d" conf
.tilew conf
.tileh
)
4197 let w, h = Scanf.sscanf
v "%dx%d" (fun w h -> w, h) in
4198 conf
.tilew
<- max
64 w;
4199 conf
.tileh
<- max
64 h;
4202 state
.text <- Printf.sprintf
"bad tile size `%s': %s"
4205 src#
int "texture count"
4206 (fun () -> conf
.texcount
)
4209 then conf
.texcount
<- v
4210 else showtext '
!'
" Failed to set texture count please retry later"
4212 src#
int "slice height"
4213 (fun () -> conf
.sliceheight
)
4215 conf
.sliceheight
<- v;
4216 wcmd "sliceh %d" conf
.sliceheight
;
4218 src#
int "anti-aliasing level"
4219 (fun () -> conf
.aalevel
)
4221 conf
.aalevel
<- bound
v 0 8;
4222 state
.anchor <- getanchor
();
4223 opendoc state
.path state
.password
;
4225 src#
string "page scroll scaling factor"
4226 (fun () -> string_of_float conf
.pgscale)
4229 let s = float_of_string
v in
4232 state
.text <- Printf.sprintf
4233 "bad page scroll scaling factor `%s': %s" v (exntos exn
)
4236 src#
int "ui font size"
4237 (fun () -> fstate
.fontsize
)
4238 (fun v -> setfontsize (bound
v 5 100));
4239 src#
int "hint font size"
4240 (fun () -> conf
.hfsize
)
4241 (fun v -> conf
.hfsize
<- bound
v 5 100);
4242 colorp "background color"
4243 (fun () -> conf
.bgcolor
)
4244 (fun v -> conf
.bgcolor
<- v);
4245 src#
bool "crop hack"
4246 (fun () -> conf
.crophack
)
4247 (fun v -> conf
.crophack
<- v);
4248 src#
string "trim fuzz"
4249 (fun () -> irect_to_string conf
.trimfuzz
)
4252 conf
.trimfuzz
<- irect_of_string
v;
4254 then settrim true conf
.trimfuzz
;
4256 state
.text <- Printf.sprintf
"bad irect `%s': %s" v (exntos exn
)
4258 src#
string "throttle"
4260 match conf
.maxwait
with
4261 | None
-> "show place holder if page is not ready"
4264 then "wait for page to fully render"
4266 "wait " ^ string_of_float
time
4267 ^
" seconds before showing placeholder"
4271 let f = float_of_string
v in
4273 then conf
.maxwait
<- None
4274 else conf
.maxwait
<- Some
f
4276 state
.text <- Printf.sprintf
"bad time `%s': %s" v (exntos exn
)
4278 src#
string "ghyll scroll"
4280 match conf
.ghyllscroll
with
4282 | Some nab
-> ghyllscroll_to_string nab
4285 try conf
.ghyllscroll
<- ghyllscroll_of_string
v
4287 state
.text <- Printf.sprintf
"bad ghyll `%s': %s" v (exntos exn
)
4289 src#
string "selection command"
4290 (fun () -> conf
.selcmd
)
4291 (fun v -> conf
.selcmd
<- v);
4292 src#
string "synctex command"
4293 (fun () -> conf
.stcmd
)
4294 (fun v -> conf
.stcmd
<- v);
4295 src#
string "pax command"
4296 (fun () -> conf
.paxcmd
)
4297 (fun v -> conf
.paxcmd
<- v);
4298 src#colorspace
"color space"
4299 (fun () -> CSTE.to_string conf
.colorspace
)
4301 conf
.colorspace
<- CSTE.of_int
v;
4305 src#paxmark
"pax mark method"
4306 (fun () -> MTE.to_string conf
.paxmark
)
4307 (fun v -> conf
.paxmark
<- MTE.of_int
v);
4311 (fun () -> conf
.usepbo
)
4312 (fun v -> conf
.usepbo
<- v);
4313 src#
bool "mouse wheel scrolls pages"
4314 (fun () -> conf
.wheelbypage
)
4315 (fun v -> conf
.wheelbypage
<- v);
4316 src#
bool "open remote links in a new instance"
4317 (fun () -> conf
.riani
)
4318 (fun v -> conf
.riani
<- v);
4322 src#caption
"Document" 0;
4323 List.iter
(fun (_, s) -> src#caption
s 1) state
.docinfo
;
4324 src#caption2
"Pages"
4325 (fun () -> string_of_int state
.pagecount
) 1;
4326 src#caption2
"Dimensions"
4327 (fun () -> string_of_int
(List.length state
.pdims
)) 1;
4331 src#caption
"Trimmed margins" 0;
4332 src#caption2
"Dimensions"
4333 (fun () -> string_of_int
(List.length state
.pdims
)) 1;
4337 src#caption
"OpenGL" 0;
4338 src#caption
(Printf.sprintf
"Vendor\t%s" (GlMisc.get_string `vendor
)) 1;
4339 src#caption
(Printf.sprintf
"Renderer\t%s" (GlMisc.get_string `renderer
)) 1;
4342 src#caption
"Location" 0;
4343 if nonemptystr state
.origin
4344 then src#caption
("Orign\t" ^ mbtoutf8 state
.origin
) 1;
4345 src#caption
("Path\t" ^ mbtoutf8 state
.path) 1;
4347 src#reset prevmode prevuioh
;
4352 let prevmode = state
.mode
4353 and prevuioh
= state
.uioh in
4354 fillsrc prevmode prevuioh
;
4355 let source = (src :> lvsource
) in
4356 let modehash = findkeyhash conf
"info" in
4357 state
.uioh <- coe (object (self)
4358 inherit listview ~zebra
:false ~helpmode
:false
4359 ~
source ~trusted
:true ~
modehash as super
4360 val mutable m_prevmemused
= 0
4361 method infochanged
= function
4363 if m_prevmemused
!= state
.memused
4365 m_prevmemused
<- state
.memused
;
4366 G.postRedisplay "memusedchanged";
4368 | Pdim
-> G.postRedisplay "pdimchanged"
4369 | Docinfo
-> fillsrc prevmode prevuioh
4371 method key key mask
=
4372 if not
(Wsi.withctrl mask
)
4375 | @left | @kpleft
-> coe (self#updownlevel ~
-1)
4376 | @right
| @kpright
-> coe (self#updownlevel
1)
4377 | _ -> super#
key key mask
4378 else super#
key key mask
4380 G.postRedisplay "info";
4386 inherit lvsourcebase
4387 method getitemcount
= Array.length state
.help
4389 let s, l, _ = state
.help
.(n) in
4392 method exit ~
uioh ~cancel ~
active ~
first ~pan
=
4396 match state
.help
.(active) with
4397 | _, _, Action
f -> Some
(f uioh)
4407 method hasaction
n =
4408 match state
.help
.(n) with
4409 | _, _, Action
_ -> true
4416 let modehash = findkeyhash conf
"help" in
4418 state
.uioh <- coe (new listview
4419 ~zebra
:false ~helpmode
:true
4420 ~
source ~trusted
:true ~
modehash);
4421 G.postRedisplay "help";
4426 let re = Str.regexp
"[\r\n]" in
4428 inherit lvsourcebase
4429 val mutable m_items
= E.a
4431 method getitemcount
= 1 + Array.length m_items
4436 else m_items
.(n-1), 0
4438 method exit ~
uioh ~cancel ~
active ~
first ~pan
=
4443 then Buffer.clear state
.errmsgs
;
4450 method hasaction
n =
4454 state
.newerrmsgs
<- false;
4455 let l = Str.split
re (Buffer.contents state
.errmsgs
) in
4456 m_items
<- Array.of_list
l
4465 let source = (msgsource :> lvsource
) in
4466 let modehash = findkeyhash conf
"listview" in
4467 state
.uioh <- coe (object
4468 inherit listview ~zebra
:false ~helpmode
:false
4469 ~
source ~trusted
:false ~
modehash as super
4472 then msgsource#reset
;
4475 G.postRedisplay "msgs";
4478 let quickbookmark ?title
() =
4479 match state
.layout with
4485 let tm = Unix.localtime
(now
()) in
4486 Printf.sprintf
"Quick (page %d) (bookmarked at %d/%d/%d %d:%d)"
4490 (tm.Unix.tm_year
+ 1900)
4493 | Some
title -> title
4495 state
.bookmarks
<- (title, 0, Oanchor
(getanchor1
l)) :: state
.bookmarks
4498 let setautoscrollspeed step goingdown
=
4499 let incr = max
1 ((abs step
) / 2) in
4500 let incr = if goingdown
then incr else -incr in
4501 let astep = boundastep state
.winh
(step
+ incr) in
4502 state
.autoscroll
<- Some
astep;
4506 match conf
.columns
with
4508 | _ -> state
.x != 0 || conf
.zoom > 1.0
4511 let panbound x = bound
x (-state
.w) (wadjsb state
.winw
);;
4513 let existsinrow pageno (columns
, coverA
, coverB
) p =
4514 let last = ((pageno - coverA
) mod columns
) + columns
in
4515 let rec any = function
4518 if l.pageno = coverA
- 1 || l.pageno = state
.pagecount
- coverB
4522 then (if l.pageno = last then false else any rest
)
4530 match state
.layout with
4532 let pageno = page_of_y state
.y in
4533 gotoghyll (getpagey
(pageno+1))
4535 match conf
.columns
with
4537 if conf
.presentation
&& rest
== [] && l.pageh
> l.pagey + l.pagevh
4539 let y = clamp (pgscale state
.winh
) in
4542 let pageno = min
(l.pageno+1) (state
.pagecount
-1) in
4543 gotoghyll (getpagey
pageno)
4544 | Cmulti
((c, _, _) as cl, _) ->
4545 if conf
.presentation
4546 && (existsinrow l.pageno cl
4547 (fun l -> l.pageh
> l.pagey + l.pagevh))
4549 let y = clamp (pgscale state
.winh
) in
4552 let pageno = min
(l.pageno+c) (state
.pagecount
-1) in
4553 gotoghyll (getpagey
pageno)
4555 if l.pageno < state
.pagecount
- 1 || l.pagecol
< n - 1
4557 let pagey, pageh
= getpageyh
l.pageno in
4558 let pagey = pagey + pageh
* l.pagecol
in
4559 let ips = if l.pagecol
= 0 then 0 else conf
.interpagespace
in
4560 gotoghyll (pagey + pageh
+ ips)
4564 match state
.layout with
4566 let pageno = page_of_y state
.y in
4567 gotoghyll (getpagey
(pageno-1))
4569 match conf
.columns
with
4571 if conf
.presentation
&& l.pagey != 0
4573 gotoghyll (clamp (pgscale ~
-(state
.winh
)))
4575 let pageno = max
0 (l.pageno-1) in
4576 gotoghyll (getpagey
pageno)
4577 | Cmulti
((c, _, coverB
) as cl, _) ->
4578 if conf
.presentation
&&
4579 (existsinrow l.pageno cl (fun l -> l.pagey != 0))
4581 gotoghyll (clamp (pgscale ~
-(state
.winh
)))
4584 if l.pageno = state
.pagecount
- coverB
4588 let pageno = max
0 (l.pageno-decr) in
4589 gotoghyll (getpagey
pageno)
4597 let pageno = max
0 (l.pageno-1) in
4598 let pagey, pageh
= getpageyh
pageno in
4601 let pagey, pageh
= getpageyh
l.pageno in
4602 pagey + pageh
* (l.pagecol
-1) - conf
.interpagespace
4607 let viewkeyboard key mask
=
4609 let mode = state
.mode in
4610 state
.mode <- Textentry
(te, fun _ -> state
.mode <- mode);
4613 G.postRedisplay "view:enttext"
4615 let ctrl = Wsi.withctrl mask
in
4617 if key >= 0xffb0 && key < 0xffb9 then key - 0xffb0 + 48 else key
4622 if conf
.angle
mod 360 = 0 && not
(isbirdseye state
.mode)
4624 state
.mode <- LinkNav
(Ltgendir
0);
4627 else showtext '
!'
"Keyboard link navigation does not work under rotation"
4630 begin match state
.mstate
with
4633 G.postRedisplay "kill zoom rect";
4635 begin match state
.mode with
4638 G.postRedisplay "esc leave linknav"
4640 match state
.ranchors
with
4642 | (path, password
, anchor, origin
) :: rest
->
4643 state
.ranchors
<- rest
;
4644 state
.anchor <- anchor;
4645 state
.origin
<- origin
;
4646 state
.nameddest
<- E.s;
4647 opendoc path password
4652 gotoghyll (getnav ~
-1)
4663 Hashtbl.iter
(fun _ opaque -> clearmark
opaque) state
.pagemap
;
4664 G.postRedisplay "dehighlight";
4666 | @slash
| @question
->
4667 let ondone isforw
s =
4668 cbput state
.hists
.pat
s;
4669 state
.searchpattern
<- s;
4672 let s = String.create
1 in
4673 s.[0] <- Char.chr
key;
4674 enttext (s, E.s, Some
(onhist state
.hists
.pat
),
4675 textentry, ondone (key = @slash
), true)
4677 | @plus
| @kpplus
| @equals
when ctrl ->
4678 let incr = if conf
.zoom +. 0.01 > 0.1 then 0.1 else 0.01 in
4679 setzoom (conf
.zoom +. incr)
4681 | @plus
| @kpplus
->
4684 try int_of_string
s with exc
->
4685 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
);
4691 state
.text <- "page bias is now " ^ string_of_int
n;
4694 enttext ("page bias: ", E.s, None
, intentry, ondone, true)
4696 | @minus
| @kpminus
when ctrl ->
4697 let decr = if conf
.zoom -. 0.1 < 0.1 then 0.01 else 0.1 in
4698 setzoom (max
0.01 (conf
.zoom -. decr))
4700 | @minus
| @kpminus
->
4701 let ondone msg
= state
.text <- msg
in
4703 "option [acfhilpstvxACFPRSZTISM]: ", E.s, None
,
4704 optentry state
.mode, ondone, true
4715 | (@1 | @2) when ctrl && conf
.fitmodel
!= FitPage
-> (* ctrl-1/2 *)
4717 match conf
.columns
with
4718 | Csingle
_ | Cmulti
_ -> 1
4719 | Csplit
(n, _) -> n
4721 let h = state
.winh
-
4722 conf
.interpagespace
lsl (if conf
.presentation
then 1 else 0)
4724 let zoom = zoomforh state
.winw
h (vscrollw ()) cols in
4725 if zoom > 0.0 && (key = 50 || zoom < 1.0)
4730 match conf
.fitmodel
with
4731 | FitWidth
-> FitProportional
4732 | FitProportional
-> FitPage
4733 | FitPage
-> FitWidth
4735 state
.text <- "fit model: " ^
FMTE.to_string
fm;
4736 reqlayout conf
.angle
fm
4744 | (48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57)
4745 when not
ctrl -> (* 0..9 *)
4748 try int_of_string
s with exc
->
4749 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
);
4755 cbput state
.hists
.pag
(string_of_int
n);
4756 gotopage1 (n + conf
.pagebias
- 1) 0;
4759 let pageentry text key =
4760 match Char.unsafe_chr
key with
4761 | '
g'
-> TEdone
text
4762 | _ -> intentry text key
4764 let text = "x" in text.[0] <- Char.chr
key;
4765 enttext (":", text, Some
(onhist state
.hists
.pag
), pageentry, ondone, true)
4768 conf
.scrollb
<- if conf
.scrollb
= 0 then (scrollbvv
lor scrollbhv
) else 0;
4769 reshape state
.winw state
.winh
;
4772 state
.bzoom
<- not state
.bzoom
;
4774 showtext ' '
("block zoom " ^
if state
.bzoom
then "on" else "off")
4777 conf
.hlinks
<- not conf
.hlinks
;
4778 state
.text <- "highlightlinks " ^
if conf
.hlinks
then "on" else "off";
4779 G.postRedisplay "toggle highlightlinks";
4782 state
.glinks
<- true;
4783 let mode = state
.mode in
4784 state
.mode <- Textentry
(
4785 (":", E.s, None
, linknentry, linkndone gotounder, false),
4787 state
.glinks
<- false;
4791 G.postRedisplay "view:linkent(F)"
4794 state
.glinks
<- true;
4795 let mode = state
.mode in
4796 state
.mode <- Textentry
(
4798 ":", E.s, None
, linknentry, linkndone (fun under ->
4799 selstring (undertext under);
4803 state
.glinks
<- false;
4807 G.postRedisplay "view:linkent"
4810 begin match state
.autoscroll
with
4812 conf
.autoscrollstep
<- step
;
4813 state
.autoscroll
<- None
4815 if conf
.autoscrollstep
= 0
4816 then state
.autoscroll
<- Some
1
4817 else state
.autoscroll
<- Some conf
.autoscrollstep
4824 setpresentationmode (not conf
.presentation
);
4825 showtext ' '
("presentation mode " ^
4826 if conf
.presentation
then "on" else "off");
4829 if List.mem
Wsi.Fullscreen state
.winstate
4830 then Wsi.reshape conf
.cwinw conf
.cwinh
4831 else Wsi.fullscreen
()
4834 search state
.searchpattern
false
4837 search state
.searchpattern
true
4840 begin match state
.layout with
4843 gotoghyll (getpagey
l.pageno)
4849 | @delete
| @kpdelete
-> (* delete *)
4853 showtext ' '
(describe_location ());
4856 begin match state
.layout with
4859 Wsi.reshape (l.pagew
+ vscrollw ()) l.pageh
;
4864 enterbookmarkmode ()
4872 | @e when Buffer.length state
.errmsgs
> 0 ->
4877 match state
.layout with
4882 (s, 0, Oanchor
(getanchor1
l)) :: state
.bookmarks
4885 enttext ("bookmark: ", E.s, None
, textentry, ondone, true)
4889 showtext ' '
"Quick bookmark added";
4892 begin match state
.layout with
4894 let rect = getpdimrect
l.pagedimno
in
4898 (truncate
(1.8 *. (rect.(1) -. rect.(0))),
4899 truncate
(1.2 *. (rect.(3) -. rect.(0))))
4901 (truncate
(rect.(1) -. rect.(0)),
4902 truncate
(rect.(3) -. rect.(0)))
4904 let w = truncate
((float w)*.conf
.zoom)
4905 and h = truncate
((float h)*.conf
.zoom) in
4908 state
.anchor <- getanchor
();
4909 Wsi.reshape (w + vscrollw ()) (h + conf
.interpagespace
)
4911 G.postRedisplay "z";
4916 | @x -> state
.roam
()
4919 reqlayout (conf
.angle
+ (if key = @question
then 30 else -30)) conf
.fitmodel
4923 bound
(conf
.colorscale
+. (if key = 93 then 0.1 else -0.1)) 0.0 1.0
4925 G.postRedisplay "brightness";
4927 | @c when state
.mode = View
->
4932 let m = (wadjsb state
.winw
- state
.w) / 2 in
4934 gotoy_and_clear_text state
.y
4938 match state
.prevcolumns
with
4939 | None
-> (1, 0, 0), 1.0
4940 | Some
(columns
, z
) ->
4943 | Csplit
(c, _) -> -c, 0, 0
4944 | Cmulti
((c, a, b), _) -> c, a, b
4945 | Csingle
_ -> 1, 0, 0
4949 setcolumns View
c a b;
4952 | @down
| @up
when ctrl && Wsi.withshift mask
->
4953 let zoom, x = state
.prevzoom
in
4957 | @k
| @up
| @kpup
->
4958 begin match state
.autoscroll
with
4960 begin match state
.mode with
4961 | Birdseye beye
-> upbirdseye 1 beye
4964 then gotoy_and_clear_text (clamp ~
-(state
.winh
/2))
4966 if not
(Wsi.withshift mask
) && conf
.presentation
4968 else gotoghyll1 true (clamp (-conf
.scrollstep
))
4972 setautoscrollspeed n false
4975 | @j
| @down
| @kpdown
->
4976 begin match state
.autoscroll
with
4978 begin match state
.mode with
4979 | Birdseye beye
-> downbirdseye 1 beye
4982 then gotoy_and_clear_text (clamp (state
.winh
/2))
4984 if not
(Wsi.withshift mask
) && conf
.presentation
4986 else gotoghyll1 true (clamp (conf
.scrollstep
))
4990 setautoscrollspeed n true
4993 | @left | @right
| @kpleft
| @kpright
when not
(Wsi.withalt mask
) ->
4999 else conf
.hscrollstep
5001 let dx = if key = @left || key = @kpleft
then dx else -dx in
5002 state
.x <- panbound (state
.x + dx);
5003 gotoy_and_clear_text state
.y
5006 G.postRedisplay "left/right"
5009 | @prior
| @kpprior
->
5013 match state
.layout with
5015 | l :: _ -> state
.y - l.pagey
5017 clamp (pgscale (-state
.winh
))
5021 | @next | @kpnext
->
5025 match List.rev state
.layout with
5027 | l :: _ -> getpagey
l.pageno
5029 clamp (pgscale state
.winh
)
5033 | @g | @home
| @kphome
->
5035 | @G
| @jend
| @kpend
->
5036 gotoghyll (clamp state
.maxy)
5038 | @right
| @kpright
when Wsi.withalt mask
->
5039 gotoghyll (getnav 1)
5040 | @left | @kpleft
when Wsi.withalt mask
->
5041 gotoghyll (getnav ~
-1)
5046 | @v when conf
.debug
->
5049 match getopaque l.pageno with
5052 let x0, y0, x1, y1 = pagebbox
opaque in
5053 let a,b = float x0, float y0 in
5054 let c,d = float x1, float y0 in
5055 let e,f = float x1, float y1 in
5056 let h,j
= float x0, float y1 in
5057 let rect = (a,b,c,d,e,f,h,j
) in
5059 state
.rects
<- (l.pageno, l.pageno mod 3, rect) :: state
.rects
;
5061 G.postRedisplay "v";
5064 let mode = state
.mode in
5065 let cmd = ref E.s in
5066 let onleave = function
5067 | Cancel
-> state
.mode <- mode
5070 match getopaque l.pageno with
5071 | Some
opaque -> pipesel opaque !cmd
5072 | None
-> ()) state
.layout;
5076 cbput state
.hists
.sel
s;
5080 "| ", !cmd, Some
(onhist state
.hists
.sel
), textentry, ondone, true
5082 G.postRedisplay "|";
5083 state
.mode <- Textentry
(te, onleave);
5086 vlog "huh? %s" (Wsi.keyname
key)
5089 let linknavkeyboard key mask
linknav =
5090 let getpage pageno =
5091 let rec loop = function
5093 | l :: _ when l.pageno = pageno -> Some
l
5094 | _ :: rest
-> loop rest
5095 in loop state
.layout
5097 let doexact (pageno, n) =
5098 match getopaque pageno, getpage pageno with
5099 | Some
opaque, Some
l ->
5100 if key = @enter
|| key = @kpenter
5102 let under = getlink
opaque n in
5103 G.postRedisplay "link gotounder";
5110 Some
(findlink
opaque LDfirst
), -1
5113 Some
(findlink
opaque LDlast
), 1
5116 Some
(findlink
opaque (LDleft
n)), -1
5119 Some
(findlink
opaque (LDright
n)), 1
5122 Some
(findlink
opaque (LDup
n)), -1
5125 Some
(findlink
opaque (LDdown
n)), 1
5130 begin match findpwl
l.pageno dir with
5134 state
.mode <- LinkNav
(Ltgendir
dir);
5135 let y, h = getpageyh
pageno in
5138 then y + h - state
.winh
5143 begin match getopaque pageno, getpage pageno with
5144 | Some
opaque, Some
_ ->
5146 let ld = if dir > 0 then LDfirst
else LDlast
in
5149 begin match link with
5151 showlinktype (getlink
opaque m);
5152 state
.mode <- LinkNav
(Ltexact
(pageno, m));
5153 G.postRedisplay "linknav jpage";
5160 begin match opt with
5161 | Some Lnotfound
-> pwl l dir;
5162 | Some
(Lfound
m) ->
5166 let _, y0, _, y1 = getlinkrect
opaque m in
5168 then gotopage1 l.pageno y0
5170 let d = fstate
.fontsize
+ 1 in
5171 if y1 - l.pagey > l.pagevh - d
5172 then gotopage1 l.pageno (y1 - state
.winh
- hscrollh () + d)
5173 else G.postRedisplay "linknav";
5175 showlinktype (getlink
opaque m);
5176 state
.mode <- LinkNav
(Ltexact
(l.pageno, m));
5179 | None
-> viewkeyboard key mask
5181 | _ -> viewkeyboard key mask
5186 G.postRedisplay "leave linknav"
5190 | Ltgendir
_ -> viewkeyboard key mask
5191 | Ltexact exact
-> doexact exact
5194 let keyboard key mask
=
5195 if (key = 103 && Wsi.withctrl mask
) && not
(istextentry state
.mode)
5196 then wcmd "interrupt"
5197 else state
.uioh <- state
.uioh#
key key mask
5200 let birdseyekeyboard key mask
5201 ((oconf
, leftx
, pageno, hooverpageno
, anchor) as beye
) =
5203 match conf
.columns
with
5205 | Cmulti
((c, _, _), _) -> c
5206 | Csplit
_ -> failwith
"bird's eye split mode"
5208 let pgh layout = List.fold_left
(fun m l -> max
l.pageh
m) state
.winh
layout in
5210 | @l when Wsi.withctrl mask
->
5211 let y, h = getpageyh
pageno in
5212 let top = (state
.winh
- h) / 2 in
5213 gotoy (max
0 (y - top))
5214 | @enter
| @kpenter
-> leavebirdseye beye
false
5215 | @escape
-> leavebirdseye beye
true
5216 | @up
-> upbirdseye incr beye
5217 | @down
-> downbirdseye incr beye
5218 | @left -> upbirdseye 1 beye
5219 | @right
-> downbirdseye 1 beye
5222 begin match state
.layout with
5226 state
.mode <- Birdseye
(
5227 oconf
, leftx
, l.pageno, hooverpageno
, anchor
5229 gotopage1 l.pageno 0;
5232 let layout = layout (state
.y-state
.winh
) (pgh state
.layout) in
5234 | [] -> gotoy (clamp (-state
.winh
))
5236 state
.mode <- Birdseye
(
5237 oconf
, leftx
, l.pageno, hooverpageno
, anchor
5239 gotopage1 l.pageno 0
5242 | [] -> gotoy (clamp (-state
.winh
))
5246 begin match List.rev state
.layout with
5248 let layout = layout (state
.y + (pgh state
.layout)) state
.winh
in
5249 begin match layout with
5251 let incr = l.pageh
- l.pagevh in
5256 oconf
, leftx
, state
.pagecount
- 1, hooverpageno
, anchor
5258 G.postRedisplay "birdseye pagedown";
5260 else gotoy (clamp (incr + conf
.interpagespace
*2));
5264 Birdseye
(oconf
, leftx
, l.pageno, hooverpageno
, anchor);
5265 gotopage1 l.pageno 0;
5268 | [] -> gotoy (clamp state
.winh
)
5272 state
.mode <- Birdseye
(oconf
, leftx
, 0, hooverpageno
, anchor);
5276 let pageno = state
.pagecount
- 1 in
5277 state
.mode <- Birdseye
(oconf
, leftx
, pageno, hooverpageno
, anchor);
5278 if not
(pagevisible state
.layout pageno)
5281 match List.rev state
.pdims
with
5283 | (_, _, h, _) :: _ -> h
5285 gotoy (max
0 (getpagey
pageno - (state
.winh
- h - conf
.interpagespace
)))
5286 else G.postRedisplay "birdseye end";
5288 | _ -> viewkeyboard key mask
5293 match state
.mode with
5294 | Textentry
_ -> scalecolor 0.4
5296 | View
-> scalecolor 1.0
5297 | Birdseye
(_, _, pageno, hooverpageno
, _) ->
5298 if l.pageno = hooverpageno
5301 if l.pageno = pageno
5309 let postdrawpage l linkindexbase
=
5310 match getopaque l.pageno with
5312 if tileready l l.pagex
l.pagey
5314 let x = l.pagedispx - l.pagex
+ xadjsb 0
5315 and y = l.pagedispy - l.pagey in
5317 match conf
.columns
with
5318 | Csingle
_ | Cmulti
_ ->
5319 (if conf
.hlinks
then 1 else 0)
5321 && not
(isbirdseye state
.mode) then 2 else 0)
5325 match state
.mode with
5326 | Textentry
((_, s, _, _, _, _), _) when state
.glinks
-> s
5329 postprocess
opaque hlmask x y (linkindexbase
, s, conf
.hfsize
);
5334 let scrollindicator () =
5335 let sbw, ph
, sh = state
.uioh#
scrollph in
5336 let sbh, pw, sw = state
.uioh#scrollpw
in
5341 else (state
.winw
- sbw), state
.winw
5344 GlDraw.color (0.64, 0.64, 0.64);
5345 filledrect (float x0) 0. (float x1) (float state
.winh
);
5347 0. (float (state
.winh
- sbh))
5348 (float (wadjsb state
.winw
- 1)) (float state
.winh
)
5350 GlDraw.color (0.0, 0.0, 0.0);
5352 filledrect (float x0) ph
(float x1) (ph
+. sh);
5353 filledrect pw (float (state
.winh
- sbh)) (pw +. sw) (float state
.winh
);
5357 match state
.mstate
with
5358 | Mnone
| Mscrolly
| Mscrollx
| Mpan
_ | Mzoom
_ | Mzoomrect
_ ->
5361 | Msel
((x0, y0), (x1, y1)) ->
5362 let identify opaque l px py = Some
(opaque, l.pageno, px, py) in
5363 let o0,n0
,px0
,py0
= onppundermouse identify x0 y0 (~
< E.s, -1, 0, 0) in
5364 let _o1,n1
,px1
,py1
= onppundermouse identify x1 y1 (~
< E.s, -1, 0, 0) in
5365 if n0
!= -1 && n0
= n1
then seltext
o0 (px0
, py0
, px1
, py1
);
5368 let showrects = function [] -> () | rects
->
5370 GlDraw.color (0.0, 0.0, 1.0) ~
alpha:0.5;
5371 GlFunc.blend_func `src_alpha `one_minus_src_alpha
;
5373 (fun (pageno, c, (x0, y0, x1, y1, x2
, y2
, x3
, y3
)) ->
5375 if l.pageno = pageno
5377 let dx = float (l.pagedispx - l.pagex
) in
5378 let dy = float (l.pagedispy - l.pagey) in
5379 GlDraw.color (0.0, 0.0, 1.0 /. float c) ~
alpha:0.5;
5380 Raw.sets_float state
.vraw ~
pos:0
5385 GlArray.vertex `two state
.vraw
;
5386 GlArray.draw_arrays `triangle_strip
0 4;
5395 GlClear.color (scalecolor2 conf
.bgcolor
);
5396 GlClear.clear
[`
color];
5397 List.iter
drawpage state
.layout;
5399 match state
.mode with
5400 | LinkNav
(Ltexact
(pageno, linkno
)) ->
5401 begin match getopaque pageno with
5403 let dx = xadjsb 0 in
5404 let x0, y0, x1, y1 = getlinkrect
opaque linkno
in
5405 let x0 = x0 + dx and x1 = x1 + dx in
5412 | None
-> state
.rects
5417 let rec postloop linkindexbase
= function
5419 let linkindexbase = linkindexbase + postdrawpage l linkindexbase in
5420 postloop linkindexbase rest
5424 postloop 0 state
.layout;
5426 begin match state
.mstate
with
5427 | Mzoomrect
((x0, y0), (x1, y1)) ->
5429 GlDraw.color (0.3, 0.3, 0.3) ~
alpha:0.5;
5430 GlFunc.blend_func `src_alpha `one_minus_src_alpha
;
5431 filledrect (float x0) (float y0) (float x1) (float y1);
5440 let zoomrect x y x1 y1 =
5443 and y0 = min
y y1 in
5444 gotoy (state
.y + y0);
5445 state
.anchor <- getanchor
();
5446 let zoom = (float state
.w) /. float (x1 - x0) in
5448 match conf
.fitmodel
, conf
.columns
with
5449 | FitPage
, Csplit
_ ->
5450 onppundermouse (fun _ l _ _ -> Some
l.pagedispx) x0 y0 x0
5453 let adjw = wadjsb state
.winw
in
5455 then (adjw - state
.w) / 2
5458 state
.x <- (state
.x + margin) - x0;
5464 let g opaque l px py =
5465 match rectofblock
opaque px py with
5467 let x0 = a.(0) -. 20. in
5468 let x1 = a.(1) +. 20. in
5469 let y0 = a.(2) -. 20. in
5470 let zoom = (float state
.w) /. (x1 -. x0) in
5471 let pagey = getpagey
l.pageno in
5472 gotoy_and_clear_text (pagey + truncate
y0);
5473 state
.anchor <- getanchor
();
5474 let margin = (state
.w - l.pagew
)/2 in
5475 state
.x <- -truncate
x0 - margin;
5480 match conf
.columns
with
5482 showtext '
!'
"block zooming does not work properly in split columns mode"
5483 | _ -> onppundermouse g x y ()
5487 let winw = wadjsb state
.winw - 1 in
5488 let s = float x /. float winw in
5489 let destx = truncate
(float (state
.w + winw) *. s) in
5490 state
.x <- winw - destx;
5491 gotoy_and_clear_text state
.y;
5492 state
.mstate
<- Mscrollx
;
5496 let s = float y /. float state
.winh
in
5497 let desty = truncate
(float (state
.maxy - state
.winh
) *. s) in
5498 gotoy_and_clear_text desty;
5499 state
.mstate
<- Mscrolly
;
5502 let viewmulticlick clicks
x y mask
=
5503 let g opaque l px py =
5511 if markunder
opaque px py mark
5515 match getopaque l.pageno with
5517 | Some
opaque -> pipesel opaque cmd
5519 state
.roam
<- (fun () -> dopipe conf
.paxcmd
);
5520 if not
(Wsi.withctrl mask
) then dopipe conf
.selcmd
;
5525 G.postRedisplay "viewmulticlick";
5526 onppundermouse g x y (fun () -> showtext '
!'
"Nothing to select") ();
5530 match conf
.columns
with
5532 | Csingle
_ | Cmulti
_ -> conf
.angle
mod 360 = 0
5535 let viewmouse button down
x y mask
=
5537 | n when (n == 4 || n == 5) && not down
->
5538 if Wsi.withctrl mask
5540 match state
.mstate
with
5541 | Mzoom
(oldn
, i
) ->
5549 if conf
.zoom +. 0.01 > 0.1 then 0.1 else 0.01
5551 if conf
.zoom -. 0.1 < 0.1 then -0.01 else -0.1
5553 let zoom = conf
.zoom -. incr in
5555 state
.mstate
<- Mzoom
(n, 0);
5557 state
.mstate
<- Mzoom
(n, i
+1);
5559 else state
.mstate
<- Mzoom
(n, 0)
5561 | _ -> state
.mstate
<- Mzoom
(n, 0)
5564 match state
.autoscroll
with
5565 | Some step
-> setautoscrollspeed step
(n=4)
5567 if conf
.wheelbypage
|| conf
.presentation
5576 then -conf
.scrollstep
5577 else conf
.scrollstep
5579 let incr = incr * 2 in
5580 let y = clamp incr in
5581 gotoy_and_clear_text y
5584 | n when (n = 6 || n = 7) && not down
&& canpan () ->
5586 panbound (state
.x + (if n = 7 then -2 else 2) * conf
.hscrollstep
);
5587 gotoy_and_clear_text state
.y
5589 | 1 when Wsi.withshift mask
->
5590 state
.mstate
<- Mnone
;
5593 match unproject x y with
5594 | Some
(pageno, ux
, uy
) ->
5595 let cmd = Printf.sprintf
5597 conf
.stcmd state
.path pageno ux uy
5603 | 1 when Wsi.withctrl mask
->
5606 Wsi.setcursor
Wsi.CURSOR_CROSSHAIR
;
5607 state
.mstate
<- Mpan
(x, y)
5610 state
.mstate
<- Mnone
5615 Wsi.setcursor
Wsi.CURSOR_CYCLE
;
5617 state
.mstate
<- Mzoomrect
(p, p)
5620 match state
.mstate
with
5621 | Mzoomrect
((x0, y0), _) ->
5622 if abs
(x-x0) > 10 && abs
(y - y0) > 10
5623 then zoomrect x0 y0 x y
5626 G.postRedisplay "kill accidental zoom rect";
5632 | 1 when x > state
.winw - vscrollw () ->
5635 let _, position, sh = state
.uioh#
scrollph in
5636 if y > truncate
position && y < truncate
(position +. sh)
5637 then state
.mstate
<- Mscrolly
5640 state
.mstate
<- Mnone
5642 | 1 when y > state
.winh
- hscrollh () ->
5645 let _, position, sw = state
.uioh#scrollpw
in
5646 if x > truncate
position && x < truncate
(position +. sw)
5647 then state
.mstate
<- Mscrollx
5650 state
.mstate
<- Mnone
5652 | 1 when state
.bzoom
-> if not down
then zoomblock x y
5655 let dest = if down
then getunder x y else Unone
in
5656 begin match dest with
5659 | Uremote
_ | Uremotedest
_
5660 | Uunexpected
_ | Ulaunch
_ | Unamed
_ ->
5663 | Unone
when down
->
5664 Wsi.setcursor
Wsi.CURSOR_CROSSHAIR
;
5665 state
.mstate
<- Mpan
(x, y);
5667 | Unone
| Utext
_ ->
5672 state
.mstate
<- Msel
((x, y), (x, y));
5673 G.postRedisplay "mouse select";
5677 match state
.mstate
with
5680 | Mzoom
_ | Mscrollx
| Mscrolly
->
5681 state
.mstate
<- Mnone
5683 | Mzoomrect
((x0, y0), _) ->
5687 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
5688 state
.mstate
<- Mnone
5690 | Msel
((x0, y0), (x1, y1)) ->
5691 let rec loop = function
5695 let a0 = l.pagedispy in
5696 let a1 = a0 + l.pagevh in
5697 let b0 = l.pagedispx in
5698 let b1 = b0 + l.pagevw in
5699 ((y0 >= a0 && y0 <= a1) || (y1 >= a0 && y1 <= a1))
5700 && ((x0 >= b0 && x0 <= b1) || (x1 >= b0 && x1 <= b1))
5704 match getopaque l.pageno with
5707 match Ne.res Unix.pipe
with
5711 "can not create sel pipe: %s"
5715 Ne.clo fd
(fun msg
->
5716 dolog
"%s close failed: %s" what msg
)
5719 try popen
cmd [r, 0; w, -1]; true
5721 dolog
"can not execute %S: %s"
5728 G.postRedisplay "copysel";
5730 else clo "Msel pipe/w" w;
5731 clo "Msel pipe/r" r;
5733 dosel conf
.selcmd
();
5734 state
.roam
<- dosel conf
.paxcmd
;
5746 let birdseyemouse button down
x y mask
5747 (conf
, leftx
, _, hooverpageno
, anchor) =
5750 let rec loop = function
5753 if y > l.pagedispy && y < l.pagedispy + l.pagevh
5754 && x > l.pagedispx && x < l.pagedispx + l.pagevw
5756 leavebirdseye (conf
, leftx
, l.pageno, hooverpageno
, anchor) false;
5762 | _ -> viewmouse button down
x y mask
5768 method key key mask
=
5769 begin match state
.mode with
5770 | Textentry
textentry -> textentrykeyboard key mask
textentry
5771 | Birdseye
birdseye -> birdseyekeyboard key mask
birdseye
5772 | View
-> viewkeyboard key mask
5773 | LinkNav
linknav -> linknavkeyboard key mask
linknav
5777 method button button bstate
x y mask
=
5778 begin match state
.mode with
5780 | View
-> viewmouse button bstate
x y mask
5781 | Birdseye beye
-> birdseyemouse button bstate
x y mask beye
5786 method multiclick clicks
x y mask
=
5787 begin match state
.mode with
5789 | View
-> viewmulticlick clicks
x y mask
5796 begin match state
.mode with
5798 | View
| Birdseye
_ | LinkNav
_ ->
5799 match state
.mstate
with
5800 | Mzoom
_ | Mnone
-> ()
5805 state
.mstate
<- Mpan
(x, y);
5807 then state
.x <- panbound (state
.x + dx);
5809 gotoy_and_clear_text y
5812 state
.mstate
<- Msel
(a, (x, y));
5813 G.postRedisplay "motion select";
5816 let y = min state
.winh
(max
0 y) in
5820 let x = min state
.winw (max
0 x) in
5823 | Mzoomrect
(p0
, _) ->
5824 state
.mstate
<- Mzoomrect
(p0
, (x, y));
5825 G.postRedisplay "motion zoomrect";
5829 method pmotion
x y =
5830 begin match state
.mode with
5831 | Birdseye
(conf
, leftx
, pageno, hooverpageno
, anchor) ->
5832 let rec loop = function
5834 if hooverpageno
!= -1
5836 state
.mode <- Birdseye
(conf
, leftx
, pageno, -1, anchor);
5837 G.postRedisplay "pmotion birdseye no hoover";
5840 if y > l.pagedispy && y < l.pagedispy + l.pagevh
5841 && x > l.pagedispx && x < l.pagedispx + l.pagevw
5843 state
.mode <- Birdseye
(conf
, leftx
, pageno, l.pageno, anchor);
5844 G.postRedisplay "pmotion birdseye hoover";
5854 match state
.mstate
with
5855 | Mpan
_ | Msel
_ | Mzoom
_ | Mscrolly
| Mscrollx
| Mzoomrect
_ ->
5864 let past, _, _ = !r in
5866 let delta = now -. past in
5869 else r := (now, x, y)
5873 method infochanged
_ = ()
5876 let maxy = state
.maxy - (if conf
.maxhfit
then state
.winh
else 0) in
5879 then 0.0, float state
.winh
5880 else scrollph state
.y maxy
5885 let winw = wadjsb state
.winw in
5886 let fwinw = float winw in
5888 let sw = fwinw /. float state
.w in
5889 let sw = fwinw *. sw in
5890 max
sw (float conf
.scrollh
)
5893 let maxx = state
.w + winw in
5894 let x = winw - state
.x in
5895 let percent = float x /. float maxx in
5896 (fwinw -. sw) *. percent
5898 hscrollh (), position, sw
5902 match state
.mode with
5903 | LinkNav
_ -> "links"
5904 | Textentry
_ -> "textentry"
5905 | Birdseye
_ -> "birdseye"
5908 findkeyhash conf
modename
5910 method eformsgs
= true
5913 let adderrmsg src msg
=
5914 Buffer.add_string state
.errmsgs msg
;
5915 state
.newerrmsgs
<- true;
5919 let adderrfmt src fmt
=
5920 Format.kprintf
(fun s -> adderrmsg src s) fmt
;
5924 let cl = splitatspace cmds
in
5926 try Scanf.sscanf
s fmt
f
5928 adderrfmt "remote exec"
5929 "error processing '%S': %s\n" cmds
(exntos exn
)
5932 | "reload" :: [] -> reload ()
5933 | "goto" :: args
:: [] ->
5934 scan args
"%u %f %f"
5936 let cmd, _ = state
.geomcmds
in
5938 then gotopagexy pageno x y
5941 gotopagexy pageno x y;
5944 state
.reprf
<- f state
.reprf
5946 | "goto1" :: args
:: [] -> scan args
"%u %f" gotopage
5947 | "gotor" :: args
:: [] ->
5949 (fun filename
pageno -> gotounder (Uremote
(filename
, pageno)))
5950 | "gotord" :: args
:: [] ->
5952 (fun filename
dest -> gotounder (Uremotedest
(filename
, dest)))
5953 | "rect" :: args
:: [] ->
5954 scan args
"%u %u %f %f %f %f"
5955 (fun pageno color x0 y0 x1 y1 ->
5956 onpagerect pageno (fun w h ->
5957 let _,w1,h1
,_ = getpagedim
pageno in
5958 let sw = float w1 /. float w
5959 and sh = float h1
/. float h in
5963 and y1s
= y1 *. sh in
5964 let rect = (x0s,y0s
,x1s
,y0s
,x1s
,y1s
,x0s,y1s
) in
5966 state
.rects <- (pageno, color, rect) :: state
.rects;
5967 G.postRedisplay "rect";
5970 | "activatewin" :: [] -> Wsi.activatewin
()
5971 | "quit" :: [] -> raise Quit
5973 adderrfmt "remote command"
5974 "error processing remote command: %S\n" cmds
;
5978 let scratch = String.create
80 in
5979 let buf = Buffer.create
80 in
5982 try Some
(Unix.read fd
scratch 0 80)
5984 | Unix.Unix_error
(Unix.EAGAIN
, _, _) -> None
5985 | Unix.Unix_error
(Unix.EINTR
, _, _) -> tempfr ()
5988 match tempfr () with
5994 if Buffer.length
buf > 0
5996 let s = Buffer.contents
buf in
6006 let pos = String.index_from
scratch ppos '
\n'
in
6007 if pos >= n then -1 else pos
6008 with Not_found
-> -1
6012 Buffer.add_substring
buf scratch ppos
(nlpos-ppos
);
6013 let s = Buffer.contents
buf in
6019 Buffer.add_substring
buf scratch ppos
(n-ppos
);
6025 let remoteopen path =
6026 try Some
(Unix.openfile
path [Unix.O_NONBLOCK
; Unix.O_RDONLY
] 0o0)
6028 adderrfmt "remoteopen" "error opening %S: %s" path (exntos exn
);
6033 let trimcachepath = ref E.s in
6034 let rcmdpath = ref E.s in
6035 let pageno = ref None
in
6036 selfexec := Sys.executable_name
;
6039 [("-p", Arg.String
(fun s -> state
.password
<- s),
6040 "<password> Set password");
6044 Config.fontpath
:= s;
6045 selfexec := !selfexec ^
" -f " ^
Filename.quote
s;
6047 "<path> Set path to the user interface font");
6051 selfexec := !selfexec ^
" -c " ^
Filename.quote
s;
6052 Config.confpath
:= s),
6053 "<path> Set path to the configuration file");
6055 ("-page", Arg.Int
(fun pageno1
-> pageno := Some
(pageno1
-1)),
6056 "<page-number> Jump to page");
6058 ("-tcf", Arg.String
(fun s -> trimcachepath := s),
6059 "<path> Set path to the trim cache file");
6061 ("-dest", Arg.String
(fun s -> state
.nameddest
<- s),
6062 "<named-destination> Set named destination");
6064 ("-wtmode", Arg.Set
wtmode, " Operate in wt mode");
6065 ("-cxack", Arg.Set
cxack, " Cut corners");
6067 ("-remote", Arg.String
(fun s -> rcmdpath := s),
6068 "<path> Set path to the remote commands source");
6070 ("-origin", Arg.String
(fun s -> state
.origin
<- s),
6071 "<original-path> Set original path");
6073 ("-v", Arg.Unit
(fun () ->
6075 "%s\nconfiguration path: %s\n"
6079 exit
0), " Print version and exit");
6082 (fun s -> state
.path <- s)
6083 ("Usage: " ^
Sys.argv
.(0) ^
" [options] some.pdf\nOptions:")
6086 then selfexec := !selfexec ^
" -wtmode";
6088 let histmode = emptystr state
.path in
6090 if not
(Config.load ())
6091 then prerr_endline
"failed to load configuration";
6092 begin match !pageno with
6093 | Some
pageno -> state
.anchor <- (pageno, 0.0, 0.0)
6097 let wsfd, winw, winh
= Wsi.init
(object (self)
6098 val mutable m_hack
= false
6099 val mutable m_clicks
= 0
6100 val mutable m_click_x
= 0
6101 val mutable m_click_y
= 0
6102 val mutable m_lastclicktime
= infinity
6104 method private cleanup
=
6105 state
.roam
<- noroam
;
6106 Hashtbl.iter
(fun _ opaque -> clearmark
opaque) state
.pagemap
;
6107 method expose
= if not m_hack
then G.postRedisplay "expose"
6108 method visible
= G.postRedisplay "visible"
6109 method display = m_hack
<- false; display ()
6110 method reshape w h =
6112 m_hack
<- w < state
.winw && h < state
.winh
;
6114 method mouse
b d x y m =
6115 if d && canselect ()
6117 (* http://blogs.msdn.com/b/oldnewthing/archive/2004/10/18/243925.aspx *)
6123 if abs
x - m_click_x
> 10
6124 || abs
y - m_click_y
> 10
6125 || abs_float
(t -. m_lastclicktime
) > 0.3
6127 m_clicks
<- m_clicks
+ 1;
6128 m_lastclicktime
<- t;
6132 G.postRedisplay "cleanup";
6133 state
.uioh <- state
.uioh#button
b d x y m;
6135 else state
.uioh <- state
.uioh#multiclick m_clicks
x y m
6140 m_lastclicktime
<- infinity
;
6141 state
.uioh <- state
.uioh#button
b d x y m
6145 state
.uioh <- state
.uioh#button
b d x y m
6148 state
.mpos
<- (x, y);
6149 state
.uioh <- state
.uioh#motion
x y
6150 method pmotion
x y =
6151 state
.mpos
<- (x, y);
6152 state
.uioh <- state
.uioh#pmotion
x y
6154 let mascm = m land (
6155 Wsi.altmask
+ Wsi.shiftmask
+ Wsi.ctrlmask
+ Wsi.metamask
6158 let x = state
.x and y = state
.y in
6160 if x != state
.x || y != state
.y then self#cleanup
6162 match state
.keystate
with
6164 let km = k
, mascm in
6167 let modehash = state
.uioh#
modehash in
6168 try Hashtbl.find modehash km
6170 try Hashtbl.find (findkeyhash conf
"global") km
6171 with Not_found
-> KMinsrt
(k
, m)
6173 | KMinsrt
(k
, m) -> keyboard k
m
6174 | KMinsrl
l -> List.iter
(fun (k
, m) -> keyboard k
m) l
6175 | KMmulti
(l, r) -> state
.keystate
<- KSinto
(l, r)
6177 | KSinto
((k'
, m'
) :: [], insrt
) when k'
=k
&& m'
land mascm = m'
->
6178 List.iter
(fun (k
, m) -> keyboard k
m) insrt
;
6179 state
.keystate
<- KSnone
6180 | KSinto
((k'
, m'
) :: keys
, insrt
) when k'
=k
&& m'
land mascm = m'
->
6181 state
.keystate
<- KSinto
(keys
, insrt
)
6183 state
.keystate
<- KSnone
6186 state
.mpos
<- (x, y);
6187 state
.uioh <- state
.uioh#pmotion
x y
6188 method leave = state
.mpos
<- (-1, -1)
6189 method winstate wsl
= state
.winstate
<- wsl
; m_hack
<- false
6190 method quit
= raise Quit
6191 end) conf
.cwinw conf
.cwinh
(platform
= Posx
) in
6196 List.exists
GlMisc.check_extension
6197 [ "GL_ARB_texture_rectangle"
6198 ; "GL_EXT_texture_recangle"
6199 ; "GL_NV_texture_rectangle" ]
6201 then (prerr_endline
"OpenGL does not suppport rectangular textures"; exit
1);
6204 let r = GlMisc.get_string `renderer
in
6205 let p = "Mesa DRI Intel(" in
6206 let l = String.length
p in
6207 String.length
r > l && String.sub
r 0 l = p
6210 defconf
.sliceheight
<- 1024;
6211 defconf
.texcount
<- 32;
6212 defconf
.usepbo
<- true;
6216 match Ne.res Unix.pipe
with
6218 Printf.eprintf
"pipe/crsw failed: %s" (exntos exn
);
6222 match Ne.res Unix.pipe
with
6224 Printf.eprintf
"pipe/srcw failed: %s" (exntos exn
);
6234 setcheckers conf
.checkers
;
6236 if conf
.redirectstderr
6239 let s = Buffer.contents state
.errmsgs ^
6240 (match state
.errfd
with
6242 let s = String.create
(80*24) in
6245 let r, _, _ = Unix.select
[fd
] [] [] 0.0 in
6247 then Unix.read fd
s 0 (String.length
s)
6253 else String.sub
s 0 n
6257 try ignore
(Unix.write state
.stderr
s 0 (String.length
s))
6258 with exn
-> print_endline
(exntos exn
)
6263 conf
.angle
, conf
.fitmodel
, (conf
.trimmargins
, conf
.trimfuzz
),
6264 conf
.texcount
, conf
.sliceheight
, conf
.mustoresize
, conf
.colorspace
,
6265 !Config.fontpath
, !trimcachepath,
6266 GlMisc.check_extension
"GL_ARB_pixel_buffer_object"
6268 List.iter
GlArray.enable
[`texture_coord
; `vertex
];
6278 state
.text <- "Opening " ^
(mbtoutf8 state
.path);
6279 opendoc state
.path state
.password
;
6284 Sys.set_signal
Sys.sighup
(Sys.Signal_handle
(fun _ -> reload ()));
6287 if nonemptystr
!rcmdpath
6288 then remoteopen !rcmdpath
6293 let rec loop deadline
=
6295 match state
.errfd
with
6296 | None
-> [state
.sr
; state
.wsfd]
6297 | Some fd
-> [state
.sr
; state
.wsfd; fd
]
6302 | Some fd
-> fd
:: r
6306 state
.redisplay
<- false;
6313 if deadline
= infinity
6315 else max
0.0 (deadline
-. now)
6320 try Unix.select
r [] [] timeout
6321 with Unix.Unix_error
(Unix.EINTR
, _, _) -> [], [], []
6327 if state
.ghyll
== noghyll
6329 match state
.autoscroll
with
6330 | Some step
when step
!= 0 ->
6331 let y = state
.y + step
in
6335 else if y >= state
.maxy then 0 else y
6338 if state
.mode = View
6339 then state
.text <- E.s;
6342 else deadline
+. 0.01
6347 let rec checkfds = function
6349 | fd
:: rest
when fd
= state
.sr
->
6350 let cmd = readcmd state
.sr
in
6354 | fd
:: rest
when fd
= state
.wsfd ->
6358 | fd
:: rest
when Some fd
= !optrfd ->
6359 begin match remote fd
with
6360 | None
-> optrfd := remoteopen !rcmdpath;
6361 | opt -> optrfd := opt
6366 let s = String.create
80 in
6367 let n = tempfailureretry
(Unix.read fd
s 0) 80 in
6368 if conf
.redirectstderr
6370 Buffer.add_substring state
.errmsgs
s 0 n;
6371 state
.newerrmsgs
<- true;
6372 state
.redisplay
<- true;
6375 prerr_string
(String.sub
s 0 n);
6381 if !reeenterhist then (
6383 reeenterhist := false;
6387 if deadline
= infinity
6391 match state
.autoscroll
with
6392 | Some step
when step
!= 0 -> deadline1
6393 | _ -> if state
.ghyll
== noghyll
then infinity
else deadline1
6401 Config.save
leavebirdseye;