6 external init
: Unix.file_descr
-> params
-> unit = "ml_init";;
7 external seltext
: opaque
-> (int * int * int * int) -> unit = "ml_seltext";;
8 external hassel
: opaque
-> bool = "ml_hassel";;
9 external copysel
: Unix.file_descr
-> opaque
-> unit = "ml_copysel";;
10 external getpdimrect
: int -> float array
= "ml_getpdimrect";;
11 external whatsunder
: opaque
-> int -> int -> under
= "ml_whatsunder";;
12 external markunder
: opaque
-> int -> int -> mark
-> bool = "ml_markunder";;
13 external clearmark
: opaque
-> unit = "ml_clearmark";;
14 external zoomforh
: int -> int -> int -> int -> float = "ml_zoom_for_height";;
15 external drawstr
: int -> int -> int -> string -> float = "ml_draw_string";;
16 external measurestr
: int -> string -> float = "ml_measure_string";;
17 external postprocess
:
18 opaque
-> int -> int -> int -> (int * string * int) -> int
20 external pagebbox
: opaque
-> (int * int * int * int) = "ml_getpagebox";;
21 external setaalevel
: int -> unit = "ml_setaalevel";;
22 external realloctexts
: int -> bool = "ml_realloctexts";;
23 external findlink
: opaque
-> linkdir
-> link
= "ml_findlink";;
24 external getlink
: opaque
-> int -> under
= "ml_getlink";;
25 external getlinkrect
: opaque
-> int -> irect
= "ml_getlinkrect";;
26 external getlinkcount
: opaque
-> int = "ml_getlinkcount";;
27 external findpwl
: int -> int -> pagewithlinks
= "ml_find_page_with_links";;
28 external getpbo
: width
-> height
-> colorspace
-> opaque
= "ml_getpbo";;
29 external freepbo
: opaque
-> unit = "ml_freepbo";;
30 external unmappbo
: opaque
-> unit = "ml_unmappbo";;
31 external pbousable
: unit -> bool = "ml_pbo_usable";;
32 external unproject
: opaque
-> int -> int -> (int * int) option
34 external drawtile
: tileparams
-> opaque
-> unit = "ml_drawtile";;
35 external rectofblock
: opaque
-> int -> int -> float array
option
37 external begintiles
: unit -> unit = "ml_begintiles";;
38 external endtiles
: unit -> unit = "ml_endtiles";;
39 external addannot
: opaque
-> int -> int -> string -> unit = "ml_addannot";;
40 external modannot
: opaque
-> slinkindex
-> string -> unit = "ml_modannot";;
41 external delannot
: opaque
-> slinkindex
-> unit = "ml_delannot";;
42 external hasunsavedchanges
: unit -> bool = "ml_hasunsavedchanges";;
43 external savedoc
: string -> unit = "ml_savedoc";;
44 external getannotcontents
: opaque
-> slinkindex
-> string
45 = "ml_getannotcontents";;
47 let reeenterhist = ref false;;
48 let selfexec = ref E.s
;;
50 let drawstring size x y s
=
52 Gl.enable `texture_2d
;
53 GlFunc.blend_func ~src
:`src_alpha ~dst
:`one_minus_src_alpha
;
54 ignore
(drawstr size x y s
);
56 Gl.disable `texture_2d
;
59 let drawstring1 size x y s
=
63 let drawstring2 size x y fmt
=
64 Printf.kprintf
(drawstring size
(x
+1) (y
+size
+1)) fmt
68 dolog
"l %d dim=%d {" l
.pageno l
.pagedimno
;
69 dolog
" WxH %dx%d" l
.pagew l
.pageh
;
70 dolog
" vWxH %dx%d" l
.pagevw l
.pagevh
;
71 dolog
" pagex,y %d,%d" l
.pagex l
.pagey
;
72 dolog
" dispx,y %d,%d" l
.pagedispx l
.pagedispy
;
73 dolog
" column %d" l
.pagecol
;
77 let debugrect (x0
, y0
, x1
, y1
, x2
, y2
, x3
, y3
) =
79 dolog
" x0,y0=(% f, % f)" x0 y0
;
80 dolog
" x1,y1=(% f, % f)" x1 y1
;
81 dolog
" x2,y2=(% f, % f)" x2 y2
;
82 dolog
" x3,y3=(% f, % f)" x3 y3
;
86 let isbirdseye = function
93 let istextentry = function
100 let wtmode = ref false;;
101 let cxack = ref false;;
103 let pgscale h
= truncate
(float h
*. conf
.pgscale);;
106 if not state
.uioh#alwaysscrolly
&& (conf
.scrollb
land scrollbhv
= 0)
107 || (state
.x
= 0 && state
.w
<= state
.winw
- conf
.scrollbw
)
113 if not state
.uioh#alwaysscrolly
&& (conf
.scrollb
land scrollbvv
= 0)
118 let wadjsb () = -vscrollw ();;
119 let xadjsb () = if conf
.leftscroll
then vscrollw () else 0;;
122 fstate
.fontsize
<- n
;
123 fstate
.wwidth
<- measurestr fstate
.fontsize
"w";
124 fstate
.maxrows
<- (state
.winh
- fstate
.fontsize
- 1) / (fstate
.fontsize
+ 1);
130 Printf.kprintf prerr_endline fmt
132 Printf.kprintf ignore fmt
136 if emptystr conf
.pathlauncher
137 then print_endline state
.path
139 let command = Str.global_replace percentsre state
.path conf
.pathlauncher
in
140 try addpid
@@ popen
command []
142 Printf.eprintf
"failed to execute `%s': %s\n" command (exntos exn
);
147 let redirectstderr () =
148 let clofail what errmsg
= dolog
"failed to close %s: %s" what errmsg
in
149 if conf
.redirectstderr
151 match Unix.pipe
() with
153 dolog
"failed to create stderr redirection pipes: %s" (exntos exn
)
156 begin match Unix.dup
Unix.stderr
with
158 dolog
"failed to dup stderr: %s" (exntos exn
);
159 Ne.clo r
(clofail "pipe/r");
160 Ne.clo w
(clofail "pipe/w");
163 begin match Unix.dup2 w
Unix.stderr
with
165 dolog
"failed to dup2 to stderr: %s" (exntos exn
);
166 Ne.clo dupstderr
(clofail "stderr duplicate");
167 Ne.clo r
(clofail "redir pipe/r");
168 Ne.clo w
(clofail "redir pipe/w");
171 state
.stderr
<- dupstderr
;
172 state
.errfd
<- Some r
;
176 state
.newerrmsgs
<- false;
177 begin match state
.errfd
with
179 begin match Unix.dup2 state
.stderr
Unix.stderr
with
181 dolog
"failed to dup2 original stderr: %s" (exntos exn
)
183 Ne.clo fd
(clofail "dup of stderr");
188 prerr_string
(Buffer.contents state
.errmsgs
);
190 Buffer.clear state
.errmsgs
;
196 let postRedisplay who
=
198 then prerr_endline
("redisplay for " ^ who
);
199 state
.redisplay
<- true;
203 let getopaque pageno
=
204 try Some
(Hashtbl.find state
.pagemap
(pageno
, state
.gen
))
205 with Not_found
-> None
208 let putopaque pageno opaque
=
209 Hashtbl.replace state
.pagemap
(pageno
, state
.gen
) opaque
212 let pagetranslatepoint l x y
=
213 let dy = y
- l
.pagedispy
in
214 let y = dy + l
.pagey
in
215 let dx = x
- l
.pagedispx
in
216 let x = dx + l
.pagex
in
220 let onppundermouse g
x y d
=
223 begin match getopaque l
.pageno
with
225 let x0 = l
.pagedispx
in
226 let x1 = x0 + l
.pagevw
in
227 let y0 = l
.pagedispy
in
228 let y1 = y0 + l
.pagevh
in
229 if y >= y0 && y <= y1 && x >= x0 && x <= x1
231 let px, py
= pagetranslatepoint l
x y in
232 match g opaque l
px py
with
245 let g opaque l
px py
=
248 match rectofblock opaque
px py
with
250 let rect = (a
.(0),a
.(2),a
.(1),a
.(2),a
.(1),a
.(3),a
.(0),a
.(3)) in
251 state
.rects
<- [l
.pageno
, l
.pageno
mod 3, rect];
252 G.postRedisplay "getunder";
255 let under = whatsunder opaque
px py
in
256 if under = Unone
then None
else Some
under
258 onppundermouse g x y Unone
263 match unproject opaque
x y with
264 | Some
(x, y) -> Some
(Some
(opaque
, l
.pageno
, x, y))
267 onppundermouse g x y None
;
271 state
.text
<- Printf.sprintf
"%c%s" c s
;
272 G.postRedisplay "showtext";
275 let pipesel opaque cmd
=
278 match Unix.pipe
() with
281 (Printf.sprintf
"pipesel can not create pipe: %s" (exntos exn
));
283 let doclose what fd
=
284 Ne.clo fd
(fun msg
-> dolog
"%s close failed: %s" what msg
)
287 try popen cmd
[r
, 0; w
, -1]
289 dolog
"can not execute %S: %s" cmd
(exntos exn
);
295 G.postRedisplay "pipesel";
297 else doclose "pipesel pipe/w" w
;
298 doclose "pipesel pipe/r" r
;
302 let g opaque l
px py
=
303 if markunder opaque
px py conf
.paxmark
306 match getopaque l
.pageno
with
308 | Some opaque
-> pipesel opaque conf
.paxcmd
313 G.postRedisplay "paxunder";
314 if conf
.paxmark
= Mark_page
317 match getopaque l
.pageno
with
319 | Some opaque
-> clearmark opaque
) state
.layout
;
321 onppundermouse g x y (fun () -> showtext '
!'
"Whoopsie daisy");
325 match Unix.pipe
() with
327 showtext '
!'
(Printf.sprintf
"pipe failed: %s" (exntos exn
))
330 Ne.clo fd
(fun msg
->
331 showtext '
!'
(Printf.sprintf
"failed to close %s: %s" cap msg
)
335 try popen conf
.selcmd
[r
, 0; w
, -1]
338 (Printf.sprintf
"failed to execute %s: %s"
339 conf
.selcmd
(exntos exn
));
345 let l = String.length s
in
346 let bytes = Bytes.unsafe_of_string s
in
347 let n = tempfailureretry
(Unix.write w
bytes 0) l in
352 "failed to write %d characters to sel pipe, wrote %d"
357 (Printf.sprintf
"failed to write to sel pipe: %s"
362 clo "selstring pipe/r" r
;
363 clo "selstring pipe/w" w
;
366 let undertext = function
369 | Ulinkgoto
(pageno
, _
) -> Printf.sprintf
"%s: page %d" state
.path
(pageno
+1)
370 | Utext s
-> "font: " ^ s
371 | Uunexpected s
-> "unexpected: " ^ s
372 | Ulaunch s
-> "launch: " ^ s
373 | Unamed s
-> "named: " ^ s
374 | Uremote
(filename
, pageno
) ->
375 Printf.sprintf
"%s: page %d" filename
(pageno
+1)
376 | Uremotedest
(filename
, destname
) ->
377 Printf.sprintf
"%s: destination %S" filename destname
378 | Uannotation
(opaque
, slinkindex
) ->
379 "annotation: " ^ getannotcontents opaque slinkindex
382 let updateunder x y =
383 match getunder x y with
384 | Unone
-> Wsi.setcursor
Wsi.CURSOR_INHERIT
386 if conf
.underinfo
then showtext 'u'
("ri: " ^ uri
);
387 Wsi.setcursor
Wsi.CURSOR_INFO
388 | Ulinkgoto
(pageno
, _
) ->
390 then showtext 'p'
("age: " ^ string_of_int
(pageno
+1));
391 Wsi.setcursor
Wsi.CURSOR_INFO
393 if conf
.underinfo
then showtext '
f'
("ont: " ^ s
);
394 Wsi.setcursor
Wsi.CURSOR_TEXT
396 if conf
.underinfo
then showtext 'u'
("nexpected: " ^ s
);
397 Wsi.setcursor
Wsi.CURSOR_INHERIT
399 if conf
.underinfo
then showtext '
l'
("aunch: " ^ s
);
400 Wsi.setcursor
Wsi.CURSOR_INHERIT
402 if conf
.underinfo
then showtext '
n'
("amed: " ^ s
);
403 Wsi.setcursor
Wsi.CURSOR_INHERIT
404 | Uremote
(filename
, pageno
) ->
405 if conf
.underinfo
then showtext 'r'
406 (Printf.sprintf
"emote: %s (%d)" filename
(pageno
+1));
407 Wsi.setcursor
Wsi.CURSOR_INFO
408 | Uremotedest
(filename
, destname
) ->
409 if conf
.underinfo
then showtext 'r'
410 (Printf.sprintf
"emote destination: %s (%S)" filename destname
);
411 Wsi.setcursor
Wsi.CURSOR_INFO
413 if conf
.underinfo
then showtext 'a'
"nnotation";
414 Wsi.setcursor
Wsi.CURSOR_INFO
417 let showlinktype under =
418 if conf
.underinfo
&& under != Unone
419 then showtext ' '
@@ undertext under
422 let intentry_with_suffix text key
=
424 if key
>= 32 && key
< 127
428 match Char.lowercase
c with
430 let text = addchar
text c in
434 let text = addchar
text c in
438 state
.text <- Printf.sprintf
"invalid char (%d, `%c')" key
c;
443 let s = Bytes.create
4 in
444 let n = tempfailureretry
(Unix.read fd
s 0) 4 in
445 if n != 4 then error
"incomplete read(len) = %d" n;
446 let len = (Char.code
(Bytes.get
s 0) lsl 24)
447 lor (Char.code
(Bytes.get
s 1) lsl 16)
448 lor (Char.code
(Bytes.get
s 2) lsl 8)
449 lor (Char.code
(Bytes.get
s 3))
451 let s = Bytes.create
len in
452 let n = tempfailureretry
(Unix.read fd
s 0) len in
453 if n != len then error
"incomplete read(data) %d vs %d" n len;
458 let b = Buffer.create
16 in
459 Buffer.add_string
b "llll";
462 let s = Buffer.to_bytes
b in
463 let n = Bytes.length
s in
465 (* dolog "wcmd %S" (String.sub s 4 len); *)
466 Bytes.set
s 0 (Char.chr
((len lsr 24) land 0xff));
467 Bytes.set
s 1 (Char.chr
((len lsr 16) land 0xff));
468 Bytes.set
s 2 (Char.chr
((len lsr 8) land 0xff));
469 Bytes.set
s 3 (Char.chr
(len land 0xff));
470 let n'
= tempfailureretry
(Unix.write state
.ss
s 0) n in
471 if n'
!= n then error
"write failed %d vs %d" n'
n;
475 let nogeomcmds cmds
=
477 | s, [] -> emptystr
s
481 let layoutN ((columns
, coverA
, coverB
), b) y sh
=
482 let sh = sh - (hscrollh ()) in
483 let wadj = wadjsb () in
484 let rec fold accu
n =
485 if n = Array.length
b
488 let pdimno, dx, vy
, (_
, w
, h
, xoff
) = b.(n) in
491 || n = state
.pagecount
- coverB
492 || (n - coverA
) mod columns
= columns
- 1)
498 let pagey = max
0 (y - vy
) in
499 let pagedispy = if pagey > 0 then 0 else vy
- y in
500 let pagedispx, pagex
=
502 if n = coverA
- 1 || n = state
.pagecount
- coverB
503 then state
.x + (wadj + state
.winw
- w
) / 2
504 else dx + xoff
+ state
.x
511 let vw = wadj + state
.winw
- pagedispx in
512 let pw = w
- pagex
in
515 let pagevh = min
(h
- pagey) (sh - pagedispy) in
516 if pagevw > 0 && pagevh > 0
527 ; pagedispx = pagedispx
528 ; pagedispy = pagedispy
540 if Array.length
b = 0
542 else List.rev
(fold [] (page_of_y
y))
545 let layoutS (columns
, b) y sh =
546 let sh = sh - hscrollh () in
547 let wadj = wadjsb () in
548 let rec fold accu n =
549 if n = Array.length
b
552 let pdimno, px, vy
, (_
, pagew
, pageh
, xoff
) = b.(n) in
559 let x = xoff
+ state
.x in
560 let pagey = max
0 (y - vy
) in
561 let pagedispy = if pagey > 0 then 0 else vy
- y in
562 let pagedispx, pagex
=
576 let pagecolw = pagew
/columns
in
578 if pagecolw < state
.winw
579 then pagedispx + ((wadj + state
.winw
- pagecolw) / 2)
583 let vw = wadj + state
.winw
- pagedispx in
584 let pw = pagew
- pagex
in
587 let pagevw = min
pagevw pagecolw in
588 let pagevh = min
(pageh
- pagey) (sh - pagedispy) in
589 if pagevw > 0 && pagevh > 0
600 ; pagedispx = pagedispx
601 ; pagedispy = pagedispy
602 ; pagecol
= n mod columns
617 if nogeomcmds state
.geomcmds
619 match conf
.columns
with
620 | Csingle
b -> layoutN ((1, 0, 0), b) y sh
621 | Cmulti
c -> layoutN c y sh
622 | Csplit
s -> layoutS s y sh
627 let y = state
.y + incr
in
629 let y = min
y (state
.maxy
- (if conf
.maxhfit
then state
.winh
else 0)) in
634 let tilex = l.pagex
mod conf
.tilew
in
635 let tiley = l.pagey mod conf
.tileh
in
637 let col = l.pagex
/ conf
.tilew
in
638 let row = l.pagey / conf
.tileh
in
640 let xadj = xadjsb () in
641 let rec rowloop row y0 dispy h
=
645 let dh = conf
.tileh
- y0 in
647 let rec colloop col x0 dispx w
=
651 let dw = conf
.tilew
- x0 in
653 let dispx'
= xadj + dispx in
654 f col row dispx' dispy
x0 y0 dw dh;
655 colloop (col+1) 0 (dispx+dw) (w
-dw)
658 colloop col tilex l.pagedispx l.pagevw;
659 rowloop (row+1) 0 (dispy
+dh) (h
-dh)
662 if l.pagevw > 0 && l.pagevh > 0
663 then rowloop row tiley l.pagedispy l.pagevh;
666 let gettileopaque l col row =
668 l.pageno
, state
.gen
, conf
.colorspace
, conf
.angle
, l.pagew
, l.pageh
, col, row
670 try Some
(Hashtbl.find state
.tilemap
key)
671 with Not_found
-> None
674 let puttileopaque l col row gen colorspace angle opaque size elapsed
=
675 let key = l.pageno
, gen
, colorspace
, angle
, l.pagew
, l.pageh
, col, row in
676 Hashtbl.add state
.tilemap
key (opaque
, size
, elapsed
)
679 let filledrect x0 y0 x1 y1 =
680 GlArray.disable `texture_coord
;
681 Raw.sets_float state
.vraw ~pos
:0 [| x0; y0; x0; y1; x1; y0; x1; y1 |];
682 GlArray.vertex `two state
.vraw
;
683 GlArray.draw_arrays `triangle_strip ~first
:0 ~count
:4;
684 GlArray.enable `texture_coord
;
687 let linerect x0 y0 x1 y1 =
688 GlArray.disable `texture_coord
;
689 Raw.sets_float state
.vraw ~pos
:0 [| x0; y0; x0; y1; x1; y1; x1; y0 |];
690 GlArray.vertex `two state
.vraw
;
691 GlArray.draw_arrays `line_loop ~first
:0 ~count
:4;
692 GlArray.enable `texture_coord
;
695 let drawtiles l color
=
697 let wadj = wadjsb () in
699 let f col row x y tilex tiley w h
=
700 match gettileopaque l col row with
701 | Some
(opaque
, _
, t
) ->
702 let params = x, y, w
, h
, tilex, tiley in
704 then GlTex.env
(`mode `blend
);
705 drawtile
params opaque
;
707 then GlTex.env
(`mode `modulate
);
711 let s = Printf.sprintf
715 let w = measurestr fstate
.fontsize
s in
716 GlDraw.color
(0.0, 0.0, 0.0);
717 filledrect (float (x-2))
720 (float (y + fstate
.fontsize
+ 2));
721 GlDraw.color
(1.0, 1.0, 1.0);
722 drawstring fstate
.fontsize
x (y + fstate
.fontsize
- 1) s;
732 let lw = wadj + state
.winw
- x in
735 let lh = state
.winh
- y in
739 then GlTex.env
(`mode `blend
);
740 begin match state
.checkerstexid
with
742 Gl.enable `texture_2d
;
743 GlTex.bind_texture ~target
:`texture_2d id
;
747 and y1 = float (y+h
) in
749 let tw = float w /. 16.0
750 and th
= float h
/. 16.0 in
751 let tx0 = float tilex /. 16.0
752 and ty0
= float tiley /. 16.0 in
754 and ty1
= ty0
+. th
in
755 Raw.sets_float state
.vraw ~pos
:0
756 [| x0; y0; x0; y1; x1; y0; x1; y1 |];
757 Raw.sets_float state
.traw ~pos
:0
758 [| tx0; ty0
; tx0; ty1
; tx1; ty0
; tx1; ty1
|];
759 GlArray.vertex `two state
.vraw
;
760 GlArray.tex_coord `two state
.traw
;
761 GlArray.draw_arrays `triangle_strip ~first
:0 ~count
:4;
762 Gl.disable `texture_2d
;
765 GlDraw.color
(1.0, 1.0, 1.0);
766 filledrect (float x) (float y) (float (x+w)) (float (y+h
));
769 then GlTex.env
(`mode `modulate
);
770 if w > 128 && h
> fstate
.fontsize
+ 10
772 let c = if conf
.invert
then 1.0 else 0.0 in
773 GlDraw.color
(c, c, c);
776 then (col*conf
.tilew
, row*conf
.tileh
)
779 drawstring2 fstate
.fontsize
x y "Loading %d [%d,%d]" l.pageno
c r
;
788 let pagevisible layout n = List.exists
(fun l -> l.pageno
= n) layout;;
790 let tilevisible1 l x y =
792 and ax1
= l.pagex
+ l.pagevw
794 and ay1
= l.pagey + l.pagevh in
798 let bx1 = min
(bx0 + conf
.tilew
) l.pagew
799 and by1
= min
(by0
+ conf
.tileh
) l.pageh
in
801 let rx0 = max
ax0 bx0
802 and ry0
= max ay0 by0
803 and rx1
= min ax1
bx1
804 and ry1
= min ay1 by1
in
806 let nonemptyintersection = rx1
> rx0 && ry1
> ry0
in
810 let tilevisible layout n x y =
811 let rec findpageinlayout m
= function
812 | l :: rest
when l.pageno
= n ->
813 tilevisible1 l x y || (
814 match conf
.columns
with
815 | Csplit
(c, _
) when c > m
-> findpageinlayout (m
+1) rest
820 | _
:: rest
-> findpageinlayout 0 rest
823 findpageinlayout 0 layout;
826 let tileready l x y =
827 tilevisible1 l x y &&
828 gettileopaque l (x/conf
.tilew
) (y/conf
.tileh
) != None
831 let tilepage n p
layout =
832 let rec loop = function
836 let f col row _ _ _ _ _ _
=
837 if state
.currently
= Idle
839 match gettileopaque l col row with
842 let x = col*conf
.tilew
843 and y = row*conf
.tileh
in
845 let w = l.pagew
- x in
849 let h = l.pageh
- y in
854 then getpbo
w h conf
.colorspace
857 wcmd "tile %s %d %d %d %d %s"
858 (~
> p
) x y w h (~
> pbo);
861 l, p
, conf
.colorspace
, conf
.angle
,
862 state
.gen
, col, row, conf
.tilew
, conf
.tileh
871 if nogeomcmds state
.geomcmds
875 let preloadlayout y =
876 let y = if y < state
.winh
then 0 else y - state
.winh
in
877 let h = state
.winh
*3 in
883 if state
.currently
!= Idle
888 begin match getopaque l.pageno
with
890 wcmd "page %d %d" l.pageno
l.pagedimno
;
891 state
.currently
<- Loading
(l, state
.gen
);
893 tilepage l.pageno opaque pages
;
898 if nogeomcmds state
.geomcmds
904 if conf
.preload && state
.currently
= Idle
905 then load (preloadlayout state
.y);
908 let layoutready layout =
909 let rec fold all ls
=
912 let seen = ref false in
913 let allvisible = ref true in
914 let foo col row _ _ _ _ _ _
=
916 allvisible := !allvisible &&
917 begin match gettileopaque l col row with
923 fold (!seen && !allvisible) rest
926 let alltilesvisible = fold true layout in
931 let y = bound
y 0 state
.maxy
in
932 let y, layout, proceed
=
933 match conf
.maxwait
with
934 | Some time
when state
.ghyll
== noghyll
->
935 begin match state
.throttle
with
937 let layout = layout y state
.winh
in
938 let ready = layoutready layout in
942 state
.throttle
<- Some
(layout, y, now
());
944 else G.postRedisplay "gotoy showall (None)";
946 | Some
(_
, _
, started
) ->
947 let dt = now
() -. started
in
950 state
.throttle
<- None
;
951 let layout = layout y state
.winh
in
953 G.postRedisplay "maxwait";
960 let layout = layout y state
.winh
in
961 if not
!wtmode || layoutready layout
962 then G.postRedisplay "gotoy ready";
968 state
.layout <- layout;
969 begin match state
.mode
with
972 | Ltexact
(pageno
, linkno
) ->
973 let rec loop = function
975 state
.mode
<- LinkNav
(Ltgendir
0)
976 | l :: _
when l.pageno
= pageno
->
977 begin match getopaque pageno
with
978 | None
-> state
.mode
<- LinkNav
(Ltnotready
(pageno
, 0))
980 let x0, y0, x1, y1 = getlinkrect opaque linkno
in
981 if not
(x0 >= l.pagex
&& x1 <= l.pagex
+ l.pagevw
982 && y0 >= l.pagey && y1 <= l.pagey + l.pagevh)
983 then state
.mode
<- LinkNav
(Ltgendir
0)
985 | _
:: rest
-> loop rest
988 | Ltnotready _
| Ltgendir _
-> ()
994 begin match state
.mode
with
995 | Birdseye
(conf
, leftx
, pageno
, hooverpageno
, anchor
) ->
996 if not
(pagevisible layout pageno
)
998 match state
.layout with
1001 state
.mode
<- Birdseye
(
1002 conf
, leftx
, l.pageno
, hooverpageno
, anchor
1007 | Ltnotready
(_
, dir
)
1010 let rec loop = function
1013 match getopaque l.pageno
with
1014 | None
-> Ltnotready
(l.pageno
, dir
)
1019 then LDfirstvisible
(l.pagex
, l.pagey, dir
)
1021 if dir
> 0 then LDfirst
else LDlast
1027 | Lnotfound
-> loop rest
1029 showlinktype (getlink opaque
n);
1030 Ltexact
(l.pageno
, n)
1034 state
.mode
<- LinkNav
linknav
1042 state
.ghyll
<- noghyll
;
1045 let mx, my
= state
.mpos
in
1050 let conttiling pageno opaque
=
1051 tilepage pageno opaque
1052 (if conf
.preload then preloadlayout state
.y else state
.layout)
1055 let gotoy_and_clear_text y =
1056 if not conf
.verbose
then state
.text <- E.s;
1060 let getanchory (n, top
, dtop
) =
1061 let y, h = getpageyh
n in
1062 if conf
.presentation
1064 let ips = calcips
h in
1065 y + truncate
(top
*.float h -. dtop
*.float ips) + ips;
1067 y + truncate
(top
*.float h -. dtop
*.float conf
.interpagespace
)
1070 let gotoanchor anchor
=
1071 gotoy (getanchory anchor
);
1075 cbput state
.hists
.nav
(getanchor
());
1079 let anchor = cbgetc state
.hists
.nav dir
in
1083 let gotoghyll1 single
y =
1084 let scroll f n a
b =
1085 (* http://devmaster.net/forums/topic/9796-ease-in-ease-out-algorithm/ *)
1087 let s x = 3.0*.x**2.0 -. 2.0*.x**3.0 in
1089 then s (float f /. float a
)
1092 then 1.0 -. s ((float (f-b) /. float (n-b)))
1098 let ins = float a
*. 0.5
1099 and outs
= float (n-b) *. 0.5 in
1101 ins +. outs
+. float ones
1103 let rec set nab
y sy
=
1104 let (_N
, _A
, _B
), y =
1107 let scl = if y > sy
then 2 else -2 in
1108 let _N, _
, _
= nab
in
1109 (_N,0,_N), y+conf
.scrollstep
*scl
1111 let sum = summa
_N _A _B
in
1112 let dy = float (y - sy
) in
1116 then state
.ghyll
<- noghyll
1119 let s = scroll n _N _A _B
in
1120 let y1 = y1 +. ((s *. dy) /. sum) in
1121 gotoy_and_clear_text (truncate
y1);
1122 state
.ghyll
<- gf (n+1) y1;
1126 | Some
y'
when single
-> set nab
y' state
.y
1127 | Some
y'
-> set (_N/2, 1, 1) y' state
.y
1129 gf 0 (float state
.y)
1132 match conf
.ghyllscroll
with
1133 | Some nab
when not conf
.presentation
->
1134 if state
.ghyll
== noghyll
1135 then set nab
y state
.y
1136 else state
.ghyll
(Some
y)
1138 gotoy_and_clear_text y
1141 let gotoghyll = gotoghyll1 false;;
1143 let gotopage n top
=
1144 let y, h = getpageyh
n in
1145 let y = y + (truncate
(top
*. float h)) in
1149 let gotopage1 n top
=
1150 let y = getpagey
n in
1155 let invalidate s f =
1160 match state
.geomcmds
with
1161 | ps
, [] when emptystr ps
->
1163 state
.geomcmds
<- s, [];
1166 state
.geomcmds
<- ps
, [s, f];
1168 | ps
, (s'
, _
) :: rest
when s'
= s ->
1169 state
.geomcmds
<- ps
, ((s, f) :: rest
);
1172 state
.geomcmds
<- ps
, ((s, f) :: cmds
);
1176 Hashtbl.iter
(fun _ opaque
->
1177 wcmd "freepage %s" (~
> opaque
);
1179 Hashtbl.clear state
.pagemap
;
1183 if not
(Queue.is_empty state
.tilelru
)
1185 Queue.iter
(fun (k
, p
, s) ->
1186 wcmd "freetile %s" (~
> p
);
1187 state
.memused
<- state
.memused
- s;
1188 Hashtbl.remove state
.tilemap k
;
1190 state
.uioh#infochanged Memused
;
1191 Queue.clear state
.tilelru
;
1197 let h = truncate
(float h*.conf
.zoom
) in
1198 let d = conf
.interpagespace
lsl (if conf
.presentation
then 1 else 0) in
1202 let opendoc path password
=
1204 state
.password
<- password
;
1205 state
.gen
<- state
.gen
+ 1;
1206 state
.docinfo
<- [];
1207 state
.outlines
<- [||];
1210 setaalevel conf
.aalevel
;
1212 if emptystr state
.origin
1216 Wsi.settitle
("llpp " ^
(mbtoutf8
(Filename.basename
titlepath)));
1217 wcmd "open %d %d %s\000%s\000" (btod
!wtmode) (btod
!cxack) path password
;
1218 invalidate "reqlayout"
1220 wcmd "reqlayout %d %d %d %s\000"
1221 conf
.angle
(FMTE.to_int conf
.fitmodel
)
1222 (stateh state
.winh
) state
.nameddest
1227 state
.anchor <- getanchor
();
1228 opendoc state
.path state
.password
;
1232 let c = c *. conf
.colorscale
in
1236 let scalecolor2 (r
, g, b) =
1237 (r
*. conf
.colorscale
, g *. conf
.colorscale
, b *. conf
.colorscale
);
1240 let docolumns columns
=
1241 let wadj = wadjsb () in
1244 let a = Array.make state
.pagecount
(-1, -1, -1, (-1, -1, -1, -1)) in
1245 let wadj = wadjsb () in
1246 let rec loop pageno
pdimno pdim
y ph pdims
=
1247 if pageno
= state
.pagecount
1250 let pdimno, ((_
, w, h, xoff
) as pdim
), pdims
=
1252 | ((pageno'
, _
, _
, _
) as pdim
) :: rest
when pageno'
= pageno
->
1253 pdimno+1, pdim
, rest
1257 let x = max
0 (((wadj + state
.winw
- w) / 2) - xoff
) in
1259 (if conf
.presentation
1260 then (if pageno
= 0 then calcips
h else calcips ph
+ calcips
h)
1261 else (if pageno
= 0 then 0 else conf
.interpagespace
)
1264 a.(pageno
) <- (pdimno, x, y, pdim
);
1265 loop (pageno
+1) pdimno pdim
(y + h) h pdims
1267 loop 0 ~
-1 (-1,-1,-1,-1) 0 0 state
.pdims
;
1268 conf
.columns
<- Csingle
a;
1270 | Cmulti
((columns
, coverA
, coverB
), _
) ->
1271 let a = Array.make state
.pagecount
(-1, -1, -1, (-1, -1, -1, -1)) in
1272 let rec loop pageno
pdimno pdim
x y rowh pdims
=
1273 let rec fixrow m
= if m
= pageno
then () else
1274 let (pdimno, x, y, ((_
, _
, h, _
) as pdim
)) = a.(m
) in
1277 let y = y + (rowh
- h) / 2 in
1278 a.(m
) <- (pdimno, x, y, pdim
);
1282 if pageno
= state
.pagecount
1283 then fixrow (((pageno
- 1) / columns
) * columns
)
1285 let pdimno, ((_
, w, h, xoff
) as pdim
), pdims
=
1287 | ((pageno'
, _
, _
, _
) as pdim
) :: rest
when pageno'
= pageno
->
1288 pdimno+1, pdim
, rest
1293 if pageno
= coverA
- 1 || pageno
= state
.pagecount
- coverB
1295 let x = (wadj + state
.winw
- w) / 2 in
1297 if conf
.presentation
then calcips
h else conf
.interpagespace
in
1298 x, y + ips + rowh
, h
1301 if (pageno
- coverA
) mod columns
= 0
1303 let x = max
0 (wadj + state
.winw
- state
.w) / 2 in
1305 if conf
.presentation
1307 let ips = calcips
h in
1308 y + (if pageno
= 0 then 0 else calcips rowh
+ ips)
1310 y + (if pageno
= 0 then 0 else conf
.interpagespace
)
1314 else x, y, max rowh
h
1318 if pageno
> 1 && (pageno
- coverA
) mod columns
= 0
1321 if pageno
= columns
&& conf
.presentation
1323 let ips = calcips rowh
in
1324 for i
= 0 to pred columns
1326 let (pdimno, x, y, pdim
) = a.(i
) in
1327 a.(i
) <- (pdimno, x, y+ips, pdim
)
1333 fixrow (pageno
- columns
);
1338 a.(pageno
) <- (pdimno, x, y, pdim
);
1339 let x = x + w + xoff
*2 + conf
.interpagespace
in
1340 loop (pageno
+1) pdimno pdim
x y rowh' pdims
1342 loop 0 ~
-1 (-1,-1,-1,-1) 0 0 0 state
.pdims
;
1343 conf
.columns
<- Cmulti
((columns
, coverA
, coverB
), a);
1346 let a = Array.make
(state
.pagecount
*c) (-1, -1, -1, (-1, -1, -1, -1)) in
1347 let rec loop pageno
pdimno pdim
y pdims
=
1348 if pageno
= state
.pagecount
1351 let pdimno, ((_
, w, h, _
) as pdim
), pdims
=
1353 | ((pageno'
, _
, _
, _
) as pdim
) :: rest
when pageno'
= pageno
->
1354 pdimno+1, pdim
, rest
1359 let rec loop1 n x y =
1360 if n = c then y else (
1361 a.(pageno
*c + n) <- (pdimno, x, y, pdim
);
1362 loop1 (n+1) (x+cw) (y + h + conf
.interpagespace
)
1365 let y = loop1 0 0 y in
1366 loop (pageno
+1) pdimno pdim
y pdims
1368 loop 0 ~
-1 (-1,-1,-1,-1) 0 state
.pdims
;
1369 conf
.columns
<- Csplit
(c, a);
1373 docolumns conf
.columns
;
1374 state
.maxy
<- calcheight
();
1375 if state
.reprf
== noreprf
1377 match state
.mode
with
1378 | Birdseye
(_
, _
, pageno
, _
, _
) ->
1379 let y, h = getpageyh pageno
in
1380 let top = (state
.winh
- h) / 2 in
1381 gotoy (max
0 (y - top))
1384 | LinkNav _
-> gotoanchor state
.anchor
1388 state
.reprf
<- noreprf
;
1393 GlDraw.viewport ~
x:0 ~
y:0 ~
w:w ~
h:h;
1394 let firsttime = state
.geomcmds
== firstgeomcmds
in
1395 if not
firsttime && nogeomcmds state
.geomcmds
1396 then state
.anchor <- getanchor
();
1399 let w = wadjsb () + (truncate
(float w *. conf
.zoom
)) in
1402 setfontsize fstate
.fontsize
;
1403 GlMat.mode `modelview
;
1404 GlMat.load_identity
();
1406 GlMat.mode `projection
;
1407 GlMat.load_identity
();
1408 GlMat.rotate ~
x:1.0 ~angle
:180.0 ();
1409 GlMat.translate ~
x:~
-.1.0 ~
y:~
-.1.0 ();
1410 GlMat.scale3
(2.0 /. float state
.winw
, 2.0 /. float state
.winh
, 1.0);
1415 else float state
.x /. float state
.w
1417 invalidate "geometry"
1421 then state
.x <- truncate
(relx *. float w);
1423 match conf
.columns
with
1425 | Cmulti
((c, _
, _
), _
) -> (w - (c-1)*conf
.interpagespace
) / c
1426 | Csplit
(c, _
) -> w * c
1428 wcmd "geometry %d %d %d"
1429 w (stateh h) (FMTE.to_int conf
.fitmodel
)
1434 let len = String.length state
.text in
1435 let x0 = xadjsb () in
1438 match state
.mode
with
1439 | Textentry _
| View
| LinkNav _
->
1440 let h, _
, _
= state
.uioh#scrollpw
in
1445 filledrect x (float (state
.winh
- (fstate
.fontsize
+ 4) - hscrollh))
1446 (x+.w) (float (state
.winh
- hscrollh))
1449 let w = float (wadjsb () + state
.winw
- 1) in
1450 if state
.progress
>= 0.0 && state
.progress
< 1.0
1452 GlDraw.color
(0.3, 0.3, 0.3);
1453 let w1 = w *. state
.progress
in
1455 GlDraw.color
(0.0, 0.0, 0.0);
1456 rect (float x0+.w1) (float x0+.w-.w1)
1459 GlDraw.color
(0.0, 0.0, 0.0);
1463 GlDraw.color
(1.0, 1.0, 1.0);
1464 drawstring fstate
.fontsize
1465 (if conf
.leftscroll
then x0 + 2 else x0 + if len > 0 then 8 else 2)
1466 (state
.winh
- hscrollh - 5) s;
1469 match state
.mode
with
1470 | Textentry
((prefix
, text, _
, _
, _
, _
), _
) ->
1474 Printf.sprintf
"%s%s_ [%s]" prefix
text state
.text
1476 Printf.sprintf
"%s%s_" prefix
text
1482 | LinkNav _
-> state
.text
1487 if not
(istextentry state
.mode
) && state
.uioh#eformsgs
1489 let s1 = "(press 'e' to review error messasges)" in
1490 if nonemptystr
s then s ^
" " ^
s1 else s1
1500 let len = Queue.length state
.tilelru
in
1502 match state
.throttle
with
1505 then preloadlayout state
.y
1507 | Some
(layout, _
, _
) ->
1511 if state
.memused
<= conf
.memlimit
1516 let (k
, p
, s) as lruitem
= Queue.pop state
.tilelru
in
1517 let n, gen
, colorspace
, angle
, pagew
, pageh
, col, row = k
in
1518 let (_
, pw, ph
, _
) = getpagedim
n in
1521 && colorspace
= conf
.colorspace
1522 && angle
= conf
.angle
1526 let x = col*conf
.tilew
1527 and y = row*conf
.tileh
in
1528 tilevisible (Lazy.force_val
layout) n x y
1530 then Queue.push lruitem state
.tilelru
1533 wcmd "freetile %s" (~
> p
);
1534 state
.memused
<- state
.memused
- s;
1535 state
.uioh#infochanged Memused
;
1536 Hashtbl.remove state
.tilemap k
;
1544 let onpagerect pageno
f =
1546 match conf
.columns
with
1547 | Cmulti
(_
, b) -> b
1549 | Csplit
(_
, b) -> b
1551 if pageno
>= 0 && pageno
< Array.length
b
1553 let (_
, _
, _
, (w, h, _
, _
)) = b.(pageno
) in
1557 let gotopagexy1 pageno
x y =
1558 let _,w1,h1
,leftx
= getpagedim pageno
in
1559 let top = y /. (float h1
) in
1560 let left = x /. (float w1) in
1561 let py, w, h = getpageywh pageno
in
1562 let wh = state
.winh
- hscrollh () in
1563 let x = left *. (float w) in
1564 let x = leftx
+ state
.x + truncate
x in
1565 let wadj = wadjsb () in
1567 if x < 0 || x >= wadj + state
.winw
1571 let pdy = truncate
(top *. float h) in
1572 let y'
= py + pdy in
1573 let dy = y'
- state
.y in
1575 if x != state
.x || not
(dy > 0 && dy < wh)
1577 if conf
.presentation
1579 if abs
(py - y'
) > wh
1586 if state
.x != sx || state
.y != sy
1591 let ww = wadj + state
.winw
in
1593 and qy
= pdy / wh in
1595 and y = py + qy
* wh in
1596 let x = if -x + ww > w1 then -(w1-ww) else x
1597 and y'
= if y + wh > state
.maxy
then state
.maxy
- wh else y in
1599 if conf
.presentation
1601 if abs
(py - y'
) > wh
1611 gotoy_and_clear_text y;
1613 else gotoy_and_clear_text state
.y;
1616 let gotopagexy pageno
x y =
1617 match state
.mode
with
1618 | Birdseye
_ -> gotopage pageno
0.0
1621 | LinkNav
_ -> gotopagexy1 pageno
x y
1624 let getpassword () =
1625 let passcmd = getenvwithdef
"LLPP_ASKPASS" conf
.passcmd in
1630 showtext '
!'
@@ "error getting password: " ^
s;
1631 dolog
"%s" s) passcmd;
1635 (* dolog "%S" cmds; *)
1636 let cl = splitatspace cmds
in
1638 try Scanf.sscanf
s fmt
f
1640 dolog
"error processing '%S': %s" cmds
(exntos exn
);
1643 let addoutline outline
=
1644 match state
.currently
with
1645 | Outlining outlines
->
1646 state
.currently
<- Outlining
(outline
:: outlines
)
1647 | Idle
-> state
.currently
<- Outlining
[outline
]
1650 dolog
"invalid outlining state";
1651 logcurrently state
.currently
1655 state
.uioh#infochanged Pdim
;
1658 | "clearrects" :: [] ->
1659 state
.rects
<- state
.rects1
;
1660 G.postRedisplay "clearrects";
1662 | "continue" :: args
:: [] ->
1663 let n = scan args
"%u" (fun n -> n) in
1664 state
.pagecount
<- n;
1665 begin match state
.currently
with
1667 state
.currently
<- Idle
;
1668 state
.outlines
<- Array.of_list
(List.rev
l)
1674 let cur, cmds
= state
.geomcmds
in
1676 then failwith
"umpossible";
1678 begin match List.rev cmds
with
1680 state
.geomcmds
<- E.s, [];
1681 state
.throttle
<- None
;
1685 state
.geomcmds
<- s, List.rev rest
;
1687 if conf
.maxwait
= None
&& not
!wtmode
1688 then G.postRedisplay "continue";
1690 | "msg" :: args
:: [] ->
1693 | "vmsg" :: args
:: [] ->
1695 then showtext ' ' args
1697 | "emsg" :: args
:: [] ->
1698 Buffer.add_string state
.errmsgs args
;
1699 state
.newerrmsgs
<- true;
1700 G.postRedisplay "error message"
1702 | "progress" :: args
:: [] ->
1703 let progress, text =
1706 f, String.sub args pos
(String.length args
- pos
))
1709 state
.progress <- progress;
1710 G.postRedisplay "progress"
1712 | "firstmatch" :: args
:: [] ->
1713 let pageno, c, x0, y0, x1, y1, x2
, y2
, x3
, y3
=
1714 scan args
"%u %d %f %f %f %f %f %f %f %f"
1715 (fun p
c x0 y0 x1 y1 x2 y2 x3 y3
->
1716 (p
, c, x0, y0, x1, y1, x2
, y2
, x3
, y3
))
1718 let xoff = float (xadjsb ()) in
1722 and x3
= x3
+. xoff in
1723 let y = (getpagey
pageno) + truncate
y0 in
1726 state
.rects1
<- [pageno, c, (x0, y0, x1, y1, x2
, y2
, x3
, y3
)]
1728 | "match" :: args
:: [] ->
1729 let pageno, c, x0, y0, x1, y1, x2
, y2
, x3
, y3
=
1730 scan args
"%u %d %f %f %f %f %f %f %f %f"
1731 (fun p
c x0 y0 x1 y1 x2 y2 x3 y3
->
1732 (p
, c, x0, y0, x1, y1, x2
, y2
, x3
, y3
))
1734 let xoff = float (xadjsb ()) in
1738 and x3
= x3
+. xoff in
1740 (pageno, c, (x0, y0, x1, y1, x2
, y2
, x3
, y3
)) :: state
.rects1
1742 | "page" :: args
:: [] ->
1743 let pageopaques, t
= scan args
"%s %f" (fun p t
-> p
, t
) in
1744 let pageopaque = ~
< pageopaques in
1745 begin match state
.currently
with
1746 | Loading
(l, gen
) ->
1747 vlog "page %d took %f sec" l.pageno t
;
1748 Hashtbl.replace state
.pagemap
(l.pageno, gen
) pageopaque;
1749 begin match state
.throttle
with
1751 let preloadedpages =
1753 then preloadlayout state
.y
1758 List.fold_left
(fun s l -> IntSet.add
l.pageno s)
1759 IntSet.empty
preloadedpages
1762 Hashtbl.fold (fun ((pageno, _) as key) opaque
accu ->
1763 if not
(IntSet.mem
pageno set)
1765 wcmd "freepage %s" (~
> opaque
);
1771 List.iter
(Hashtbl.remove state
.pagemap
) evictedpages;
1774 state
.currently
<- Idle
;
1777 tilepage l.pageno pageopaque state
.layout;
1779 load preloadedpages;
1780 let visible = pagevisible state
.layout l.pageno in
1783 match state
.mode
with
1784 | LinkNav
(Ltnotready
(pageno, dir
)) ->
1785 if pageno = l.pageno
1790 then LDfirstvisible
(l.pagex
, l.pagey, dir
)
1792 if dir
> 0 then LDfirst
else LDlast
1795 findlink
pageopaque ld
1800 showlinktype (getlink
pageopaque n);
1801 state
.mode
<- LinkNav
(Ltexact
(l.pageno, n))
1803 | LinkNav
(Ltgendir
_)
1804 | LinkNav
(Ltexact
_)
1810 if visible && layoutready state
.layout
1812 G.postRedisplay "page";
1816 | Some
(layout, _, _) ->
1817 state
.currently
<- Idle
;
1818 tilepage l.pageno pageopaque layout;
1825 dolog
"Inconsistent loading state";
1826 logcurrently state
.currently
;
1830 | "tile" :: args
:: [] ->
1831 let (x, y, opaques
, size
, t
) =
1832 scan args
"%u %u %s %u %f"
1833 (fun x y p size t
-> (x, y, p
, size
, t
))
1835 let opaque = ~
< opaques
in
1836 begin match state
.currently
with
1837 | Tiling
(l, pageopaque, cs
, angle
, gen
, col, row, tilew
, tileh
) ->
1838 vlog "tile %d [%d,%d] took %f sec" l.pageno col row t
;
1841 if tilew
!= conf
.tilew
|| tileh
!= conf
.tileh
1843 wcmd "freetile %s" (~
> opaque);
1844 state
.currently
<- Idle
;
1848 puttileopaque l col row gen cs angle
opaque size t
;
1849 state
.memused
<- state
.memused
+ size
;
1850 state
.uioh#infochanged Memused
;
1852 Queue.push
((l.pageno, gen
, cs
, angle
, l.pagew
, l.pageh
, col, row),
1853 opaque, size
) state
.tilelru
;
1856 match state
.throttle
with
1857 | None
-> state
.layout
1858 | Some
(layout, _, _) -> layout
1861 state
.currently
<- Idle
;
1863 && conf
.colorspace
= cs
1864 && conf
.angle
= angle
1865 && tilevisible layout l.pageno x y
1866 then conttiling l.pageno pageopaque;
1868 begin match state
.throttle
with
1870 preload state
.layout;
1872 && conf
.colorspace
= cs
1873 && conf
.angle
= angle
1874 && tilevisible state
.layout l.pageno x y
1875 && (not
!wtmode || layoutready state
.layout)
1876 then G.postRedisplay "tile nothrottle";
1878 | Some
(layout, y, _) ->
1879 let ready = layoutready layout in
1883 state
.layout <- layout;
1884 state
.throttle
<- None
;
1885 G.postRedisplay "throttle";
1894 dolog
"Inconsistent tiling state";
1895 logcurrently state
.currently
;
1899 | "pdim" :: args
:: [] ->
1900 let (n, w, h, _) as pdim
=
1901 scan args
"%u %u %u %u" (fun n w h x -> n, w, h, x)
1904 match conf
.fitmodel
with
1906 | FitPage
| FitProportional
->
1907 match conf
.columns
with
1908 | Csplit
_ -> (n, w, h, 0)
1909 | Csingle
_ | Cmulti
_ -> pdim
1911 state
.uioh#infochanged Pdim
;
1912 state
.pdims
<- pdim :: state
.pdims
1914 | "o" :: args
:: [] ->
1915 let (l, n, t
, h, pos
) =
1916 scan args
"%u %u %d %u %n"
1917 (fun l n t
h pos
-> l, n, t
, h, pos
)
1919 let s = String.sub args pos
(String.length args
- pos
) in
1920 addoutline (s, l, Oanchor
(n, float t
/. float h, 0.0))
1922 | "ou" :: args
:: [] ->
1923 let (l, len, pos
) = scan args
"%u %u %n" (fun l len pos
-> l, len, pos
) in
1924 let s = String.sub args pos
len in
1925 let pos2 = pos
+ len + 1 in
1926 let uri = String.sub args
pos2 (String.length args
- pos2) in
1927 addoutline (s, l, Ouri
uri)
1929 | "on" :: args
:: [] ->
1930 let (l, pos
) = scan args
"%u %n" (fun l pos
-> l, pos
) in
1931 let s = String.sub args pos
(String.length args
- pos
) in
1932 addoutline (s, l, Onone
)
1934 | "a" :: args
:: [] ->
1936 scan args
"%u %d %d" (fun n l t
-> n, l, t
)
1938 state
.reprf
<- (fun () -> gotopagexy n (float l) (float t
))
1940 | "info" :: args
:: [] ->
1941 let pos = nindex args '
\t'
in
1942 if pos >= 0 && String.sub args
0 pos = "Title"
1944 let s = String.sub args
(pos+1) @@ String.length args
- pos - 1 in
1947 state
.docinfo
<- (1, args
) :: state
.docinfo
1949 | "infoend" :: [] ->
1950 state
.uioh#infochanged Docinfo
;
1951 state
.docinfo
<- List.rev state
.docinfo
1955 then Wsi.settitle
"Wrong password";
1956 let password = getpassword () in
1958 then error
"document is password protected"
1959 else opendoc state
.path
password
1962 error
"unknown cmd `%S'" cmds
1967 let action = function
1968 | HCprev
-> cbget cb ~
-1
1969 | HCnext
-> cbget cb
1
1970 | HCfirst
-> cbget cb ~
-(cb
.rc)
1971 | HClast
-> cbget cb
(cb
.len - 1 - cb
.rc)
1972 and cancel
() = cb
.rc <- rc
1976 let search pattern forward
=
1977 match conf
.columns
with
1979 showtext '
!'
"searching does not work properly in split columns mode"
1982 if nonemptystr pattern
1985 match state
.layout with
1988 l.pageno, (l.pagey + if forward
then 0 else 0*l.pagevh)
1990 wcmd "search %d %d %d %d,%s\000"
1991 (btod conf
.icase
) pn py (btod forward
) pattern
;
1994 let intentry text key =
1996 if key >= 32 && key < 127
2002 let text = addchar
text c in
2006 state
.text <- Printf.sprintf
"invalid char (%d, `%c')" key c;
2010 let linknentry text key =
2012 if key >= 32 && key < 127
2018 let text = addchar
text c in
2022 state
.text <- Printf.sprintf
"invalid char (%d, `%c')" key c;
2030 let l = String.length
s in
2031 let rec loop pos n = if pos = l then n else
2032 let m = Char.code
s.[pos] - (if pos = 0 && l > 1 then 96 else 97) in
2033 loop (pos+1) (n*26 + m)
2036 let rec loop n = function
2039 match getopaque l.pageno with
2040 | None
-> loop n rest
2042 let m = getlinkcount
opaque in
2045 let under = getlink
opaque n in
2048 else loop (n-m) rest
2050 loop n state
.layout;
2054 let textentry text key =
2055 if key land 0xff00 = 0xff00
2057 else TEcont
(text ^ toutf8
key)
2060 let reqlayout angle fitmodel
=
2061 match state
.throttle
with
2063 if nogeomcmds state
.geomcmds
2064 then state
.anchor <- getanchor
();
2065 conf
.angle
<- angle
mod 360;
2068 match state
.mode
with
2069 | LinkNav
_ -> state
.mode
<- View
2074 conf
.fitmodel
<- fitmodel
;
2075 invalidate "reqlayout"
2077 wcmd "reqlayout %d %d %d"
2078 conf
.angle
(FMTE.to_int conf
.fitmodel
) (stateh state
.winh
)
2083 let settrim trimmargins trimfuzz
=
2084 if nogeomcmds state
.geomcmds
2085 then state
.anchor <- getanchor
();
2086 conf
.trimmargins
<- trimmargins
;
2087 conf
.trimfuzz
<- trimfuzz
;
2088 let x0, y0, x1, y1 = trimfuzz
in
2089 invalidate "settrim"
2091 wcmd "settrim %d %d %d %d %d" (btod conf
.trimmargins
) x0 y0 x1 y1);
2096 match state
.throttle
with
2098 let zoom = max
0.0001 zoom in
2099 if zoom <> conf
.zoom
2101 state
.prevzoom
<- (conf
.zoom, state
.x);
2103 reshape state
.winw state
.winh
;
2104 state
.text <- Printf.sprintf
"zoom is now %-5.2f" (zoom *. 100.0);
2107 | Some
(layout, y, started
) ->
2109 match conf
.maxwait
with
2113 let dt = now
() -. started
in
2121 let setcolumns mode columns coverA coverB
=
2122 state
.prevcolumns
<- Some
(conf
.columns
, conf
.zoom);
2126 then showtext '
!'
"split mode doesn't work in bird's eye"
2128 conf
.columns
<- Csplit
(-columns
, E.a);
2136 conf
.columns
<- Csingle
E.a;
2141 conf
.columns
<- Cmulti
((columns
, coverA
, coverB
), E.a);
2145 reshape state
.winw state
.winh
;
2148 let resetmstate () =
2149 state
.mstate
<- Mnone
;
2150 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
2153 let enterbirdseye () =
2154 let zoom = float conf
.thumbw
/. float state
.winw
in
2155 let birdseyepageno =
2156 let cy = state
.winh
/ 2 in
2160 let rec fold best
= function
2163 let d = cy - (l.pagedispy + l.pagevh/2)
2164 and dbest
= cy - (best
.pagedispy + best
.pagevh/2) in
2165 if abs
d < abs dbest
2172 state
.mode
<- Birdseye
(
2173 { conf
with zoom = conf
.zoom }, state
.x, birdseyepageno, -1, getanchor
()
2177 conf
.presentation
<- false;
2178 conf
.interpagespace
<- 10;
2179 conf
.hlinks
<- false;
2180 conf
.fitmodel
<- FitPage
;
2182 conf
.maxwait
<- None
;
2184 match conf
.beyecolumns
with
2187 Cmulti
((c, 0, 0), E.a)
2188 | None
-> Csingle
E.a
2192 state
.text <- Printf.sprintf
"birds eye mode on (zoom %3.1f%%)"
2197 reshape state
.winw state
.winh
;
2200 let leavebirdseye (c, leftx
, pageno, _, anchor) goback
=
2202 conf
.zoom <- c.zoom;
2203 conf
.presentation
<- c.presentation
;
2204 conf
.interpagespace
<- c.interpagespace
;
2205 conf
.maxwait
<- c.maxwait
;
2206 conf
.hlinks
<- c.hlinks
;
2207 conf
.fitmodel
<- c.fitmodel
;
2208 conf
.beyecolumns
<- (
2209 match conf
.columns
with
2210 | Cmulti
((c, _, _), _) -> Some
c
2212 | Csplit
_ -> failwith
"leaving bird's eye split mode"
2215 match c.columns
with
2216 | Cmulti
(c, _) -> Cmulti
(c, E.a)
2217 | Csingle
_ -> Csingle
E.a
2218 | Csplit
(c, _) -> Csplit
(c, E.a)
2222 state
.text <- Printf.sprintf
"birds eye mode off (zoom %3.1f%%)"
2225 reshape state
.winw state
.winh
;
2226 state
.anchor <- if goback
then anchor else (pageno, 0.0, 1.0);
2230 let togglebirdseye () =
2231 match state
.mode
with
2232 | Birdseye vals
-> leavebirdseye vals
true
2233 | View
-> enterbirdseye ()
2238 let upbirdseye incr
(conf
, leftx
, pageno, hooverpageno
, anchor) =
2239 let pageno = max
0 (pageno - incr
) in
2240 let rec loop = function
2241 | [] -> gotopage1 pageno 0
2242 | l :: _ when l.pageno = pageno ->
2243 if l.pagedispy >= 0 && l.pagey = 0
2244 then G.postRedisplay "upbirdseye"
2245 else gotopage1 pageno 0
2246 | _ :: rest
-> loop rest
2250 state
.mode
<- Birdseye
(conf
, leftx
, pageno, hooverpageno
, anchor)
2253 let downbirdseye incr
(conf
, leftx
, pageno, hooverpageno
, anchor) =
2254 let pageno = min
(state
.pagecount
- 1) (pageno + incr
) in
2255 state
.mode
<- Birdseye
(conf
, leftx
, pageno, hooverpageno
, anchor);
2256 let rec loop = function
2258 let y, h = getpageyh
pageno in
2259 let dy = (y - state
.y) - (state
.winh
- h - conf
.interpagespace
) in
2261 | l :: _ when l.pageno = pageno ->
2262 if l.pagevh != l.pageh
2263 then gotoy (clamp (l.pageh
- l.pagevh + conf
.interpagespace
))
2264 else G.postRedisplay "downbirdseye"
2265 | _ :: rest
-> loop rest
2271 let optentry mode
_ key =
2272 let btos b = if b then "on" else "off" in
2273 if key >= 32 && key < 127
2275 let c = Char.chr
key in
2279 try conf
.scrollstep
<- int_of_string
s with exc
->
2280 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2282 TEswitch
("scroll step: ", E.s, None
, intentry, ondone, true)
2287 conf
.autoscrollstep
<- boundastep state
.winh
(int_of_string
s);
2288 if state
.autoscroll
<> None
2289 then state
.autoscroll
<- Some conf
.autoscrollstep
2291 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2293 TEswitch
("auto scroll step: ", E.s, None
, intentry, ondone, true)
2298 let n, a, b = multicolumns_of_string
s in
2299 setcolumns mode
n a b;
2301 state
.text <- Printf.sprintf
"bad columns `%s': %s" s (exntos exc
)
2303 TEswitch
("columns: ", E.s, None
, textentry, ondone, true)
2308 let zoom = float (int_of_string
s) /. 100.0 in
2311 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2313 TEswitch
("zoom: ", E.s, None
, intentry, ondone, true)
2318 conf
.thumbw
<- bound
(int_of_string
s) 2 4096;
2320 Printf.sprintf
"thumbnail width is set to %d" conf
.thumbw
;
2321 begin match mode
with
2323 leavebirdseye beye
false;
2330 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2332 TEswitch
("thumbnail width: ", E.s, None
, intentry, ondone, true)
2337 Some
(int_of_string
s)
2339 state
.text <- Printf.sprintf
"bad integer `%s': %s"
2343 | Some angle
-> reqlayout angle conf
.fitmodel
2346 TEswitch
("rotation: ", E.s, None
, intentry, ondone, true)
2349 conf
.icase
<- not conf
.icase
;
2350 TEdone
("case insensitive search " ^
(btos conf
.icase
))
2353 conf
.preload <- not conf
.preload;
2355 TEdone
("preload " ^
(btos conf
.preload))
2358 conf
.verbose
<- not conf
.verbose
;
2359 TEdone
("verbose " ^
(btos conf
.verbose
))
2362 conf
.debug
<- not conf
.debug
;
2363 TEdone
("debug " ^
(btos conf
.debug
))
2366 conf
.maxhfit
<- not conf
.maxhfit
;
2367 state
.maxy
<- calcheight
();
2368 TEdone
("maxhfit " ^
(btos conf
.maxhfit
))
2371 conf
.crophack
<- not conf
.crophack
;
2372 TEdone
("crophack " ^
btos conf
.crophack
)
2376 match conf
.maxwait
with
2378 conf
.maxwait
<- Some infinity
;
2379 "always wait for page to complete"
2381 conf
.maxwait
<- None
;
2382 "show placeholder if page is not ready"
2387 conf
.underinfo
<- not conf
.underinfo
;
2388 TEdone
("underinfo " ^
btos conf
.underinfo
)
2391 conf
.savebmarks
<- not conf
.savebmarks
;
2392 TEdone
("persistent bookmarks " ^
btos conf
.savebmarks
)
2398 match state
.layout with
2403 conf
.interpagespace
<- int_of_string
s;
2404 docolumns conf
.columns
;
2405 state
.maxy
<- calcheight
();
2406 let y = getpagey
pageno in
2409 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2411 TEswitch
("vertical margin: ", E.s, None
, intentry, ondone, true)
2415 match conf
.fitmodel
with
2416 | FitProportional
-> FitWidth
2417 | FitWidth
| FitPage
-> FitProportional
2419 reqlayout conf
.angle
fm;
2420 TEdone
("proportional display " ^
btos (fm == FitProportional
))
2423 settrim (not conf
.trimmargins
) conf
.trimfuzz
;
2424 TEdone
("trim margins " ^
btos conf
.trimmargins
)
2427 conf
.invert
<- not conf
.invert
;
2428 TEdone
("invert colors " ^
btos conf
.invert
)
2432 cbput state
.hists
.sel
s;
2435 TEswitch
("selection command: ", E.s, Some
(onhist state
.hists
.sel
),
2436 textentry, ondone, true)
2440 then conf
.pax
<- Some
(ref (0.0, 0, 0))
2441 else conf
.pax
<- None
;
2442 TEdone
("PAX " ^
btos (conf
.pax
!= None
))
2445 state
.text <- Printf.sprintf
"bad option %d `%c'" key c;
2451 class type lvsource
= object
2452 method getitemcount
: int
2453 method getitem
: int -> (string * int)
2454 method hasaction
: int -> bool
2462 method getactive
: int
2463 method getfirst
: int
2465 method getminfo
: (int * int) array
2468 class virtual lvsourcebase
= object
2469 val mutable m_active
= 0
2470 val mutable m_first
= 0
2471 val mutable m_pan
= 0
2472 method getactive
= m_active
2473 method getfirst
= m_first
2474 method getpan
= m_pan
2475 method getminfo
: (int * int) array
= E.a
2478 let textentrykeyboard
2479 key _mask
((c, text, opthist
, onkey
, ondone, cancelonempty
), onleave
) =
2481 if key >= 0xffb0 && key <= 0xffb9
2482 then key - 0xffb0 + 48 else key
2485 state
.mode
<- Textentry
(te
, onleave
);
2488 G.postRedisplay "textentrykeyboard enttext";
2490 let histaction cmd
=
2493 | Some
(action, _) ->
2494 state
.mode
<- Textentry
(
2495 (c, action cmd
, opthist
, onkey
, ondone, cancelonempty
), onleave
2497 G.postRedisplay "textentry histaction"
2501 if emptystr
text && cancelonempty
2504 G.postRedisplay "textentrykeyboard after cancel";
2507 let s = withoutlastutf8
text in
2508 enttext (c, s, opthist
, onkey
, ondone, cancelonempty
)
2510 | @enter
| @kpenter
->
2513 G.postRedisplay "textentrykeyboard after confirm"
2515 | @up
| @kpup
-> histaction HCprev
2516 | @down
| @kpdown
-> histaction HCnext
2517 | @home
| @kphome
-> histaction HCfirst
2518 | @jend
| @kpend
-> histaction HClast
2523 begin match opthist
with
2525 | Some
(_, onhistcancel
) -> onhistcancel
()
2529 G.postRedisplay "textentrykeyboard after cancel2"
2532 enttext (c, E.s, opthist
, onkey
, ondone, cancelonempty
)
2535 | @delete
| @kpdelete
-> ()
2538 && key land 0xff00 != 0xff00 (* keyboard *)
2539 && key land 0xfe00 != 0xfe00 (* xkb *)
2540 && key land 0xfd00 != 0xfd00 (* 3270 *)
2542 begin match onkey
text key with
2546 G.postRedisplay "textentrykeyboard after confirm2";
2549 enttext (c, text, opthist
, onkey
, ondone, cancelonempty
);
2553 G.postRedisplay "textentrykeyboard after cancel3"
2556 state
.mode
<- Textentry
(te
, onleave
);
2557 G.postRedisplay "textentrykeyboard switch";
2561 vlog "unhandled key %s" (Wsi.keyname
key)
2564 let firstof first active
=
2565 if first
> active
|| abs
(first
- active
) > fstate
.maxrows
- 1
2566 then max
0 (active
- (fstate
.maxrows
/2))
2570 let calcfirst first active
=
2573 let rows = active
- first
in
2574 if rows > fstate
.maxrows
then active
- fstate
.maxrows
else first
2578 let scrollph y maxy
=
2579 let sh = float (maxy
+ state
.winh
) /. float state
.winh
in
2580 let sh = float state
.winh
/. sh in
2581 let sh = max
sh (float conf
.scrollh
) in
2583 let percent = float y /. float maxy
in
2584 let position = (float state
.winh
-. sh) *. percent in
2587 if position +. sh > float state
.winh
2588 then float state
.winh
-. sh
2594 let coe s = (s :> uioh
);;
2596 class listview ~zebra ~helpmode ~
(source
:lvsource
) ~trusted ~modehash
=
2598 val m_pan
= source#getpan
2599 val m_first
= source#getfirst
2600 val m_active
= source#getactive
2602 val m_prev_uioh
= state
.uioh
2604 method private elemunder
y =
2608 let n = y / (fstate
.fontsize
+1) in
2609 if m_first
+ n < source#getitemcount
2611 if source#hasaction
(m_first
+ n)
2612 then Some
(m_first
+ n)
2619 GlFunc.blend_func ~src
:`src_alpha ~dst
:`one_minus_src_alpha
;
2620 GlDraw.color
(0., 0., 0.) ~alpha
:0.85;
2621 filledrect 0. 0. (float state
.winw
) (float state
.winh
);
2622 GlDraw.color
(1., 1., 1.);
2623 Gl.enable `texture_2d
;
2624 let fs = fstate
.fontsize
in
2626 let hw = (wadjsb () + xadjsb () + state
.winw
)/3 in
2627 let ww = fstate
.wwidth
in
2628 let tabw = 17.0*.ww in
2629 let itemcount = source#getitemcount
in
2630 let minfo = source#getminfo
in
2633 then float (xadjsb ()), float (state
.winw
- 1)
2634 else 0.0, float (state
.winw
- conf
.scrollbw
- 1)
2636 let xadj = xadjsb () in
2638 if (row - m_first
) > fstate
.maxrows
2641 if row >= 0 && row < itemcount
2643 let (s, level
) = source#getitem
row in
2644 let y = (row - m_first
) * nfs in
2646 (if conf
.leftscroll
then float xadj else 5.0)
2647 +. (float (level
+ m_pan
)) *. ww in
2650 (let c = if row land 1 = 0 then 1.0 else 0.92 in (c,c,c));
2654 Gl.disable `texture_2d
;
2655 let alpha = if source#hasaction
row then 0.9 else 0.3 in
2656 GlDraw.color
(1., 1., 1.) ~
alpha;
2657 linerect (x0 +. 1.) (float (y + 1)) (x1) (float (y + fs + 3));
2658 Gl.enable `texture_2d
;
2661 if zebra
&& row land 1 = 1
2665 GlDraw.color
(c,c,c);
2666 let drawtabularstring s =
2668 let x'
= truncate
(x0 +. x) in
2669 let pos = nindex
s '
\000'
in
2671 then drawstring1 fs x'
(y+nfs) s
2673 let s1 = String.sub
s 0 pos
2674 and s2
= String.sub
s (pos+1) (String.length
s - pos - 1) in
2679 let s'
= withoutlastutf8
s in
2680 let s = s' ^
"@Uellipsis" in
2681 let w = measurestr
fs s in
2682 if float x'
+. w +. ww < float (hw + x'
)
2687 if float x'
+. ww +. measurestr
fs s1 > float (hw + x'
)
2691 ignore
(drawstring1 fs x'
(y+nfs) s1);
2692 drawstring1 fs (hw + x'
) (y+nfs) s2
2696 let x = if helpmode
&& row > 0 then x +. ww else x in
2697 let tabpos = nindex
s '
\t'
in
2700 let len = String.length
s - tabpos - 1 in
2701 let s1 = String.sub
s 0 tabpos
2702 and s2
= String.sub
s (tabpos + 1) len in
2703 let nx = drawstr x s1 in
2705 let x = x +. (max
tabw sw) in
2708 let len = String.length
s - 2 in
2709 if len > 0 && s.[0] = '
\xc2'
&& s.[1] = '
\xb7'
2711 let s = String.sub
s 2 len in
2712 let x = if not helpmode
then x +. ww else x in
2713 GlDraw.color
(1.2, 1.2, 1.2);
2714 let vinc = drawstring1 (fs+fs/4)
2715 (truncate
(x -. ww)) (y+nfs) s in
2716 GlDraw.color
(1., 1., 1.);
2717 vinc +. (float fs *. 0.8)
2723 ignore
(drawtabularstring s);
2729 GlDraw.color
(1.0, 1.0, 1.0) ~
alpha:0.5;
2730 let xadj = float (xadjsb () + 5) in
2732 if (row - m_first
) > fstate
.maxrows
2735 if row >= 0 && row < itemcount
2737 let (s, level
) = source#getitem
row in
2738 let pos0 = nindex
s '
\000'
in
2739 let y = (row - m_first
) * nfs in
2740 let x = float (level
+ m_pan
) *. ww in
2741 let (first
, last
) = minfo.(row) in
2743 if pos0 > 0 && first
> pos0
2744 then String.sub
s (pos0+1) (first
-pos0-1)
2745 else String.sub
s 0 first
2747 let suffix = String.sub
s first
(last
- first
) in
2748 let w1 = measurestr fstate
.fontsize
prefix in
2749 let w2 = measurestr fstate
.fontsize
suffix in
2750 let x = x +. if conf
.leftscroll
then xadj else 5.0 in
2751 let x = if pos0 > 0 && first
> pos0 then x +. float hw else x in
2753 and y0 = float (y+2) in
2755 and y1 = float (y+fs+3) in
2756 filledrect x0 y0 x1 y1;
2761 Gl.disable `texture_2d
;
2762 if Array.length
minfo > 0 then loop m_first
;
2765 method updownlevel incr
=
2766 let len = source#getitemcount
in
2768 if m_active
>= 0 && m_active
< len
2769 then snd
(source#getitem m_active
)
2773 if i
= len then i
-1 else if i
= -1 then 0 else
2774 let _, l = source#getitem i
in
2775 if l != curlevel then i
else flow (i
+incr
)
2777 let active = flow m_active
in
2778 let first = calcfirst m_first
active in
2779 G.postRedisplay "outline updownlevel";
2780 {< m_active
= active; m_first
= first >}
2782 method private key1
key mask
=
2783 let set1 active first qsearch
=
2784 coe {< m_active
= active; m_first
= first; m_qsearch
= qsearch
>}
2786 let search active pattern incr
=
2787 let active = if active = -1 then m_first
else active in
2790 if n >= 0 && n < source#getitemcount
2792 let s, _ = source#getitem
n in
2794 (try ignore
(Str.search_forward re
s 0); true
2795 with Not_found
-> false)
2797 else loop (n + incr
)
2804 let re = Str.regexp_case_fold pattern
in
2810 let itemcount = source#getitemcount
in
2811 let find start incr
=
2813 if i
= -1 || i
= itemcount
2816 if source#hasaction i
2818 else find (i
+ incr
)
2823 let set active first =
2824 let first = bound
first 0 (itemcount - fstate
.maxrows
) in
2826 coe {< m_active
= active; m_first
= first; m_qsearch
= E.s >}
2829 let isvisible first n = n >= first && n - first <= fstate
.maxrows
in
2831 let incr1 = if incr
> 0 then 1 else -1 in
2832 if isvisible m_first m_active
2835 let next = m_active
+ incr
in
2837 if next < 0 || next >= itemcount
2839 else find next incr1
2841 if abs
(m_active
- next) > fstate
.maxrows
2847 let first = m_first
+ incr
in
2848 let first = bound
first 0 (itemcount - fstate
.maxrows
) in
2850 let next = m_active
+ incr
in
2851 let next = bound
next 0 (itemcount - 1) in
2858 if isvisible first next
2865 let first = min
next m_first
in
2867 if abs
(next - first) > fstate
.maxrows
2873 let first = m_first
+ incr
in
2874 let first = bound
first 0 (itemcount - 1) in
2876 let next = m_active
+ incr
in
2877 let next = bound
next 0 (itemcount - 1) in
2878 let next = find next incr1 in
2880 if next = -1 || abs
(m_active
- first) > fstate
.maxrows
2882 let active = if m_active
= -1 then next else m_active
in
2887 if isvisible first active
2893 G.postRedisplay "listview navigate";
2897 | (@r
|@s) when Wsi.withctrl mask
->
2898 let incr = if key = @r
then -1 else 1 in
2900 match search (m_active
+ incr) m_qsearch
incr with
2902 state
.text <- m_qsearch ^
" [not found]";
2905 state
.text <- m_qsearch
;
2906 active, firstof m_first
active
2908 G.postRedisplay "listview ctrl-r/s";
2909 set1 active first m_qsearch
;
2911 | @insert
when Wsi.withctrl mask
->
2912 if m_active
>= 0 && m_active
< source#getitemcount
2914 let s, _ = source#getitem m_active
in
2920 if emptystr m_qsearch
2923 let qsearch = withoutlastutf8 m_qsearch
in
2927 G.postRedisplay "listview empty qsearch";
2928 set1 m_active m_first
E.s;
2932 match search m_active
qsearch ~
-1 with
2934 state
.text <- qsearch ^
" [not found]";
2937 state
.text <- qsearch;
2938 active, firstof m_first
active
2940 G.postRedisplay "listview backspace qsearch";
2941 set1 active first qsearch
2944 | key when (key != 0 && key land 0xff00 != 0xff00) ->
2945 let pattern = m_qsearch ^ toutf8
key in
2947 match search m_active
pattern 1 with
2949 state
.text <- pattern ^
" [not found]";
2952 state
.text <- pattern;
2953 active, firstof m_first
active
2955 G.postRedisplay "listview qsearch add";
2956 set1 active first pattern;
2960 if emptystr m_qsearch
2962 G.postRedisplay "list view escape";
2965 source#exit ~uioh
:(coe self
)
2966 ~cancel
:true ~
active:m_active ~
first:m_first ~pan
:m_pan
2968 | None
-> m_prev_uioh
2973 G.postRedisplay "list view kill qsearch";
2974 coe {< m_qsearch
= E.s >}
2977 | @enter
| @kpenter
->
2979 let self = {< m_qsearch
= E.s >} in
2981 G.postRedisplay "listview enter";
2982 if m_active
>= 0 && m_active
< source#getitemcount
2984 source#exit ~uioh
:(coe self) ~cancel
:false
2985 ~
active:m_active ~
first:m_first ~pan
:m_pan
;
2988 source#exit ~uioh
:(coe self) ~cancel
:true
2989 ~
active:m_active ~
first:m_first ~pan
:m_pan
;
2992 begin match opt with
2993 | None
-> m_prev_uioh
2997 | @delete
| @kpdelete
->
3000 | @up
| @kpup
-> navigate ~
-1
3001 | @down
| @kpdown
-> navigate 1
3002 | @prior
| @kpprior
-> navigate ~
-(fstate
.maxrows
)
3003 | @next | @kpnext
-> navigate fstate
.maxrows
3005 | @right
| @kpright
->
3007 G.postRedisplay "listview right";
3008 coe {< m_pan
= m_pan
- 1 >}
3010 | @left | @kpleft
->
3012 G.postRedisplay "listview left";
3013 coe {< m_pan
= m_pan
+ 1 >}
3015 | @home
| @kphome
->
3016 let active = find 0 1 in
3017 G.postRedisplay "listview home";
3021 let first = max
0 (itemcount - fstate
.maxrows
) in
3022 let active = find (itemcount - 1) ~
-1 in
3023 G.postRedisplay "listview end";
3026 | key when (key = 0 || key land 0xff00 = 0xff00) ->
3030 dolog
"listview unknown key %#x" key; coe self
3032 method key key mask
=
3033 match state
.mode
with
3034 | Textentry te
-> textentrykeyboard key mask te
; coe self
3037 | LinkNav
_ -> self#key1
key mask
3039 method button button down
x y _ =
3042 | 1 when x > state
.winw
- conf
.scrollbw
->
3043 G.postRedisplay "listview scroll";
3046 let _, position, sh = self#
scrollph in
3047 if y > truncate
position && y < truncate
(position +. sh)
3049 state
.mstate
<- Mscrolly
;
3053 let s = float (max
0 (y - conf
.scrollh
)) /. float state
.winh
in
3054 let first = truncate
(s *. float source#getitemcount
) in
3055 let first = min source#getitemcount
first in
3056 Some
(coe {< m_first
= first; m_active
= first >})
3058 state
.mstate
<- Mnone
;
3062 begin match self#elemunder
y with
3064 G.postRedisplay "listview click";
3065 source#exit ~uioh
:(coe {< m_active
= n >})
3066 ~cancel
:false ~
active:n ~
first:m_first ~pan
:m_pan
3070 | n when (n == 4 || n == 5) && not down
->
3071 let len = source#getitemcount
in
3073 if n = 5 && m_first
+ fstate
.maxrows
>= len
3077 let first = m_first
+ (if n == 4 then -1 else 1) in
3078 bound
first 0 (len - 1)
3080 G.postRedisplay "listview wheel";
3081 Some
(coe {< m_first
= first >})
3082 | n when (n = 6 || n = 7) && not down
->
3083 let inc = if n = 7 then -1 else 1 in
3084 G.postRedisplay "listview hwheel";
3085 Some
(coe {< m_pan
= m_pan
+ inc >})
3090 | None
-> m_prev_uioh
3093 method multiclick
_ x y = self#button
1 true x y
3096 match state
.mstate
with
3098 let s = float (max
0 (y - conf
.scrollh
)) /. float state
.winh
in
3099 let first = truncate
(s *. float source#getitemcount
) in
3100 let first = min source#getitemcount
first in
3101 G.postRedisplay "listview motion";
3102 coe {< m_first
= first; m_active
= first >}
3110 method pmotion
x y =
3111 if x < state
.winw
- conf
.scrollbw
3114 match self#elemunder
y with
3115 | None
-> Wsi.setcursor
Wsi.CURSOR_INHERIT
; m_active
3116 | Some
n -> Wsi.setcursor
Wsi.CURSOR_INFO
; n
3120 then (G.postRedisplay "listview pmotion"; {< m_active
= n >})
3125 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
3129 method infochanged
_ = ()
3131 method scrollpw
= (0, 0.0, 0.0)
3133 let nfs = fstate
.fontsize
+ 1 in
3134 let y = m_first
* nfs in
3135 let itemcount = source#getitemcount
in
3136 let maxi = max
0 (itemcount - fstate
.maxrows
) in
3137 let maxy = maxi * nfs in
3138 let p, h = scrollph y maxy in
3141 method modehash
= modehash
3142 method eformsgs
= false
3143 method alwaysscrolly
= true
3146 class outlinelistview ~zebra ~source
=
3147 let settext autonarrow
s =
3150 let ss = source#statestr
in
3154 else "{" ^
ss ^
"} [" ^
s ^
"]"
3155 else state
.text <- s
3161 ~source
:(source
:> lvsource
)
3163 ~modehash
:(findkeyhash conf
"outline")
3166 val m_autonarrow
= false
3168 method! key key mask
=
3170 if emptystr state
.text
3172 else fstate
.maxrows - 2
3174 let calcfirst first active =
3177 let rows = active - first in
3178 if rows > maxrows then active - maxrows else first
3182 let active = m_active
+ incr in
3183 let active = bound
active 0 (source#getitemcount
- 1) in
3184 let first = calcfirst m_first
active in
3185 G.postRedisplay "outline navigate";
3186 coe {< m_active
= active; m_first
= first >}
3188 let navscroll first =
3190 let dist = m_active
- first in
3196 else first + maxrows
3199 G.postRedisplay "outline navscroll";
3200 coe {< m_first
= first; m_active
= active >}
3202 let ctrl = Wsi.withctrl mask
in
3207 then (source#denarrow
; E.s)
3209 let pattern = source#renarrow
in
3210 if nonemptystr m_qsearch
3211 then (source#narrow m_qsearch
; m_qsearch
)
3215 settext (not m_autonarrow
) text;
3216 G.postRedisplay "toggle auto narrowing";
3217 coe {< m_first
= 0; m_active
= 0; m_autonarrow
= not m_autonarrow
>}
3219 | @slash
when emptystr m_qsearch
&& not m_autonarrow
->
3221 G.postRedisplay "toggle auto narrowing";
3222 coe {< m_first
= 0; m_active
= 0; m_autonarrow
= true >}
3225 source#narrow m_qsearch
;
3227 then source#add_narrow_pattern m_qsearch
;
3228 G.postRedisplay "outline ctrl-n";
3229 coe {< m_first
= 0; m_active
= 0 >}
3232 let active = source#calcactive
(getanchor
()) in
3233 let first = firstof m_first
active in
3234 G.postRedisplay "outline ctrl-s";
3235 coe {< m_first
= first; m_active
= active >}
3238 G.postRedisplay "outline ctrl-u";
3239 if m_autonarrow
&& nonemptystr m_qsearch
3241 ignore
(source#renarrow
);
3242 settext m_autonarrow
E.s;
3243 coe {< m_first
= 0; m_active
= 0; m_qsearch
= E.s >}
3246 source#del_narrow_pattern
;
3247 let pattern = source#renarrow
in
3249 if emptystr
pattern then E.s else "Narrowed to " ^
pattern
3251 settext m_autonarrow
text;
3252 coe {< m_first
= 0; m_active
= 0; m_qsearch
= E.s >}
3256 let first = max
0 (m_active
- (fstate
.maxrows / 2)) in
3257 G.postRedisplay "outline ctrl-l";
3258 coe {< m_first
= first >}
3260 | @tab
when m_autonarrow
->
3261 if nonemptystr m_qsearch
3263 G.postRedisplay "outline list view tab";
3264 source#add_narrow_pattern m_qsearch
;
3266 coe {< m_qsearch
= E.s >}
3270 | @escape
when m_autonarrow
->
3271 if nonemptystr m_qsearch
3272 then source#add_narrow_pattern m_qsearch
;
3275 | @enter
| @kpenter
when m_autonarrow
->
3276 if nonemptystr m_qsearch
3277 then source#add_narrow_pattern m_qsearch
;
3280 | key when m_autonarrow
&& (key != 0 && key land 0xff00 != 0xff00) ->
3281 let pattern = m_qsearch ^ toutf8
key in
3282 G.postRedisplay "outlinelistview autonarrow add";
3283 source#narrow
pattern;
3284 settext true pattern;
3285 coe {< m_first
= 0; m_active
= 0; m_qsearch
= pattern >}
3287 | key when m_autonarrow
&& key = @backspace
->
3288 if emptystr m_qsearch
3291 let pattern = withoutlastutf8 m_qsearch
in
3292 G.postRedisplay "outlinelistview autonarrow backspace";
3293 ignore
(source#renarrow
);
3294 source#narrow
pattern;
3295 settext true pattern;
3296 coe {< m_first
= 0; m_active
= 0; m_qsearch
= pattern >}
3298 | @delete
| @kpdelete
->
3299 source#remove m_active
;
3300 G.postRedisplay "outline delete";
3301 let active = max
0 (m_active
-1) in
3302 coe {< m_first
= firstof m_first
active;
3303 m_active
= active >}
3305 | @up
| @kpup
when ctrl ->
3306 navscroll (max
0 (m_first
- 1))
3308 | @down
| @kpdown
when ctrl ->
3309 navscroll (min
(source#getitemcount
- 1) (m_first
+ 1))
3311 | @up
| @kpup
-> navigate ~
-1
3312 | @down
| @kpdown
-> navigate 1
3313 | @prior
| @kpprior
-> navigate ~
-(fstate
.maxrows)
3314 | @next | @kpnext
-> navigate fstate
.maxrows
3316 | @right
| @kpright
->
3320 G.postRedisplay "outline ctrl right";
3321 {< m_pan
= m_pan
+ 1 >}
3323 else self#updownlevel
1
3327 | @left | @kpleft
->
3331 G.postRedisplay "outline ctrl left";
3332 {< m_pan
= m_pan
- 1 >}
3334 else self#updownlevel ~
-1
3338 | @home
| @kphome
->
3339 G.postRedisplay "outline home";
3340 coe {< m_first
= 0; m_active
= 0 >}
3343 let active = source#getitemcount
- 1 in
3344 let first = max
0 (active - fstate
.maxrows) in
3345 G.postRedisplay "outline end";
3346 coe {< m_active
= active; m_first
= first >}
3348 | _ -> super#
key key mask
3351 let genhistoutlines =
3352 let order ty
(p1
, c1
, _, _, _) (p2
, c2
, _, _, _) =
3354 | `lastvisit
-> compare c1
.lastvisit c2
.lastvisit
3355 | `path
-> compare p2 p1
3356 | `file
-> compare
(Filename.basename p2
) (Filename.basename p1
)
3358 let e1 = emptystr c1
.title
3359 and e2
= emptystr c2
.title
in
3361 then compare
(Filename.basename p2
) (Filename.basename p1
)
3364 else compare c1
.title c2
.title
3366 let showfullpath = ref false in
3369 let s = if orderty
= t
then "[@Uradical] " ^
s else "[ ] " ^
s in
3370 s, 0, Oaction
(fun () -> Config.historder
:= t
; reeenterhist := true)
3372 let list = ref [] in
3373 if Config.gethist
list
3377 (fun accu (path
, c, b, x, a) ->
3378 let hist = (path
, (c, b, x, a)) in
3379 let s = if !showfullpath then path
else Filename.basename path
in
3380 let base = mbtoutf8
s in
3381 (base ^
"\000" ^
c.title
, 1, Ohistory
hist) :: accu
3383 [ setorty "Sort by time of last visit" `lastvisit
;
3384 setorty "Sort by file name" `file
;
3385 setorty "Sort by path" `path
;
3386 setorty "Sort by title" `title
;
3387 (if !showfullpath then "@Uradical "
3388 else " ") ^
"Show full path", 0, Oaction
(fun () ->
3389 showfullpath := not
!showfullpath; reeenterhist := true)
3390 ] (List.sort
(order orderty
) !list)
3396 let gotohist (path
, (c, bookmarks
, x, anchor)) =
3397 Config.save
leavebirdseye;
3398 state
.anchor <- anchor;
3400 state
.bookmarks
<- bookmarks
;
3401 state
.origin
<- E.s;
3403 let x0, y0, x1, y1 = conf
.trimfuzz
in
3404 wcmd "trimset %d %d %d %d %d" (btod conf
.trimmargins
) x0 y0 x1 y1;
3408 let makecheckers () =
3409 (* Based on lablGL-1.04/LablGlut/examples/lablGL/checker.ml which had
3411 converted by Issac Trotts. July 25, 2002 *)
3412 let image = GlPix.create `ubyte ~format
:`luminance ~width
:2 ~height
:2 in
3413 Raw.sets_string
(GlPix.to_raw
image) ~
pos:0 "\255\200\200\255";
3414 let id = GlTex.gen_texture
() in
3415 GlTex.bind_texture ~target
:`texture_2d
id;
3416 GlPix.store
(`unpack_alignment
1);
3417 GlTex.image2d
image;
3418 List.iter
(GlTex.parameter ~target
:`texture_2d
)
3419 [ `mag_filter `nearest
; `min_filter `nearest
];
3423 let setcheckers enabled
=
3424 match state
.checkerstexid
with
3426 if enabled
then state
.checkerstexid
<- Some
(makecheckers ())
3428 | Some checkerstexid
->
3431 GlTex.delete_texture checkerstexid
;
3432 state
.checkerstexid
<- None
;
3436 let describe_location () =
3437 let fn = page_of_y state
.y in
3438 let ln = page_of_y
(state
.y + state
.winh
- hscrollh () - 1) in
3439 let maxy = state
.maxy - (if conf
.maxhfit
then state
.winh
else 0) in
3443 else (100. *. (float state
.y /. float maxy))
3447 Printf.sprintf
"page %d of %d [%.2f%%]"
3448 (fn+1) state
.pagecount
percent
3451 "pages %d-%d of %d [%.2f%%]"
3452 (fn+1) (ln+1) state
.pagecount
percent
3455 let setpresentationmode v
=
3456 let n = page_of_y state
.y in
3457 state
.anchor <- (n, 0.0, 1.0);
3458 conf
.presentation
<- v
;
3459 if conf
.fitmodel
= FitPage
3460 then reqlayout conf
.angle conf
.fitmodel
;
3465 let btos b = if b then "@Uradical" else E.s in
3466 let showextended = ref false in
3467 let leave mode
_ = state
.mode
<- mode
in
3470 val mutable m_first_time
= true
3471 val mutable m_l
= []
3472 val mutable m_a
= E.a
3473 val mutable m_prev_uioh
= nouioh
3474 val mutable m_prev_mode
= View
3476 inherit lvsourcebase
3478 method reset prev_mode prev_uioh
=
3479 m_a
<- Array.of_list
(List.rev m_l
);
3481 m_prev_mode
<- prev_mode
;
3482 m_prev_uioh
<- prev_uioh
;
3486 if n >= Array.length m_a
3490 | _, _, _, Action
_ -> m_active
<- n
3491 | _, _, _, Noaction
-> loop (n+1)
3494 m_first_time
<- false;
3497 method int name get
set =
3499 (name
, `
int get
, 1, Action
(
3502 try set (int_of_string
s)
3504 state
.text <- Printf.sprintf
"bad integer `%s': %s"
3508 let te = name ^
": ", E.s, None
, intentry, ondone, true in
3509 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3513 method int_with_suffix name get
set =
3515 (name
, `intws get
, 1, Action
(
3518 try set (int_of_string_with_suffix
s)
3520 state
.text <- Printf.sprintf
"bad integer `%s': %s"
3525 name ^
": ", E.s, None
, intentry_with_suffix, ondone, true
3527 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3531 method bool ?
(offset
=1) ?
(btos=btos) name get
set =
3533 (name
, `
bool (btos, get
), offset
, Action
(
3540 method color name get
set =
3542 (name
, `color get
, 1, Action
(
3544 let invalid = (nan
, nan
, nan
) in
3547 try color_of_string
s
3549 state
.text <- Printf.sprintf
"bad color `%s': %s"
3556 let te = name ^
": ", E.s, None
, textentry, ondone, true in
3557 state
.text <- color_to_string
(get
());
3558 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3562 method string name get
set =
3564 (name
, `
string get
, 1, Action
(
3566 let ondone s = set s in
3567 let te = name ^
": ", E.s, None
, textentry, ondone, true in
3568 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3572 method colorspace name get
set =
3574 (name
, `
string get
, 1, Action
(
3578 inherit lvsourcebase
3581 m_active
<- CSTE.to_int conf
.colorspace
;
3584 method getitemcount
=
3585 Array.length
CSTE.names
3588 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3589 ignore
(uioh
, first, pan
);
3590 if not cancel
then set active;
3592 method hasaction
_ = true
3596 let modehash = findkeyhash conf
"info" in
3597 coe (new listview ~zebra
:false ~helpmode
:false
3598 ~
source ~trusted
:true ~
modehash)
3601 method paxmark name get
set =
3603 (name
, `
string get
, 1, Action
(
3607 inherit lvsourcebase
3610 m_active
<- MTE.to_int conf
.paxmark
;
3613 method getitemcount
= Array.length
MTE.names
3614 method getitem
n = (MTE.names
.(n), 0)
3615 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3616 ignore
(uioh
, first, pan
);
3617 if not cancel
then set active;
3619 method hasaction
_ = true
3623 let modehash = findkeyhash conf
"info" in
3624 coe (new listview ~zebra
:false ~helpmode
:false
3625 ~
source ~trusted
:true ~
modehash)
3628 method fitmodel name get
set =
3630 (name
, `
string get
, 1, Action
(
3634 inherit lvsourcebase
3637 m_active
<- FMTE.to_int conf
.fitmodel
;
3640 method getitemcount
= Array.length
FMTE.names
3641 method getitem
n = (FMTE.names
.(n), 0)
3642 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3643 ignore
(uioh
, first, pan
);
3644 if not cancel
then set active;
3646 method hasaction
_ = true
3650 let modehash = findkeyhash conf
"info" in
3651 coe (new listview ~zebra
:false ~helpmode
:false
3652 ~
source ~trusted
:true ~
modehash)
3655 method caption
s offset
=
3656 m_l
<- (s, `empty
, offset
, Noaction
) :: m_l
3658 method caption2
s f offset
=
3659 m_l
<- (s, `
string f, offset
, Noaction
) :: m_l
3661 method getitemcount
= Array.length m_a
3664 let tostr = function
3665 | `
int f -> string_of_int
(f ())
3666 | `intws
f -> string_with_suffix_of_int
(f ())
3668 | `color
f -> color_to_string
(f ())
3669 | `
bool (btos, f) -> btos (f ())
3672 let name, t
, offset
, _ = m_a
.(n) in
3673 ((let s = tostr t
in
3675 then Printf.sprintf
"%s\t%s" name s
3679 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3684 match m_a
.(active) with
3685 | _, _, _, Action
f -> f uioh
3686 | _, _, _, Noaction
-> uioh
3697 method hasaction
n =
3699 | _, _, _, Action
_ -> true
3700 | _, _, _, Noaction
-> false
3703 let rec fillsrc prevmode prevuioh
=
3704 let sep () = src#caption
E.s 0 in
3705 let colorp name get
set =
3707 (fun () -> color_to_string
(get
()))
3710 let c = color_of_string
v in
3713 state
.text <- Printf.sprintf
"bad color `%s': %s" v (exntos exn
)
3716 let oldmode = state
.mode
in
3717 let birdseye = isbirdseye state
.mode
in
3719 src#caption
(if birdseye then "Setup (Bird's eye)" else "Setup") 0;
3721 src#
bool "presentation mode"
3722 (fun () -> conf
.presentation
)
3723 (fun v -> setpresentationmode v);
3725 src#
bool "ignore case in searches"
3726 (fun () -> conf
.icase
)
3727 (fun v -> conf
.icase
<- v);
3730 (fun () -> conf
.preload)
3731 (fun v -> conf
.preload <- v);
3733 src#
bool "highlight links"
3734 (fun () -> conf
.hlinks
)
3735 (fun v -> conf
.hlinks
<- v);
3737 src#
bool "under info"
3738 (fun () -> conf
.underinfo
)
3739 (fun v -> conf
.underinfo
<- v);
3741 src#
bool "persistent bookmarks"
3742 (fun () -> conf
.savebmarks
)
3743 (fun v -> conf
.savebmarks
<- v);
3745 src#fitmodel
"fit model"
3746 (fun () -> FMTE.to_string conf
.fitmodel
)
3747 (fun v -> reqlayout conf
.angle
(FMTE.of_int
v));
3749 src#
bool "trim margins"
3750 (fun () -> conf
.trimmargins
)
3751 (fun v -> settrim v conf
.trimfuzz
; fillsrc prevmode prevuioh
);
3753 src#
bool "persistent location"
3754 (fun () -> conf
.jumpback
)
3755 (fun v -> conf
.jumpback
<- v);
3758 src#
int "inter-page space"
3759 (fun () -> conf
.interpagespace
)
3761 conf
.interpagespace
<- n;
3762 docolumns conf
.columns
;
3764 match state
.layout with
3769 state
.maxy <- calcheight
();
3770 let y = getpagey
pageno in
3775 (fun () -> conf
.pagebias
)
3776 (fun v -> conf
.pagebias
<- v);
3778 src#
int "scroll step"
3779 (fun () -> conf
.scrollstep
)
3780 (fun n -> conf
.scrollstep
<- n);
3782 src#
int "horizontal scroll step"
3783 (fun () -> conf
.hscrollstep
)
3784 (fun v -> conf
.hscrollstep
<- v);
3786 src#
int "auto scroll step"
3788 match state
.autoscroll
with
3790 | _ -> conf
.autoscrollstep
)
3792 let n = boundastep state
.winh
n in
3793 if state
.autoscroll
<> None
3794 then state
.autoscroll
<- Some
n;
3795 conf
.autoscrollstep
<- n);
3798 (fun () -> truncate
(conf
.zoom *. 100.))
3799 (fun v -> setzoom ((float v) /. 100.));
3802 (fun () -> conf
.angle
)
3803 (fun v -> reqlayout v conf
.fitmodel
);
3805 src#
int "scroll bar width"
3806 (fun () -> conf
.scrollbw
)
3809 reshape state
.winw state
.winh
;
3812 src#
int "scroll handle height"
3813 (fun () -> conf
.scrollh
)
3814 (fun v -> conf
.scrollh
<- v;);
3816 src#
int "thumbnail width"
3817 (fun () -> conf
.thumbw
)
3819 conf
.thumbw
<- min
4096 v;
3822 leavebirdseye beye
false;
3829 let mode = state
.mode in
3830 src#
string "columns"
3832 match conf
.columns
with
3834 | Cmulti
(multi
, _) -> multicolumns_to_string multi
3835 | Csplit
(count
, _) -> "-" ^ string_of_int count
3838 let n, a, b = multicolumns_of_string
v in
3839 setcolumns mode n a b);
3842 src#caption
"Pixmap cache" 0;
3843 src#int_with_suffix
"size (advisory)"
3844 (fun () -> conf
.memlimit
)
3845 (fun v -> conf
.memlimit
<- v);
3848 (fun () -> Printf.sprintf
"%s bytes, %d tiles"
3849 (string_with_suffix_of_int state
.memused
)
3850 (Hashtbl.length state
.tilemap
)) 1;
3853 src#caption
"Layout" 0;
3854 src#caption2
"Dimension"
3856 Printf.sprintf
"%dx%d (virtual %dx%d)"
3857 state
.winw state
.winh
3862 src#caption2
"Position" (fun () ->
3863 Printf.sprintf
"%dx%d" state
.x state
.y
3866 src#caption2
"Position" (fun () -> describe_location ()) 1
3870 src#
bool ~offset
:0 ~
btos:(fun v -> if v then "(on)" else "(off)")
3871 "Save these parameters as global defaults at exit"
3872 (fun () -> conf
.bedefault
)
3873 (fun v -> conf
.bedefault
<- v)
3877 let btos b = if b then "@Ulguillemet" else "@Urguillemet" in
3878 src#
bool ~offset
:0 ~
btos "Extended parameters"
3879 (fun () -> !showextended)
3880 (fun v -> showextended := v; fillsrc prevmode prevuioh
);
3884 (fun () -> conf
.checkers
)
3885 (fun v -> conf
.checkers
<- v; setcheckers v);
3886 src#
bool "update cursor"
3887 (fun () -> conf
.updatecurs
)
3888 (fun v -> conf
.updatecurs
<- v);
3889 src#
bool "scroll-bar on the left"
3890 (fun () -> conf
.leftscroll
)
3891 (fun v -> conf
.leftscroll
<- v);
3893 (fun () -> conf
.verbose
)
3894 (fun v -> conf
.verbose
<- v);
3895 src#
bool "invert colors"
3896 (fun () -> conf
.invert
)
3897 (fun v -> conf
.invert
<- v);
3899 (fun () -> conf
.maxhfit
)
3900 (fun v -> conf
.maxhfit
<- v);
3901 src#
bool "redirect stderr"
3902 (fun () -> conf
.redirectstderr)
3903 (fun v -> conf
.redirectstderr <- v; redirectstderr ());
3905 (fun () -> conf
.pax
!= None
)
3908 then conf
.pax
<- Some
(ref (now
(), 0, 0))
3909 else conf
.pax
<- None
);
3910 src#
string "uri launcher"
3911 (fun () -> conf
.urilauncher
)
3912 (fun v -> conf
.urilauncher
<- v);
3913 src#
string "path launcher"
3914 (fun () -> conf
.pathlauncher
)
3915 (fun v -> conf
.pathlauncher
<- v);
3916 src#
string "tile size"
3917 (fun () -> Printf.sprintf
"%dx%d" conf
.tilew conf
.tileh
)
3920 let w, h = Scanf.sscanf
v "%dx%d" (fun w h -> w, h) in
3921 conf
.tilew
<- max
64 w;
3922 conf
.tileh
<- max
64 h;
3925 state
.text <- Printf.sprintf
"bad tile size `%s': %s"
3928 src#
int "texture count"
3929 (fun () -> conf
.texcount
)
3932 then conf
.texcount
<- v
3933 else showtext '
!'
" Failed to set texture count please retry later"
3935 src#
int "slice height"
3936 (fun () -> conf
.sliceheight
)
3938 conf
.sliceheight
<- v;
3939 wcmd "sliceh %d" conf
.sliceheight
;
3941 src#
int "anti-aliasing level"
3942 (fun () -> conf
.aalevel
)
3944 conf
.aalevel
<- bound
v 0 8;
3945 state
.anchor <- getanchor
();
3946 opendoc state
.path state
.password;
3948 src#
string "page scroll scaling factor"
3949 (fun () -> string_of_float conf
.pgscale)
3952 let s = float_of_string
v in
3955 state
.text <- Printf.sprintf
3956 "bad page scroll scaling factor `%s': %s" v (exntos exn
)
3959 src#
int "ui font size"
3960 (fun () -> fstate
.fontsize
)
3961 (fun v -> setfontsize (bound
v 5 100));
3962 src#
int "hint font size"
3963 (fun () -> conf
.hfsize
)
3964 (fun v -> conf
.hfsize
<- bound
v 5 100);
3965 colorp "background color"
3966 (fun () -> conf
.bgcolor
)
3967 (fun v -> conf
.bgcolor
<- v);
3968 src#
bool "crop hack"
3969 (fun () -> conf
.crophack
)
3970 (fun v -> conf
.crophack
<- v);
3971 src#
string "trim fuzz"
3972 (fun () -> irect_to_string conf
.trimfuzz
)
3975 conf
.trimfuzz
<- irect_of_string
v;
3977 then settrim true conf
.trimfuzz
;
3979 state
.text <- Printf.sprintf
"bad irect `%s': %s" v (exntos exn
)
3981 src#
string "throttle"
3983 match conf
.maxwait
with
3984 | None
-> "show place holder if page is not ready"
3987 then "wait for page to fully render"
3989 "wait " ^ string_of_float
time
3990 ^
" seconds before showing placeholder"
3994 let f = float_of_string
v in
3996 then conf
.maxwait
<- None
3997 else conf
.maxwait
<- Some
f
3999 state
.text <- Printf.sprintf
"bad time `%s': %s" v (exntos exn
)
4001 src#
string "ghyll scroll"
4003 match conf
.ghyllscroll
with
4005 | Some nab
-> ghyllscroll_to_string nab
4008 try conf
.ghyllscroll
<- ghyllscroll_of_string
v
4010 state
.text <- Printf.sprintf
"bad ghyll `%s': %s" v (exntos exn
)
4012 src#
string "selection command"
4013 (fun () -> conf
.selcmd
)
4014 (fun v -> conf
.selcmd
<- v);
4015 src#
string "synctex command"
4016 (fun () -> conf
.stcmd
)
4017 (fun v -> conf
.stcmd
<- v);
4018 src#
string "pax command"
4019 (fun () -> conf
.paxcmd
)
4020 (fun v -> conf
.paxcmd
<- v);
4021 src#
string "ask password command"
4022 (fun () -> conf
.passcmd)
4023 (fun v -> conf
.passcmd <- v);
4024 src#
string "save path command"
4025 (fun () -> conf
.savecmd
)
4026 (fun v -> conf
.savecmd
<- v);
4027 src#colorspace
"color space"
4028 (fun () -> CSTE.to_string conf
.colorspace
)
4030 conf
.colorspace
<- CSTE.of_int
v;
4034 src#paxmark
"pax mark method"
4035 (fun () -> MTE.to_string conf
.paxmark
)
4036 (fun v -> conf
.paxmark
<- MTE.of_int
v);
4040 (fun () -> conf
.usepbo
)
4041 (fun v -> conf
.usepbo
<- v);
4042 src#
bool "mouse wheel scrolls pages"
4043 (fun () -> conf
.wheelbypage
)
4044 (fun v -> conf
.wheelbypage
<- v);
4045 src#
bool "open remote links in a new instance"
4046 (fun () -> conf
.riani
)
4047 (fun v -> conf
.riani
<- v);
4051 src#caption
"Document" 0;
4052 List.iter
(fun (_, s) -> src#caption
s 1) state
.docinfo
;
4053 src#caption2
"Pages"
4054 (fun () -> string_of_int state
.pagecount
) 1;
4055 src#caption2
"Dimensions"
4056 (fun () -> string_of_int
(List.length state
.pdims
)) 1;
4060 src#caption
"Trimmed margins" 0;
4061 src#caption2
"Dimensions"
4062 (fun () -> string_of_int
(List.length state
.pdims
)) 1;
4066 src#caption
"OpenGL" 0;
4067 src#caption
(Printf.sprintf
"Vendor\t%s" (GlMisc.get_string `vendor
)) 1;
4068 src#caption
(Printf.sprintf
"Renderer\t%s" (GlMisc.get_string `renderer
)) 1;
4071 src#caption
"Location" 0;
4072 if nonemptystr state
.origin
4073 then src#caption
("Orign\t" ^ mbtoutf8 state
.origin
) 1;
4074 src#caption
("Path\t" ^ mbtoutf8 state
.path
) 1;
4076 src#reset prevmode prevuioh
;
4081 let prevmode = state
.mode
4082 and prevuioh
= state
.uioh in
4083 fillsrc prevmode prevuioh
;
4084 let source = (src :> lvsource
) in
4085 let modehash = findkeyhash conf
"info" in
4086 state
.uioh <- coe (object (self)
4087 inherit listview ~zebra
:false ~helpmode
:false
4088 ~
source ~trusted
:true ~
modehash as super
4089 val mutable m_prevmemused
= 0
4090 method! infochanged
= function
4092 if m_prevmemused
!= state
.memused
4094 m_prevmemused
<- state
.memused
;
4095 G.postRedisplay "memusedchanged";
4097 | Pdim
-> G.postRedisplay "pdimchanged"
4098 | Docinfo
-> fillsrc prevmode prevuioh
4100 method! key key mask
=
4101 if not
(Wsi.withctrl mask
)
4104 | @left | @kpleft
-> coe (self#updownlevel ~
-1)
4105 | @right
| @kpright
-> coe (self#updownlevel
1)
4106 | _ -> super#
key key mask
4107 else super#
key key mask
4109 G.postRedisplay "info";
4115 inherit lvsourcebase
4116 method getitemcount
= Array.length state
.help
4118 let s, l, _ = state
.help
.(n) in
4121 method exit ~
uioh ~cancel ~
active ~
first ~pan
=
4125 match state
.help
.(active) with
4126 | _, _, Action
f -> Some
(f uioh)
4127 | _, _, Noaction
-> Some
uioh
4136 method hasaction
n =
4137 match state
.help
.(n) with
4138 | _, _, Action
_ -> true
4139 | _, _, Noaction
-> false
4145 let modehash = findkeyhash conf
"help" in
4147 state
.uioh <- coe (new listview
4148 ~zebra
:false ~helpmode
:true
4149 ~
source ~trusted
:true ~
modehash);
4150 G.postRedisplay "help";
4156 inherit lvsourcebase
4157 val mutable m_items
= E.a
4159 method getitemcount
= 1 + Array.length m_items
4164 else m_items
.(n-1), 0
4166 method exit ~
uioh ~cancel ~
active ~
first ~pan
=
4171 then Buffer.clear state
.errmsgs
;
4178 method hasaction
n =
4182 state
.newerrmsgs
<- false;
4183 let l = Str.split newlinere
(Buffer.contents state
.errmsgs
) in
4184 m_items
<- Array.of_list
l
4193 let source = (msgsource :> lvsource
) in
4194 let modehash = findkeyhash conf
"listview" in
4195 state
.uioh <- coe (object
4196 inherit listview ~zebra
:false ~helpmode
:false
4197 ~
source ~trusted
:false ~
modehash as super
4200 then msgsource#reset
;
4203 G.postRedisplay "msgs";
4207 let editor = getenvwithdef
"EDITOR" E.s in
4211 let tmppath = Filename.temp_file
"llpp" "note" in
4214 let oc = open_out
tmppath in
4218 let execstr = editor ^
" " ^
tmppath in
4220 match popen
execstr [] with
4221 | (exception exn
) ->
4223 Printf.sprintf
"popen(%S) failed: %s" execstr (exntos exn
);
4226 match Unix.waitpid
[] pid
4228 | (exception exn
) ->
4230 Printf.sprintf
"waitpid(%d) failed: %s" pid (exntos exn
);
4234 | Unix.WEXITED
0 -> filelines
tmppath
4237 Printf.sprintf
"editor process(%s) exited abnormally: %d"
4240 | Unix.WSIGNALED
n ->
4242 Printf.sprintf
"editor process(%s) was killed by signal %d"
4245 | Unix.WSTOPPED
n ->
4247 Printf.sprintf
"editor(%s) process was stopped by signal %d"
4251 match Unix.unlink
tmppath with
4252 | (exception exn
) ->
4253 showtext '
!'
@@ Printf.sprintf
"failed to ulink %S: %s"
4254 tmppath (exntos exn
);
4259 let enterannotmode opaque slinkindex
=
4262 inherit lvsourcebase
4263 val mutable m_text
= E.s
4264 val mutable m_items
= E.a
4266 method getitemcount
= Array.length m_items
4269 let label, _func
= m_items
.(n) in
4272 method exit ~
uioh ~cancel ~
active ~
first ~pan
=
4273 ignore
(uioh, first, pan
);
4276 let _label, func
= m_items
.(active) in
4281 method hasaction
n = not
@@ emptystr
@@ fst m_items
.(n)
4284 let rec split accu b i
=
4286 if p = String.length
s
4287 then (String.sub
s b (p-b), unit) :: accu
4289 if (i
> 70 && s.[p] = ' '
) || s.[p] = '
\r'
|| s.[p] = '
\n'
4291 let ss = if i
= 0 then E.s else String.sub
s b i
in
4292 split ((ss, unit)::accu) (p+1) 0
4297 wcmd "freepage %s" (~
> opaque);
4299 Hashtbl.fold (fun key opaque'
accu ->
4300 if opaque'
= opaque'
4301 then key :: accu else accu) state
.pagemap
[]
4303 List.iter
(Hashtbl.remove state
.pagemap
) keys;
4308 delannot
opaque slinkindex
;
4311 let edit inline
() =
4316 modannot
opaque slinkindex
s;
4322 let mode = state
.mode in
4325 ("annotation: ", m_text
, None
, textentry, update, true),
4326 fun _ -> state
.mode <- mode);
4330 let s = getusertext m_text
in
4335 ( "[Copy]", fun () -> selstring m_text
)
4336 :: ("[Delete]", dele)
4337 :: ("[Edit]", edit true)
4339 :: split [] 0 0 |> List.rev
|> Array.of_list
4346 let s = getannotcontents
opaque slinkindex
in
4349 let source = (msgsource :> lvsource
) in
4350 let modehash = findkeyhash conf
"listview" in
4351 state
.uioh <- coe (object
4352 inherit listview ~zebra
:false ~helpmode
:false
4353 ~
source ~trusted
:false ~
modehash
4355 G.postRedisplay "enterannotmode";
4358 let gotounder under =
4359 let getpath filename
=
4361 if nonemptystr filename
4363 if Filename.is_relative filename
4365 let dir = Filename.dirname state
.path in
4367 if Filename.is_implicit
dir
4368 then Filename.concat
(Sys.getcwd
()) dir
4371 Filename.concat
dir filename
4375 if Sys.file_exists
path
4380 | Ulinkgoto
(pageno, top) ->
4384 gotopage1 pageno top;
4390 | Uremote
(filename
, pageno) ->
4391 let path = getpath filename
in
4396 let command = Printf.sprintf
"%s -page %d %S" !selfexec pageno path in
4397 try addpid
@@ popen
command []
4399 Printf.eprintf
"failed to execute `%s': %s\n" command (exntos exn
);
4402 let anchor = getanchor
() in
4403 let ranchor = state
.path, state
.password, anchor, state
.origin
in
4404 state
.origin
<- E.s;
4405 state
.anchor <- (pageno, 0.0, 0.0);
4406 state
.ranchors
<- ranchor :: state
.ranchors
;
4409 else showtext '
!'
("Could not find " ^ filename
)
4411 | Uremotedest
(filename
, destname
) ->
4412 let path = getpath filename
in
4417 let command = !selfexec ^
" " ^
path ^
" -dest " ^ destname
in
4418 try addpid
@@ popen
command []
4421 "failed to execute `%s': %s\n" command (exntos exn
);
4424 let anchor = getanchor
() in
4425 let ranchor = state
.path, state
.password, anchor, state
.origin
in
4426 state
.origin
<- E.s;
4427 state
.nameddest
<- destname
;
4428 state
.ranchors
<- ranchor :: state
.ranchors
;
4431 else showtext '
!'
("Could not find " ^ filename
)
4433 | Uunexpected
_ | Ulaunch
_ | Unamed
_ | Utext
_ | Unone
-> ()
4434 | Uannotation
(opaque, slinkindex
) -> enterannotmode opaque slinkindex
4437 let gotooutline (_, _, kind
) =
4441 let (pageno, y, _) = anchor in
4443 (if conf
.presentation
then (pageno, y, 1.0) else anchor)
4447 | Ouri
uri -> gotounder (Ulinkuri
uri)
4448 | Olaunch cmd
-> gotounder (Ulaunch cmd
)
4449 | Oremote remote
-> gotounder (Uremote remote
)
4450 | Ohistory
hist -> gotohist hist
4451 | Oremotedest remotedest
-> gotounder (Uremotedest remotedest
)
4455 let outlinesource sourcetype
=
4457 inherit lvsourcebase
4458 val mutable m_items
= E.a
4459 val mutable m_minfo
= E.a
4460 val mutable m_orig_items
= E.a
4461 val mutable m_orig_minfo
= E.a
4462 val mutable m_narrow_patterns
= []
4463 val mutable m_hadremovals
= false
4464 val mutable m_gen
= -1
4466 method getitemcount
=
4467 Array.length m_items
+ (if m_hadremovals
then 1 else 0)
4470 if n == Array.length m_items
&& m_hadremovals
4472 ("[Confirm removal]", 0)
4474 let s, n, _ = m_items
.(n) in
4477 method exit ~
uioh ~cancel ~
active ~
first ~pan
=
4478 ignore
(uioh, first);
4479 let confrimremoval = m_hadremovals
&& active = Array.length m_items
in
4481 if m_narrow_patterns
= []
4482 then m_orig_items
, m_orig_minfo
4483 else m_items
, m_minfo
4487 if not
confrimremoval
4489 gotooutline m_items
.(active);
4494 state
.bookmarks
<- Array.to_list m_items
;
4495 m_orig_items
<- m_items
;
4496 m_orig_minfo
<- m_minfo
;
4506 method hasaction
_ = true
4509 if Array.length m_items
!= Array.length m_orig_items
4512 match m_narrow_patterns
with
4514 | many
-> String.concat
"@Uellipsis" (List.rev many
)
4516 "Narrowed to " ^
s ^
" (ctrl-u to restore)"
4520 match m_narrow_patterns
with
4523 | head
:: _ -> "@Uellipsis" ^ head
4525 method narrow
pattern =
4526 let reopt = try Some
(Str.regexp_case_fold
pattern) with _ -> None
in
4530 let rec loop accu minfo n =
4533 m_items
<- Array.of_list
accu;
4534 m_minfo
<- Array.of_list
minfo;
4537 let (s, _, t
) as o = m_items
.(n) in
4540 | Oaction
_ -> o :: accu, (0, 0) :: minfo
4541 | Onone
| Oanchor
_ | Ouri
_ | Olaunch
_
4542 | Oremote
_ | Oremotedest
_ | Ohistory
_ ->
4544 try Str.search_forward
re s 0
4545 with Not_found
-> -1
4548 then o :: accu, (first, Str.match_end
()) :: minfo
4551 loop accu minfo (n-1)
4553 loop [] [] (Array.length m_items
- 1)
4555 method! getminfo
= m_minfo
4559 match sourcetype
with
4560 | `bookmarks
-> Array.of_list state
.bookmarks
4561 | `outlines
-> state
.outlines
4562 | `history
-> genhistoutlines !Config.historder
4564 m_minfo
<- m_orig_minfo
;
4565 m_items
<- m_orig_items
4568 if sourcetype
= `bookmarks
4570 if m >= 0 && m < Array.length m_items
4572 m_hadremovals
<- true;
4573 m_items
<- Array.init
(Array.length m_items
- 1) (fun n ->
4574 let n = if n >= m then n+1 else n in
4579 method add_narrow_pattern
pattern =
4580 m_narrow_patterns
<- pattern :: m_narrow_patterns
4582 method del_narrow_pattern
=
4583 match m_narrow_patterns
with
4584 | _ :: rest
-> m_narrow_patterns
<- rest
4589 match m_narrow_patterns
with
4590 | pattern :: [] -> self#narrow
pattern; pattern
4592 List.fold_left
(fun accu pattern ->
4593 self#narrow
pattern;
4594 pattern ^
"@Uellipsis" ^
accu) E.s list
4596 method calcactive
anchor =
4597 let rely = getanchory anchor in
4598 let rec loop n best bestd
=
4599 if n = Array.length m_items
4602 let _, _, kind
= m_items
.(n) in
4605 let orely = getanchory anchor in
4606 let d = abs
(orely - rely) in
4609 else loop (n+1) best bestd
4610 | Onone
| Oremote
_ | Olaunch
_
4611 | Oremotedest
_ | Ouri
_ | Ohistory
_ | Oaction
_ ->
4612 loop (n+1) best bestd
4616 method reset
anchor items =
4617 m_hadremovals
<- false;
4618 if state
.gen
!= m_gen
4620 m_orig_items
<- items;
4622 m_narrow_patterns
<- [];
4624 m_orig_minfo
<- E.a;
4628 if items != m_orig_items
4630 m_orig_items
<- items;
4631 if m_narrow_patterns
== []
4632 then m_items
<- items;
4635 let active = self#calcactive
anchor in
4637 m_first
<- firstof m_first
active
4641 let enterselector sourcetype
=
4643 let source = outlinesource sourcetype
in
4646 match sourcetype
with
4647 | `bookmarks
-> Array.of_list state
.bookmarks
4648 | `
outlines -> state
.outlines
4649 | `history
-> genhistoutlines !Config.historder
4651 if Array.length
outlines = 0
4653 showtext ' ' errmsg
;
4656 state
.text <- source#greetmsg
;
4657 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
4658 let anchor = getanchor
() in
4659 source#reset
anchor outlines;
4661 coe (new outlinelistview ~zebra
:(sourcetype
=`history
) ~
source);
4662 G.postRedisplay "enter selector";
4666 let enteroutlinemode =
4667 let f = enterselector `
outlines in
4668 fun () -> f "Document has no outline";
4671 let enterbookmarkmode =
4672 let f = enterselector `bookmarks
in
4673 fun () -> f "Document has no bookmarks (yet)";
4676 let enterhistmode () = enterselector `history
"No history (yet)";;
4678 let quickbookmark ?title
() =
4679 match state
.layout with
4685 let tm = Unix.localtime
(now
()) in
4686 Printf.sprintf
"Quick (page %d) (bookmarked at %d/%d/%d %d:%d)"
4690 (tm.Unix.tm_year
+ 1900)
4693 | Some
title -> title
4695 state
.bookmarks
<- (title, 0, Oanchor
(getanchor1
l)) :: state
.bookmarks
4698 let setautoscrollspeed step goingdown
=
4699 let incr = max
1 ((abs step
) / 2) in
4700 let incr = if goingdown
then incr else -incr in
4701 let astep = boundastep state
.winh
(step
+ incr) in
4702 state
.autoscroll
<- Some
astep;
4706 match conf
.columns
with
4708 | Csingle
_ | Cmulti
_ -> state
.x != 0 || conf
.zoom > 1.0
4711 let panbound x = bound
x (-state
.w) (wadjsb () + state
.winw
);;
4713 let existsinrow pageno (columns
, coverA
, coverB
) p =
4714 let last = ((pageno - coverA
) mod columns
) + columns
in
4715 let rec any = function
4718 if l.pageno = coverA
- 1 || l.pageno = state
.pagecount
- coverB
4722 then (if l.pageno = last then false else any rest
)
4730 match state
.layout with
4732 let pageno = page_of_y state
.y in
4733 gotoghyll (getpagey
(pageno+1))
4735 match conf
.columns
with
4737 if conf
.presentation
&& rest
== [] && l.pageh
> l.pagey + l.pagevh
4739 let y = clamp (pgscale state
.winh
) in
4742 let pageno = min
(l.pageno+1) (state
.pagecount
-1) in
4743 gotoghyll (getpagey
pageno)
4744 | Cmulti
((c, _, _) as cl, _) ->
4745 if conf
.presentation
4746 && (existsinrow l.pageno cl
4747 (fun l -> l.pageh
> l.pagey + l.pagevh))
4749 let y = clamp (pgscale state
.winh
) in
4752 let pageno = min
(l.pageno+c) (state
.pagecount
-1) in
4753 gotoghyll (getpagey
pageno)
4755 if l.pageno < state
.pagecount
- 1 || l.pagecol
< n - 1
4757 let pagey, pageh
= getpageyh
l.pageno in
4758 let pagey = pagey + pageh
* l.pagecol
in
4759 let ips = if l.pagecol
= 0 then 0 else conf
.interpagespace
in
4760 gotoghyll (pagey + pageh
+ ips)
4764 match state
.layout with
4766 let pageno = page_of_y state
.y in
4767 gotoghyll (getpagey
(pageno-1))
4769 match conf
.columns
with
4771 if conf
.presentation
&& l.pagey != 0
4773 gotoghyll (clamp (pgscale ~
-(state
.winh
)))
4775 let pageno = max
0 (l.pageno-1) in
4776 gotoghyll (getpagey
pageno)
4777 | Cmulti
((c, _, coverB
) as cl, _) ->
4778 if conf
.presentation
&&
4779 (existsinrow l.pageno cl (fun l -> l.pagey != 0))
4781 gotoghyll (clamp (pgscale ~
-(state
.winh
)))
4784 if l.pageno = state
.pagecount
- coverB
4788 let pageno = max
0 (l.pageno-decr) in
4789 gotoghyll (getpagey
pageno)
4797 let pageno = max
0 (l.pageno-1) in
4798 let pagey, pageh
= getpageyh
pageno in
4801 let pagey, pageh
= getpageyh
l.pageno in
4802 pagey + pageh
* (l.pagecol
-1) - conf
.interpagespace
4808 if emptystr conf
.savecmd
4809 then error
"don't know where to save modified document"
4811 let savecmd = Str.global_replace percentsre state
.path conf
.savecmd in
4814 (fun s -> error
"failed to obtain path to the saved copy: %s" s)
4817 if not
(emptystr
path)
4819 let tmp = path ^
".tmp" in
4821 Unix.rename
tmp path;
4824 let viewkeyboard key mask
=
4826 let mode = state
.mode in
4827 state
.mode <- Textentry
(te, fun _ -> state
.mode <- mode);
4830 G.postRedisplay "view:enttext"
4832 let ctrl = Wsi.withctrl mask
in
4834 if key >= 0xffb0 && key < 0xffb9 then key - 0xffb0 + 48 else key
4840 if hasunsavedchanges
()
4844 if conf
.angle
mod 360 = 0 && not
(isbirdseye state
.mode)
4846 state
.mode <- LinkNav
(Ltgendir
0);
4849 else showtext '
!'
"Keyboard link navigation does not work under rotation"
4852 begin match state
.mstate
with
4855 G.postRedisplay "kill rect";
4858 | Mscrolly
| Mscrollx
4861 begin match state
.mode with
4864 G.postRedisplay "esc leave linknav"
4868 match state
.ranchors
with
4870 | (path, password, anchor, origin
) :: rest
->
4871 state
.ranchors
<- rest
;
4872 state
.anchor <- anchor;
4873 state
.origin
<- origin
;
4874 state
.nameddest
<- E.s;
4875 opendoc path password
4880 gotoghyll (getnav ~
-1)
4891 Hashtbl.iter
(fun _ opaque -> clearmark
opaque) state
.pagemap
;
4892 G.postRedisplay "dehighlight";
4894 | @slash
| @question
->
4895 let ondone isforw
s =
4896 cbput state
.hists
.pat
s;
4897 state
.searchpattern
<- s;
4900 let s = String.make
1 (Char.chr
key) in
4901 enttext (s, E.s, Some
(onhist state
.hists
.pat
),
4902 textentry, ondone (key = @slash
), true)
4904 | @plus
| @kpplus
| @equals
when ctrl ->
4905 let incr = if conf
.zoom +. 0.01 > 0.1 then 0.1 else 0.01 in
4906 setzoom (conf
.zoom +. incr)
4908 | @plus
| @kpplus
->
4911 try int_of_string
s with exc
->
4912 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
);
4918 state
.text <- "page bias is now " ^ string_of_int
n;
4921 enttext ("page bias: ", E.s, None
, intentry, ondone, true)
4923 | @minus
| @kpminus
when ctrl ->
4924 let decr = if conf
.zoom -. 0.1 < 0.1 then 0.01 else 0.1 in
4925 setzoom (max
0.01 (conf
.zoom -. decr))
4927 | @minus
| @kpminus
->
4928 let ondone msg
= state
.text <- msg
in
4930 "option [acfhilpstvxACFPRSZTISM]: ", E.s, None
,
4931 optentry state
.mode, ondone, true
4942 | (@1 | @2) when ctrl && conf
.fitmodel
!= FitPage
-> (* ctrl-1/2 *)
4944 match conf
.columns
with
4945 | Csingle
_ | Cmulti
_ -> 1
4946 | Csplit
(n, _) -> n
4948 let h = state
.winh
-
4949 conf
.interpagespace
lsl (if conf
.presentation
then 1 else 0)
4951 let zoom = zoomforh state
.winw
h (vscrollw ()) cols in
4952 if zoom > 0.0 && (key = 50 || zoom < 1.0)
4957 match conf
.fitmodel
with
4958 | FitWidth
-> FitProportional
4959 | FitProportional
-> FitPage
4960 | FitPage
-> FitWidth
4962 state
.text <- "fit model: " ^
FMTE.to_string
fm;
4963 reqlayout conf
.angle
fm
4971 | (48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57)
4972 when not
ctrl -> (* 0..9 *)
4975 try int_of_string
s with exc
->
4976 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
);
4982 cbput state
.hists
.pag
(string_of_int
n);
4983 gotopage1 (n + conf
.pagebias
- 1) 0;
4986 let pageentry text key =
4987 match Char.unsafe_chr
key with
4988 | '
g'
-> TEdone
text
4989 | _ -> intentry text key
4991 let text = String.make
1 (Char.chr
key) in
4992 enttext (":", text, Some
(onhist state
.hists
.pag
),
4993 pageentry, ondone, true)
4996 conf
.scrollb
<- if conf
.scrollb
= 0 then (scrollbvv
lor scrollbhv
) else 0;
4997 reshape state
.winw state
.winh
;
5000 state
.bzoom
<- not state
.bzoom
;
5002 showtext ' '
("block zoom " ^
if state
.bzoom
then "on" else "off")
5005 conf
.hlinks
<- not conf
.hlinks
;
5006 state
.text <- "highlightlinks " ^
if conf
.hlinks
then "on" else "off";
5007 G.postRedisplay "toggle highlightlinks";
5010 state
.glinks
<- true;
5011 let mode = state
.mode in
5012 state
.mode <- Textentry
(
5013 (":", E.s, None
, linknentry, linkndone gotounder, false),
5015 state
.glinks
<- false;
5019 G.postRedisplay "view:linkent(F)"
5022 state
.glinks
<- true;
5023 let mode = state
.mode in
5024 state
.mode <- Textentry
(
5026 ":", E.s, None
, linknentry, linkndone (fun under ->
5027 selstring (undertext under);
5031 state
.glinks
<- false;
5035 G.postRedisplay "view:linkent"
5038 begin match state
.autoscroll
with
5040 conf
.autoscrollstep
<- step
;
5041 state
.autoscroll
<- None
5043 if conf
.autoscrollstep
= 0
5044 then state
.autoscroll
<- Some
1
5045 else state
.autoscroll
<- Some conf
.autoscrollstep
5052 setpresentationmode (not conf
.presentation
);
5053 showtext ' '
("presentation mode " ^
5054 if conf
.presentation
then "on" else "off");
5057 if List.mem
Wsi.Fullscreen state
.winstate
5058 then Wsi.reshape conf
.cwinw conf
.cwinh
5059 else Wsi.fullscreen
()
5062 search state
.searchpattern
false
5065 search state
.searchpattern
true
5068 begin match state
.layout with
5071 gotoghyll (getpagey
l.pageno)
5077 | @delete
| @kpdelete
-> (* delete *)
5081 showtext ' '
(describe_location ());
5084 begin match state
.layout with
5087 Wsi.reshape (l.pagew
+ vscrollw ()) l.pageh
;
5092 enterbookmarkmode ()
5100 | @e when Buffer.length state
.errmsgs
> 0 ->
5105 match state
.layout with
5110 (s, 0, Oanchor
(getanchor1
l)) :: state
.bookmarks
5113 enttext ("bookmark: ", E.s, None
, textentry, ondone, true)
5117 showtext ' '
"Quick bookmark added";
5120 begin match state
.layout with
5122 let rect = getpdimrect
l.pagedimno
in
5126 (truncate
(1.8 *. (rect.(1) -. rect.(0))),
5127 truncate
(1.2 *. (rect.(3) -. rect.(0))))
5129 (truncate
(rect.(1) -. rect.(0)),
5130 truncate
(rect.(3) -. rect.(0)))
5132 let w = truncate
((float w)*.conf
.zoom)
5133 and h = truncate
((float h)*.conf
.zoom) in
5136 state
.anchor <- getanchor
();
5137 Wsi.reshape (w + vscrollw ()) (h + conf
.interpagespace
)
5139 G.postRedisplay "z";
5144 | @x -> state
.roam
()
5147 reqlayout (conf
.angle
+
5148 (if key = @Gt
then 30 else -30)) conf
.fitmodel
5152 bound
(conf
.colorscale
+. (if key = 93 then 0.1 else -0.1)) 0.0 1.0
5154 G.postRedisplay "brightness";
5156 | @c when state
.mode = View
->
5161 let m = (wadjsb () + state
.winw
- state
.w) / 2 in
5163 gotoy_and_clear_text state
.y
5167 match state
.prevcolumns
with
5168 | None
-> (1, 0, 0), 1.0
5169 | Some
(columns
, z
) ->
5172 | Csplit
(c, _) -> -c, 0, 0
5173 | Cmulti
((c, a, b), _) -> c, a, b
5174 | Csingle
_ -> 1, 0, 0
5178 setcolumns View
c a b;
5181 | @down
| @up
when ctrl && Wsi.withshift mask
->
5182 let zoom, x = state
.prevzoom
in
5186 | @k
| @up
| @kpup
->
5187 begin match state
.autoscroll
with
5189 begin match state
.mode with
5190 | Birdseye beye
-> upbirdseye 1 beye
5195 then gotoy_and_clear_text (clamp ~
-(state
.winh
/2))
5197 if not
(Wsi.withshift mask
) && conf
.presentation
5199 else gotoghyll1 true (clamp (-conf
.scrollstep
))
5203 setautoscrollspeed n false
5206 | @j
| @down
| @kpdown
->
5207 begin match state
.autoscroll
with
5209 begin match state
.mode with
5210 | Birdseye beye
-> downbirdseye 1 beye
5215 then gotoy_and_clear_text (clamp (state
.winh
/2))
5217 if not
(Wsi.withshift mask
) && conf
.presentation
5219 else gotoghyll1 true (clamp (conf
.scrollstep
))
5223 setautoscrollspeed n true
5226 | @left | @right
| @kpleft
| @kpright
when not
(Wsi.withalt mask
) ->
5232 else conf
.hscrollstep
5234 let dx = if key = @left || key = @kpleft
then dx else -dx in
5235 state
.x <- panbound (state
.x + dx);
5236 gotoy_and_clear_text state
.y
5239 G.postRedisplay "left/right"
5242 | @prior
| @kpprior
->
5246 match state
.layout with
5248 | l :: _ -> state
.y - l.pagey
5250 clamp (pgscale (-state
.winh
))
5254 | @next | @kpnext
->
5258 match List.rev state
.layout with
5260 | l :: _ -> getpagey
l.pageno
5262 clamp (pgscale state
.winh
)
5266 | @g | @home
| @kphome
->
5269 | @G
| @jend
| @kpend
->
5271 gotoghyll (clamp state
.maxy)
5273 | @right
| @kpright
when Wsi.withalt mask
->
5274 gotoghyll (getnav 1)
5275 | @left | @kpleft
when Wsi.withalt mask
->
5276 gotoghyll (getnav ~
-1)
5281 | @v when conf
.debug
->
5284 match getopaque l.pageno with
5287 let x0, y0, x1, y1 = pagebbox
opaque in
5288 let a,b = float x0, float y0 in
5289 let c,d = float x1, float y0 in
5290 let e,f = float x1, float y1 in
5291 let h,j
= float x0, float y1 in
5292 let rect = (a,b,c,d,e,f,h,j
) in
5294 state
.rects
<- (l.pageno, l.pageno mod 3, rect) :: state
.rects
;
5296 G.postRedisplay "v";
5299 let mode = state
.mode in
5300 let cmd = ref E.s in
5301 let onleave = function
5302 | Cancel
-> state
.mode <- mode
5305 match getopaque l.pageno with
5306 | Some
opaque -> pipesel opaque !cmd
5307 | None
-> ()) state
.layout;
5311 cbput state
.hists
.sel
s;
5315 "| ", !cmd, Some
(onhist state
.hists
.sel
), textentry, ondone, true
5317 G.postRedisplay "|";
5318 state
.mode <- Textentry
(te, onleave);
5321 vlog "huh? %s" (Wsi.keyname
key)
5324 let linknavkeyboard key mask
linknav =
5325 let getpage pageno =
5326 let rec loop = function
5328 | l :: _ when l.pageno = pageno -> Some
l
5329 | _ :: rest
-> loop rest
5330 in loop state
.layout
5332 let doexact (pageno, n) =
5333 match getopaque pageno, getpage pageno with
5334 | Some
opaque, Some
l ->
5335 if key = @enter
|| key = @kpenter
5337 let under = getlink
opaque n in
5338 G.postRedisplay "link gotounder";
5345 Some
(findlink
opaque LDfirst
), -1
5348 Some
(findlink
opaque LDlast
), 1
5351 Some
(findlink
opaque (LDleft
n)), -1
5354 Some
(findlink
opaque (LDright
n)), 1
5357 Some
(findlink
opaque (LDup
n)), -1
5360 Some
(findlink
opaque (LDdown
n)), 1
5365 begin match findpwl
l.pageno dir with
5369 state
.mode <- LinkNav
(Ltgendir
dir);
5370 let y, h = getpageyh
pageno in
5373 then y + h - state
.winh
5378 begin match getopaque pageno, getpage pageno with
5379 | Some
opaque, Some
_ ->
5381 let ld = if dir > 0 then LDfirst
else LDlast
in
5384 begin match link with
5386 showlinktype (getlink
opaque m);
5387 state
.mode <- LinkNav
(Ltexact
(pageno, m));
5388 G.postRedisplay "linknav jpage";
5389 | Lnotfound
-> notfound dir
5395 begin match opt with
5396 | Some Lnotfound
-> pwl l dir;
5397 | Some
(Lfound
m) ->
5401 let _, y0, _, y1 = getlinkrect
opaque m in
5403 then gotopage1 l.pageno y0
5405 let d = fstate
.fontsize
+ 1 in
5406 if y1 - l.pagey > l.pagevh - d
5407 then gotopage1 l.pageno (y1 - state
.winh
- hscrollh () + d)
5408 else G.postRedisplay "linknav";
5410 showlinktype (getlink
opaque m);
5411 state
.mode <- LinkNav
(Ltexact
(l.pageno, m));
5414 | None
-> viewkeyboard key mask
5416 | _ -> viewkeyboard key mask
5421 G.postRedisplay "leave linknav"
5425 | Ltgendir
_ | Ltnotready
_ -> viewkeyboard key mask
5426 | Ltexact exact
-> doexact exact
5429 let keyboard key mask
=
5430 if (key = 103 && Wsi.withctrl mask
) && not
(istextentry state
.mode)
5431 then wcmd "interrupt"
5432 else state
.uioh <- state
.uioh#
key key mask
5435 let birdseyekeyboard key mask
5436 ((oconf
, leftx
, pageno, hooverpageno
, anchor) as beye
) =
5438 match conf
.columns
with
5440 | Cmulti
((c, _, _), _) -> c
5441 | Csplit
_ -> failwith
"bird's eye split mode"
5443 let pgh layout = List.fold_left
5444 (fun m l -> max
l.pageh
m) state
.winh
layout in
5446 | @l when Wsi.withctrl mask
->
5447 let y, h = getpageyh
pageno in
5448 let top = (state
.winh
- h) / 2 in
5449 gotoy (max
0 (y - top))
5450 | @enter
| @kpenter
-> leavebirdseye beye
false
5451 | @escape
-> leavebirdseye beye
true
5452 | @up
-> upbirdseye incr beye
5453 | @down
-> downbirdseye incr beye
5454 | @left -> upbirdseye 1 beye
5455 | @right
-> downbirdseye 1 beye
5458 begin match state
.layout with
5462 state
.mode <- Birdseye
(
5463 oconf
, leftx
, l.pageno, hooverpageno
, anchor
5465 gotopage1 l.pageno 0;
5468 let layout = layout (state
.y-state
.winh
) (pgh state
.layout) in
5470 | [] -> gotoy (clamp (-state
.winh
))
5472 state
.mode <- Birdseye
(
5473 oconf
, leftx
, l.pageno, hooverpageno
, anchor
5475 gotopage1 l.pageno 0
5478 | [] -> gotoy (clamp (-state
.winh
))
5482 begin match List.rev state
.layout with
5484 let layout = layout (state
.y + (pgh state
.layout)) state
.winh
in
5485 begin match layout with
5487 let incr = l.pageh
- l.pagevh in
5492 oconf
, leftx
, state
.pagecount
- 1, hooverpageno
, anchor
5494 G.postRedisplay "birdseye pagedown";
5496 else gotoy (clamp (incr + conf
.interpagespace
*2));
5500 Birdseye
(oconf
, leftx
, l.pageno, hooverpageno
, anchor);
5501 gotopage1 l.pageno 0;
5504 | [] -> gotoy (clamp state
.winh
)
5508 state
.mode <- Birdseye
(oconf
, leftx
, 0, hooverpageno
, anchor);
5512 let pageno = state
.pagecount
- 1 in
5513 state
.mode <- Birdseye
(oconf
, leftx
, pageno, hooverpageno
, anchor);
5514 if not
(pagevisible state
.layout pageno)
5517 match List.rev state
.pdims
with
5519 | (_, _, h, _) :: _ -> h
5521 gotoy (max
0 (getpagey
pageno - (state
.winh
- h - conf
.interpagespace
)))
5522 else G.postRedisplay "birdseye end";
5524 | _ -> viewkeyboard key mask
5529 match state
.mode with
5530 | Textentry
_ -> scalecolor 0.4
5532 | View
-> scalecolor 1.0
5533 | Birdseye
(_, _, pageno, hooverpageno
, _) ->
5534 if l.pageno = hooverpageno
5537 if l.pageno = pageno
5539 let c = scalecolor 1.0 in
5541 GlDraw.line_width
3.0;
5542 let dispx = xadjsb () + l.pagedispx in
5544 (float (dispx-1)) (float (l.pagedispy-1))
5545 (float (dispx+l.pagevw+1))
5546 (float (l.pagedispy+l.pagevh+1))
5548 GlDraw.line_width
1.0;
5557 let postdrawpage l linkindexbase
=
5558 match getopaque l.pageno with
5560 if tileready l l.pagex
l.pagey
5562 let x = l.pagedispx - l.pagex
+ xadjsb ()
5563 and y = l.pagedispy - l.pagey in
5565 match conf
.columns
with
5566 | Csingle
_ | Cmulti
_ ->
5567 (if conf
.hlinks
then 1 else 0)
5569 && not
(isbirdseye state
.mode) then 2 else 0)
5573 match state
.mode with
5574 | Textentry
((_, s, _, _, _, _), _) when state
.glinks
-> s
5580 postprocess
opaque hlmask x y (linkindexbase
, s, conf
.hfsize
);
5585 let scrollindicator () =
5586 let sbw, ph
, sh = state
.uioh#
scrollph in
5587 let sbh, pw, sw = state
.uioh#scrollpw
in
5592 else ((state
.winw
- sbw), state
.winw
, 0)
5595 GlDraw.color (0.64, 0.64, 0.64);
5596 filledrect (float x0) 0. (float x1) (float state
.winh
);
5598 (float hx0
) (float (state
.winh
- sbh))
5599 (float (hx0
+ wadjsb () + state
.winw
)) (float state
.winh
)
5601 GlDraw.color (0.0, 0.0, 0.0);
5603 filledrect (float x0) ph
(float x1) (ph
+. sh);
5604 let pw = pw +. float hx0
in
5605 filledrect pw (float (state
.winh
- sbh)) (pw +. sw) (float state
.winh
);
5609 match state
.mstate
with
5610 | Mnone
| Mscrolly
| Mscrollx
| Mpan
_ | Mzoom
_ | Mzoomrect
_ ->
5613 | Msel
((x0, y0), (x1, y1)) ->
5614 let identify opaque l px py = Some
(opaque, l.pageno, px, py) in
5615 let o0,n0
,px0
,py0
= onppundermouse identify x0 y0 (~
< E.s, -1, 0, 0) in
5616 let _o1,n1
,px1
,py1
= onppundermouse identify x1 y1 (~
< E.s, -1, 0, 0) in
5617 if n0
!= -1 && n0
= n1
then seltext
o0 (px0
, py0
, px1
, py1
);
5620 let showrects = function [] -> () | rects
->
5622 GlDraw.color (0.0, 0.0, 1.0) ~
alpha:0.5;
5623 GlFunc.blend_func ~
src:`src_alpha ~dst
:`one_minus_src_alpha
;
5625 (fun (pageno, c, (x0, y0, x1, y1, x2
, y2
, x3
, y3
)) ->
5627 if l.pageno = pageno
5629 let dx = float (l.pagedispx - l.pagex
) in
5630 let dy = float (l.pagedispy - l.pagey) in
5631 GlDraw.color (0.0, 0.0, 1.0 /. float c) ~
alpha:0.5;
5632 Raw.sets_float state
.vraw ~
pos:0
5637 GlArray.vertex `two state
.vraw
;
5638 GlArray.draw_arrays `triangle_strip ~
first:0 ~count
:4;
5647 GlClear.color (scalecolor2 conf
.bgcolor
);
5648 GlClear.clear
[`
color];
5649 List.iter
drawpage state
.layout;
5651 match state
.mode with
5652 | LinkNav
(Ltexact
(pageno, linkno
)) ->
5653 begin match getopaque pageno with
5655 let dx = xadjsb () in
5656 let x0, y0, x1, y1 = getlinkrect
opaque linkno
in
5657 let x0 = x0 + dx and x1 = x1 + dx in
5664 | None
-> state
.rects
5666 | LinkNav
(Ltgendir
_) | LinkNav
(Ltnotready
_)
5669 | View
-> state
.rects
5672 let rec postloop linkindexbase
= function
5674 let linkindexbase = linkindexbase + postdrawpage l linkindexbase in
5675 postloop linkindexbase rest
5679 postloop 0 state
.layout;
5681 begin match state
.mstate
with
5682 | Mzoomrect
((x0, y0), (x1, y1)) ->
5684 GlDraw.color (0.3, 0.3, 0.3) ~
alpha:0.5;
5685 GlFunc.blend_func ~
src:`src_alpha ~dst
:`one_minus_src_alpha
;
5686 filledrect (float x0) (float y0) (float x1) (float y1);
5690 | Mscrolly
| Mscrollx
5699 let zoomrect x y x1 y1 =
5702 and y0 = min
y y1 in
5703 gotoy (state
.y + y0);
5704 state
.anchor <- getanchor
();
5705 let zoom = (float state
.w) /. float (x1 - x0) in
5708 let adjw = wadjsb () + state
.winw
in
5710 then (adjw - state
.w) / 2
5713 match conf
.fitmodel
with
5714 | FitWidth
| FitProportional
-> simple ()
5716 match conf
.columns
with
5718 onppundermouse (fun _ l _ _ -> Some
l.pagedispx) x0 y0 x0
5719 | Cmulti
_ | Csingle
_ -> simple ()
5721 state
.x <- (state
.x + margin) - x0;
5726 let annot inline
x y =
5727 match unproject x y with
5728 | Some
(opaque, n, ux
, uy
) ->
5730 addannot
opaque ux uy
text;
5731 wcmd "freepage %s" (~
> opaque);
5732 Hashtbl.remove state
.pagemap
(n, state
.gen
);
5738 let ondone s = add s in
5739 let mode = state
.mode in
5740 state
.mode <- Textentry
(
5741 ("annotation: ", E.s, None
, textentry, ondone, true),
5742 fun _ -> state
.mode <- mode);
5745 G.postRedisplay "annot"
5748 let s = getusertext E.s in
5749 let l = Str.split newlinere
s in
5757 let g opaque l px py =
5758 match rectofblock
opaque px py with
5760 let x0 = a.(0) -. 20. in
5761 let x1 = a.(1) +. 20. in
5762 let y0 = a.(2) -. 20. in
5763 let zoom = (float state
.w) /. (x1 -. x0) in
5764 let pagey = getpagey
l.pageno in
5765 gotoy_and_clear_text (pagey + truncate
y0);
5766 state
.anchor <- getanchor
();
5767 let margin = (state
.w - l.pagew
)/2 in
5768 state
.x <- -truncate
x0 - margin;
5773 match conf
.columns
with
5775 showtext '
!'
"block zooming does not work properly in split columns mode"
5776 | Cmulti
_ | Csingle
_ -> onppundermouse g x y ()
5780 let winw = wadjsb () + state
.winw - 1 in
5781 let s = float x /. float winw in
5782 let destx = truncate
(float (state
.w + winw) *. s) in
5783 state
.x <- winw - destx;
5784 gotoy_and_clear_text state
.y;
5785 state
.mstate
<- Mscrollx
;
5789 let s = float y /. float state
.winh
in
5790 let desty = truncate
(float (state
.maxy - state
.winh
) *. s) in
5791 gotoy_and_clear_text desty;
5792 state
.mstate
<- Mscrolly
;
5795 let viewmulticlick clicks
x y mask
=
5796 let g opaque l px py =
5804 if markunder
opaque px py mark
5808 match getopaque l.pageno with
5810 | Some
opaque -> pipesel opaque cmd
5812 state
.roam
<- (fun () -> dopipe conf
.paxcmd
);
5813 if not
(Wsi.withctrl mask
) then dopipe conf
.selcmd
;
5818 G.postRedisplay "viewmulticlick";
5819 onppundermouse g x y (fun () -> showtext '
!'
"Nothing to select") ();
5823 match conf
.columns
with
5825 | Csingle
_ | Cmulti
_ -> conf
.angle
mod 360 = 0
5828 let viewmouse button down
x y mask
=
5830 | n when (n == 4 || n == 5) && not down
->
5831 if Wsi.withctrl mask
5833 match state
.mstate
with
5834 | Mzoom
(oldn
, i
) ->
5842 if conf
.zoom +. 0.01 > 0.1 then 0.1 else 0.01
5844 if conf
.zoom -. 0.1 < 0.1 then -0.01 else -0.1
5846 let zoom = conf
.zoom -. incr in
5848 state
.mstate
<- Mzoom
(n, 0);
5850 state
.mstate
<- Mzoom
(n, i
+1);
5852 else state
.mstate
<- Mzoom
(n, 0)
5856 | Mscrolly
| Mscrollx
5858 | Mnone
-> state
.mstate
<- Mzoom
(n, 0)
5861 match state
.autoscroll
with
5862 | Some step
-> setautoscrollspeed step
(n=4)
5864 if conf
.wheelbypage
|| conf
.presentation
5873 then -conf
.scrollstep
5874 else conf
.scrollstep
5876 let incr = incr * 2 in
5877 let y = clamp incr in
5878 gotoy_and_clear_text y
5881 | n when (n = 6 || n = 7) && not down
&& canpan () ->
5883 panbound (state
.x + (if n = 7 then -2 else 2) * conf
.hscrollstep
);
5884 gotoy_and_clear_text state
.y
5886 | 1 when Wsi.withshift mask
->
5887 state
.mstate
<- Mnone
;
5890 match unproject x y with
5891 | Some
(_, pageno, ux
, uy
) ->
5892 let cmd = Printf.sprintf
5894 conf
.stcmd state
.path pageno ux uy
5896 addpid
@@ popen
cmd []
5900 | 1 when Wsi.withctrl mask
->
5903 Wsi.setcursor
Wsi.CURSOR_CROSSHAIR
;
5904 state
.mstate
<- Mpan
(x, y)
5907 state
.mstate
<- Mnone
5912 if Wsi.withshift mask
5914 annot (not
(Wsi.withctrl mask
)) x y;
5915 G.postRedisplay "addannot"
5919 Wsi.setcursor
Wsi.CURSOR_CYCLE
;
5920 state
.mstate
<- Mzoomrect
(p, p)
5923 match state
.mstate
with
5924 | Mzoomrect
((x0, y0), _) ->
5925 if abs
(x-x0) > 10 && abs
(y - y0) > 10
5926 then zoomrect x0 y0 x y
5929 G.postRedisplay "kill accidental zoom rect";
5933 | Mscrolly
| Mscrollx
5939 | 1 when x > state
.winw - vscrollw () ->
5942 let _, position, sh = state
.uioh#
scrollph in
5943 if y > truncate
position && y < truncate
(position +. sh)
5944 then state
.mstate
<- Mscrolly
5947 state
.mstate
<- Mnone
5949 | 1 when y > state
.winh
- hscrollh () ->
5952 let _, position, sw = state
.uioh#scrollpw
in
5953 if x > truncate
position && x < truncate
(position +. sw)
5954 then state
.mstate
<- Mscrollx
5957 state
.mstate
<- Mnone
5959 | 1 when state
.bzoom
-> if not down
then zoomblock x y
5962 let dest = if down
then getunder x y else Unone
in
5963 begin match dest with
5966 | Uremote
_ | Uremotedest
_
5967 | Uunexpected
_ | Ulaunch
_ | Unamed
_ ->
5970 | Unone
when down
->
5971 Wsi.setcursor
Wsi.CURSOR_CROSSHAIR
;
5972 state
.mstate
<- Mpan
(x, y);
5974 | Uannotation
(opaque, slinkindex
) -> enterannotmode opaque slinkindex
5976 | Unone
| Utext
_ ->
5981 state
.mstate
<- Msel
((x, y), (x, y));
5982 G.postRedisplay "mouse select";
5986 match state
.mstate
with
5989 | Mzoom
_ | Mscrollx
| Mscrolly
->
5990 state
.mstate
<- Mnone
5992 | Mzoomrect
((x0, y0), _) ->
5996 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
5997 state
.mstate
<- Mnone
5999 | Msel
((x0, y0), (x1, y1)) ->
6000 let rec loop = function
6004 let a0 = l.pagedispy in
6005 let a1 = a0 + l.pagevh in
6006 let b0 = l.pagedispx in
6007 let b1 = b0 + l.pagevw in
6008 ((y0 >= a0 && y0 <= a1) || (y1 >= a0 && y1 <= a1))
6009 && ((x0 >= b0 && x0 <= b1) || (x1 >= b0 && x1 <= b1))
6013 match getopaque l.pageno with
6016 match Unix.pipe
() with
6020 "can not create sel pipe: %s"
6024 Ne.clo fd
(fun msg
->
6025 dolog
"%s close failed: %s" what msg
)
6028 try popen
cmd [r
, 0; w, -1]
6030 dolog
"can not execute %S: %s"
6037 G.postRedisplay "copysel";
6039 else clo "Msel pipe/w" w;
6040 clo "Msel pipe/r" r
;
6042 dosel conf
.selcmd
();
6043 state
.roam
<- dosel conf
.paxcmd
;
6055 let birdseyemouse button down
x y mask
6056 (conf
, leftx
, _, hooverpageno
, anchor) =
6059 let rec loop = function
6062 if y > l.pagedispy && y < l.pagedispy + l.pagevh
6063 && x > l.pagedispx && x < l.pagedispx + l.pagevw
6065 leavebirdseye (conf
, leftx
, l.pageno, hooverpageno
, anchor) false;
6071 | _ -> viewmouse button down
x y mask
6077 method key key mask
=
6078 begin match state
.mode with
6079 | Textentry
textentry -> textentrykeyboard key mask
textentry
6080 | Birdseye
birdseye -> birdseyekeyboard key mask
birdseye
6081 | View
-> viewkeyboard key mask
6082 | LinkNav
linknav -> linknavkeyboard key mask
linknav
6086 method button button bstate
x y mask
=
6087 begin match state
.mode with
6089 | View
-> viewmouse button bstate
x y mask
6090 | Birdseye beye
-> birdseyemouse button bstate
x y mask beye
6095 method multiclick clicks
x y mask
=
6096 begin match state
.mode with
6098 | View
-> viewmulticlick clicks
x y mask
6105 begin match state
.mode with
6107 | View
| Birdseye
_ | LinkNav
_ ->
6108 match state
.mstate
with
6109 | Mzoom
_ | Mnone
-> ()
6114 state
.mstate
<- Mpan
(x, y);
6116 then state
.x <- panbound (state
.x + dx);
6118 gotoy_and_clear_text y
6121 state
.mstate
<- Msel
(a, (x, y));
6122 G.postRedisplay "motion select";
6125 let y = min state
.winh
(max
0 y) in
6129 let x = min state
.winw (max
0 x) in
6132 | Mzoomrect
(p0
, _) ->
6133 state
.mstate
<- Mzoomrect
(p0
, (x, y));
6134 G.postRedisplay "motion zoomrect";
6138 method pmotion
x y =
6139 begin match state
.mode with
6140 | Birdseye
(conf
, leftx
, pageno, hooverpageno
, anchor) ->
6141 let rec loop = function
6143 if hooverpageno
!= -1
6145 state
.mode <- Birdseye
(conf
, leftx
, pageno, -1, anchor);
6146 G.postRedisplay "pmotion birdseye no hoover";
6149 if y > l.pagedispy && y < l.pagedispy + l.pagevh
6150 && x > l.pagedispx && x < l.pagedispx + l.pagevw
6152 state
.mode <- Birdseye
(conf
, leftx
, pageno, l.pageno, anchor);
6153 G.postRedisplay "pmotion birdseye hoover";
6163 match state
.mstate
with
6164 | Mpan
_ | Msel
_ | Mzoom
_ | Mscrolly
| Mscrollx
| Mzoomrect
_ -> ()
6172 let past, _, _ = !r
in
6174 let delta = now -. past in
6177 else r
:= (now, x, y)
6181 method infochanged
_ = ()
6184 let maxy = state
.maxy - (if conf
.maxhfit
then state
.winh
else 0) in
6187 then 0.0, float state
.winh
6188 else scrollph state
.y maxy
6193 let winw = wadjsb () + state
.winw in
6194 let fwinw = float winw in
6196 let sw = fwinw /. float state
.w in
6197 let sw = fwinw *. sw in
6198 max
sw (float conf
.scrollh
)
6201 let maxx = state
.w + winw in
6202 let x = winw - state
.x in
6203 let percent = float x /. float maxx in
6204 (fwinw -. sw) *. percent
6206 hscrollh (), position, sw
6210 match state
.mode with
6211 | LinkNav
_ -> "links"
6212 | Textentry
_ -> "textentry"
6213 | Birdseye
_ -> "birdseye"
6216 findkeyhash conf
modename
6218 method eformsgs
= true
6219 method alwaysscrolly
= false
6222 let adderrmsg src msg
=
6223 Buffer.add_string state
.errmsgs msg
;
6224 state
.newerrmsgs
<- true;
6228 let adderrfmt src fmt
=
6229 Format.ksprintf
(fun s -> adderrmsg src s) fmt
;
6233 let cl = splitatspace cmds
in
6235 try Scanf.sscanf
s fmt
f
6237 adderrfmt "remote exec"
6238 "error processing '%S': %s\n" cmds
(exntos exn
)
6241 | "reload" :: [] -> reload ()
6242 | "goto" :: args
:: [] ->
6243 scan args
"%u %f %f"
6245 let cmd, _ = state
.geomcmds
in
6247 then gotopagexy pageno x y
6250 gotopagexy pageno x y;
6253 state
.reprf
<- f state
.reprf
6255 | "goto1" :: args
:: [] -> scan args
"%u %f" gotopage
6256 | "gotor" :: args
:: [] ->
6258 (fun filename
pageno -> gotounder (Uremote
(filename
, pageno)))
6259 | "gotord" :: args
:: [] ->
6261 (fun filename
dest -> gotounder (Uremotedest
(filename
, dest)))
6262 | "rect" :: args
:: [] ->
6263 scan args
"%u %u %f %f %f %f"
6264 (fun pageno color x0 y0 x1 y1 ->
6265 onpagerect pageno (fun w h ->
6266 let _,w1,h1
,_ = getpagedim
pageno in
6267 let sw = float w1 /. float w
6268 and sh = float h1
/. float h in
6272 and y1s
= y1 *. sh in
6273 let rect = (x0s,y0s
,x1s
,y0s
,x1s
,y1s
,x0s,y1s
) in
6275 state
.rects <- (pageno, color, rect) :: state
.rects;
6276 G.postRedisplay "rect";
6279 | "activatewin" :: [] -> Wsi.activatewin
()
6280 | "quit" :: [] -> raise Quit
6282 adderrfmt "remote command"
6283 "error processing remote command: %S\n" cmds
;
6287 let scratch = Bytes.create
80 in
6288 let buf = Buffer.create
80 in
6291 try Some
(Unix.read fd
scratch 0 80)
6293 | Unix.Unix_error
(Unix.EAGAIN
, _, _) -> None
6294 | Unix.Unix_error
(Unix.EINTR
, _, _) -> tempfr ()
6297 match tempfr () with
6303 if Buffer.length
buf > 0
6305 let s = Buffer.contents
buf in
6315 let pos = Bytes.index_from
scratch ppos '
\n'
in
6316 if pos >= n then -1 else pos
6317 with Not_found
-> -1
6321 Buffer.add_subbytes
buf scratch ppos
(nlpos-ppos
);
6322 let s = Buffer.contents
buf in
6328 Buffer.add_subbytes
buf scratch ppos
(n-ppos
);
6334 let remoteopen path =
6335 try Some
(Unix.openfile
path [Unix.O_NONBLOCK
; Unix.O_RDONLY
] 0o0)
6337 adderrfmt "remoteopen" "error opening %S: %s" path (exntos exn
);
6342 let gcconfig = ref E.s in
6343 let trimcachepath = ref E.s in
6344 let rcmdpath = ref E.s in
6345 let pageno = ref None
in
6346 let rootwid = ref 0 in
6347 let openlast = ref false in
6348 let nofc = ref false in
6349 let doreap = ref false in
6350 selfexec := Sys.executable_name
;
6353 [("-p", Arg.String
(fun s -> state
.password <- s),
6354 "<password> Set password");
6358 Config.fontpath
:= s;
6359 selfexec := !selfexec ^
" -f " ^
Filename.quote
s;
6361 "<path> Set path to the user interface font");
6365 selfexec := !selfexec ^
" -c " ^
Filename.quote
s;
6366 Config.confpath
:= s),
6367 "<path> Set path to the configuration file");
6369 ("-last", Arg.Set
openlast, " Open last document");
6371 ("-page", Arg.Int
(fun pageno1
-> pageno := Some
(pageno1
-1)),
6372 "<page-number> Jump to page");
6374 ("-tcf", Arg.String
(fun s -> trimcachepath := s),
6375 "<path> Set path to the trim cache file");
6377 ("-dest", Arg.String
(fun s -> state
.nameddest
<- s),
6378 "<named-destination> Set named destination");
6380 ("-wtmode", Arg.Set
wtmode, " Operate in wt mode");
6381 ("-cxack", Arg.Set
cxack, " Cut corners");
6383 ("-remote", Arg.String
(fun s -> rcmdpath := s),
6384 "<path> Set path to the remote commands source");
6386 ("-origin", Arg.String
(fun s -> state
.origin
<- s),
6387 "<original-path> Set original path");
6389 ("-gc", Arg.Set_string
gcconfig,
6390 "<script-path> Collect garbage with the help of a script");
6392 ("-nofc", Arg.Set
nofc, " Do not use fontconfig");
6394 ("-v", Arg.Unit
(fun () ->
6396 "%s\nconfiguration path: %s\n"
6400 exit
0), " Print version and exit");
6402 ("-embed", Arg.Set_int
rootwid,
6403 "<window-id> Embed into window")
6406 (fun s -> state
.path <- s)
6407 ("Usage: " ^
Sys.argv
.(0) ^
" [options] some.pdf\nOptions:")
6410 then selfexec := !selfexec ^
" -wtmode";
6412 let histmode = emptystr state
.path && not
!openlast in
6414 if not
(Config.load !openlast)
6415 then prerr_endline
"failed to load configuration";
6416 begin match !pageno with
6417 | Some
pageno -> state
.anchor <- (pageno, 0.0, 0.0)
6421 if not
(emptystr
!gcconfig)
6424 match Unix.socketpair
Unix.PF_UNIX
Unix.SOCK_STREAM
0 with
6426 error
"gc socketpair failed: %s" (exntos exn
)
6429 match addpid
@@ popen
!gcconfig [(c, 0); (c, 1)] with
6431 error
"failed to popen gc script: %s" (exntos exn
);
6437 let wsfd, winw, winh
= Wsi.init
(object (self)
6438 val mutable m_clicks
= 0
6439 val mutable m_click_x
= 0
6440 val mutable m_click_y
= 0
6441 val mutable m_lastclicktime
= infinity
6443 method private cleanup =
6444 state
.roam
<- noroam
;
6445 Hashtbl.iter
(fun _ opaque -> clearmark
opaque) state
.pagemap
6446 method expose
= G.postRedisplay"expose"
6450 | Wsi.Unobscured
-> "unobscured"
6451 | Wsi.PartiallyObscured
-> "partiallyobscured"
6452 | Wsi.FullyObscured
-> "fullyobscured"
6454 vlog "visibility change %s" name
6455 method display = display ()
6456 method map mapped
= vlog "mappped %b" mapped
6457 method reshape w h =
6460 method mouse
b d x y m =
6461 if d && canselect ()
6463 (* http://blogs.msdn.com/b/oldnewthing/archive/2004/10/18/243925.aspx *)
6469 if abs
x - m_click_x
> 10
6470 || abs
y - m_click_y
> 10
6471 || abs_float
(t -. m_lastclicktime
) > 0.3
6473 m_clicks
<- m_clicks
+ 1;
6474 m_lastclicktime
<- t;
6478 G.postRedisplay "cleanup";
6479 state
.uioh <- state
.uioh#button
b d x y m;
6481 else state
.uioh <- state
.uioh#multiclick m_clicks
x y m
6486 m_lastclicktime
<- infinity
;
6487 state
.uioh <- state
.uioh#button
b d x y m
6491 state
.uioh <- state
.uioh#button
b d x y m
6494 state
.mpos
<- (x, y);
6495 state
.uioh <- state
.uioh#motion
x y
6496 method pmotion
x y =
6497 state
.mpos
<- (x, y);
6498 state
.uioh <- state
.uioh#pmotion
x y
6500 let mascm = m land (
6501 Wsi.altmask
+ Wsi.shiftmask
+ Wsi.ctrlmask
+ Wsi.metamask
6504 let x = state
.x and y = state
.y in
6506 if x != state
.x || y != state
.y then self#
cleanup
6508 match state
.keystate
with
6510 let km = k
, mascm in
6513 let modehash = state
.uioh#
modehash in
6514 try Hashtbl.find modehash km
6516 try Hashtbl.find (findkeyhash conf
"global") km
6517 with Not_found
-> KMinsrt
(k
, m)
6519 | KMinsrt
(k
, m) -> keyboard k
m
6520 | KMinsrl
l -> List.iter
(fun (k
, m) -> keyboard k
m) l
6521 | KMmulti
(l, r
) -> state
.keystate
<- KSinto
(l, r
)
6523 | KSinto
((k'
, m'
) :: [], insrt
) when k'
=k
&& m'
land mascm = m'
->
6524 List.iter
(fun (k
, m) -> keyboard k
m) insrt
;
6525 state
.keystate
<- KSnone
6526 | KSinto
((k'
, m'
) :: keys, insrt
) when k'
=k
&& m'
land mascm = m'
->
6527 state
.keystate
<- KSinto
(keys, insrt
)
6528 | KSinto
_ -> state
.keystate
<- KSnone
6531 state
.mpos
<- (x, y);
6532 state
.uioh <- state
.uioh#pmotion
x y
6533 method leave = state
.mpos
<- (-1, -1)
6534 method winstate wsl
= state
.winstate
<- wsl
6535 method quit
= raise Quit
6536 end) !rootwid conf
.cwinw conf
.cwinh platform
in
6541 List.exists
GlMisc.check_extension
6542 [ "GL_ARB_texture_rectangle"
6543 ; "GL_EXT_texture_recangle"
6544 ; "GL_NV_texture_rectangle" ]
6546 then (prerr_endline
"OpenGL does not suppport rectangular textures"; exit
1);
6549 let r = GlMisc.get_string `renderer
in
6550 let p = "Mesa DRI Intel(" in
6551 let l = String.length
p in
6552 String.length
r > l && String.sub
r 0 l = p
6555 defconf
.sliceheight
<- 1024;
6556 defconf
.texcount
<- 32;
6557 defconf
.usepbo
<- true;
6561 match Unix.socketpair
Unix.PF_UNIX
Unix.SOCK_STREAM
0 with
6563 Printf.eprintf
"socketpair failed: %s" (exntos exn
);
6571 setcheckers conf
.checkers
;
6573 if conf
.redirectstderr
6577 (Buffer.to_bytes state
.errmsgs
)
6578 (match state
.errfd
with
6580 let s = Bytes.create
(80*24) in
6583 let r, _, _ = Unix.select
[fd
] [] [] 0.0 in
6585 then Unix.read fd
s 0 (Bytes.length
s)
6591 else Bytes.sub
s 0 n
6595 try ignore
(Unix.write state
.stderr
s 0 (Bytes.length
s))
6596 with exn
-> print_endline
(exntos exn
)
6601 conf
.angle
, conf
.fitmodel
, (conf
.trimmargins
, conf
.trimfuzz
),
6602 conf
.texcount
, conf
.sliceheight
, conf
.mustoresize
, conf
.colorspace
,
6603 !Config.fontpath
, !trimcachepath,
6604 GlMisc.check_extension
"GL_ARB_pixel_buffer_object",
6607 List.iter
GlArray.enable
[`texture_coord
; `vertex
];
6613 Wsi.settitle
"llpp (history)";
6617 state
.text <- "Opening " ^
(mbtoutf8 state
.path);
6618 opendoc state
.path state
.password;
6622 Sys.set_signal
Sys.sighup
(Sys.Signal_handle
(fun _ -> reload ()));
6625 match Unix.waitpid
[Unix.WNOHANG
] ~
-1 with
6626 | (exception (Unix.Unix_error
(Unix.ECHILD
, _, _))) -> ()
6627 | (exception exn
) -> dolog
"Unix.waitpid: %s" @@ exntos exn
6629 | _pid
, _status
-> reap ()
6631 Sys.set_signal
Sys.sigchld
(Sys.Signal_handle
(fun _ -> doreap := true));
6635 if nonemptystr
!rcmdpath
6636 then remoteopen !rcmdpath
6641 let rec loop deadline
=
6648 match state
.errfd
with
6649 | None
-> [state
.ss; state
.wsfd]
6650 | Some fd
-> [state
.ss; state
.wsfd; fd
]
6655 | Some fd
-> fd
:: r
6659 state
.redisplay
<- false;
6666 if deadline
= infinity
6668 else max
0.0 (deadline
-. now)
6673 try Unix.select
r [] [] timeout
6674 with Unix.Unix_error
(Unix.EINTR
, _, _) -> [], [], []
6680 if state
.ghyll
== noghyll
6682 match state
.autoscroll
with
6683 | Some step
when step
!= 0 ->
6684 let y = state
.y + step
in
6688 else if y >= state
.maxy then 0 else y
6691 if state
.mode = View
6692 then state
.text <- E.s;
6695 else deadline
+. 0.01
6700 let rec checkfds = function
6702 | fd
:: rest
when fd
= state
.ss ->
6703 let cmd = readcmd state
.ss in
6707 | fd
:: rest
when fd
= state
.wsfd ->
6711 | fd
:: rest
when Some fd
= !optrfd ->
6712 begin match remote fd
with
6713 | None
-> optrfd := remoteopen !rcmdpath;
6714 | opt -> optrfd := opt
6719 let s = Bytes.create
80 in
6720 let n = tempfailureretry
(Unix.read fd
s 0) 80 in
6721 if conf
.redirectstderr
6723 Buffer.add_substring state
.errmsgs
(Bytes.to_string
s) 0 n;
6724 state
.newerrmsgs
<- true;
6725 state
.redisplay
<- true;
6728 prerr_string
(String.sub
(Bytes.to_string
s) 0 n);
6734 if !reeenterhist then (
6736 reeenterhist := false;
6740 if deadline
= infinity
6744 match state
.autoscroll
with
6745 | Some step
when step
!= 0 -> deadline1
6746 | _ -> if state
.ghyll
== noghyll
then infinity
else deadline1
6754 Config.save leavebirdseye;
6755 if hasunsavedchanges
()