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 hasunsavedchanges
: unit -> bool = "ml_hasunsavedchanges";;
41 external savedoc
: string -> unit = "ml_savedoc";;
43 let reeenterhist = ref false;;
44 let selfexec = ref E.s
;;
46 let drawstring size x y s
=
48 Gl.enable `texture_2d
;
49 GlFunc.blend_func ~src
:`src_alpha ~dst
:`one_minus_src_alpha
;
50 ignore
(drawstr size x y s
);
52 Gl.disable `texture_2d
;
55 let drawstring1 size x y s
=
59 let drawstring2 size x y fmt
=
60 Printf.kprintf
(drawstring size
(x
+1) (y
+size
+1)) fmt
64 dolog
"l %d dim=%d {" l
.pageno l
.pagedimno
;
65 dolog
" WxH %dx%d" l
.pagew l
.pageh
;
66 dolog
" vWxH %dx%d" l
.pagevw l
.pagevh
;
67 dolog
" pagex,y %d,%d" l
.pagex l
.pagey
;
68 dolog
" dispx,y %d,%d" l
.pagedispx l
.pagedispy
;
69 dolog
" column %d" l
.pagecol
;
73 let debugrect (x0
, y0
, x1
, y1
, x2
, y2
, x3
, y3
) =
75 dolog
" x0,y0=(% f, % f)" x0 y0
;
76 dolog
" x1,y1=(% f, % f)" x1 y1
;
77 dolog
" x2,y2=(% f, % f)" x2 y2
;
78 dolog
" x3,y3=(% f, % f)" x3 y3
;
82 let isbirdseye = function
89 let istextentry = function
96 let wtmode = ref false;;
97 let cxack = ref false;;
99 let pgscale h
= truncate
(float h
*. conf
.pgscale);;
102 if not state
.uioh#alwaysscrolly
&& (conf
.scrollb
land scrollbhv
= 0)
103 || (state
.x
= 0 && state
.w
<= state
.winw
- conf
.scrollbw
)
109 if not state
.uioh#alwaysscrolly
&& (conf
.scrollb
land scrollbvv
= 0)
114 let wadjsb () = -vscrollw ();;
115 let xadjsb () = if conf
.leftscroll
then vscrollw () else 0;;
118 fstate
.fontsize
<- n
;
119 fstate
.wwidth
<- measurestr fstate
.fontsize
"w";
120 fstate
.maxrows
<- (state
.winh
- fstate
.fontsize
- 1) / (fstate
.fontsize
+ 1);
126 Printf.kprintf prerr_endline fmt
128 Printf.kprintf ignore fmt
131 let addpid pid
= if pid
> 0 then incr pidcount
;;
134 let re = Str.regexp
"%s" in
136 if emptystr conf
.pathlauncher
137 then print_endline state
.path
139 let command = Str.global_replace
re 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
266 | Uannotation _
-> Some
under
268 onppundermouse g x y Unone
273 match unproject opaque
x y with
274 | Some
(x, y) -> Some
(Some
(opaque
, l
.pageno
, x, y))
277 onppundermouse g x y None
;
281 state
.text
<- Printf.sprintf
"%c%s" c s
;
282 G.postRedisplay "showtext";
285 let pipesel opaque cmd
=
288 match Unix.pipe
() with
291 (Printf.sprintf
"pipesel can not create pipe: %s" (exntos exn
));
293 let doclose what fd
=
294 Ne.clo fd
(fun msg
-> dolog
"%s close failed: %s" what msg
)
297 try popen cmd
[r
, 0; w
, -1]
299 dolog
"can not execute %S: %s" cmd
(exntos exn
);
306 G.postRedisplay "pipesel";
308 else doclose "pipesel pipe/w" w
;
309 doclose "pipesel pipe/r" r
;
313 let g opaque l
px py
=
314 if markunder opaque
px py conf
.paxmark
317 match getopaque l
.pageno
with
319 | Some opaque
-> pipesel opaque conf
.paxcmd
324 G.postRedisplay "paxunder";
325 if conf
.paxmark
= Mark_page
328 match getopaque l
.pageno
with
330 | Some opaque
-> clearmark opaque
) state
.layout
;
332 onppundermouse g x y (fun () -> showtext '
!'
"Whoopsie daisy");
336 match Unix.pipe
() with
338 showtext '
!'
(Printf.sprintf
"pipe failed: %s" (exntos exn
))
341 Ne.clo fd
(fun msg
->
342 showtext '
!'
(Printf.sprintf
"failed to close %s: %s" cap msg
)
346 try popen conf
.selcmd
[r
, 0; w
, -1]
349 (Printf.sprintf
"failed to execute %s: %s"
350 conf
.selcmd
(exntos exn
));
357 let l = String.length s
in
358 let bytes = Bytes.unsafe_of_string s
in
359 let n = tempfailureretry
(Unix.write w
bytes 0) l in
364 "failed to write %d characters to sel pipe, wrote %d"
369 (Printf.sprintf
"failed to write to sel pipe: %s"
374 clo "selstring pipe/r" r
;
375 clo "selstring pipe/w" w
;
378 let undertext = function
381 | Ulinkgoto
(pageno
, _
) -> Printf.sprintf
"%s: page %d" state
.path
(pageno
+1)
382 | Utext s
-> "font: " ^ s
383 | Uunexpected s
-> "unexpected: " ^ s
384 | Ulaunch s
-> "launch: " ^ s
385 | Unamed s
-> "named: " ^ s
386 | Uremote
(filename
, pageno
) ->
387 Printf.sprintf
"%s: page %d" filename
(pageno
+1)
388 | Uremotedest
(filename
, destname
) ->
389 Printf.sprintf
"%s: destination %S" filename destname
390 | Uannotation contents
->
391 Printf.sprintf
"annotation " ^ contents
394 let updateunder x y =
395 match getunder x y with
396 | Unone
-> Wsi.setcursor
Wsi.CURSOR_INHERIT
398 if conf
.underinfo
then showtext 'u'
("ri: " ^ uri
);
399 Wsi.setcursor
Wsi.CURSOR_INFO
400 | Ulinkgoto
(pageno
, _
) ->
402 then showtext 'p'
("age: " ^ string_of_int
(pageno
+1));
403 Wsi.setcursor
Wsi.CURSOR_INFO
405 if conf
.underinfo
then showtext '
f'
("ont: " ^ s
);
406 Wsi.setcursor
Wsi.CURSOR_TEXT
408 if conf
.underinfo
then showtext 'u'
("nexpected: " ^ s
);
409 Wsi.setcursor
Wsi.CURSOR_INHERIT
411 if conf
.underinfo
then showtext '
l'
("aunch: " ^ s
);
412 Wsi.setcursor
Wsi.CURSOR_INHERIT
414 if conf
.underinfo
then showtext '
n'
("amed: " ^ s
);
415 Wsi.setcursor
Wsi.CURSOR_INHERIT
416 | Uremote
(filename
, pageno
) ->
417 if conf
.underinfo
then showtext 'r'
418 (Printf.sprintf
"emote: %s (%d)" filename
(pageno
+1));
419 Wsi.setcursor
Wsi.CURSOR_INFO
420 | Uremotedest
(filename
, destname
) ->
421 if conf
.underinfo
then showtext 'r'
422 (Printf.sprintf
"emote destination: %s (%S)" filename destname
);
423 Wsi.setcursor
Wsi.CURSOR_INFO
425 if conf
.underinfo
then showtext 'a'
"nnotation";
426 Wsi.setcursor
Wsi.CURSOR_INFO
429 let showlinktype under =
443 let s = undertext under in
448 let b = Buffer.create
(String.length
s + 1) in
449 Buffer.add_string
b s;
454 let intentry_with_suffix text key
=
456 if key
>= 32 && key
< 127
460 match Char.lowercase
c with
462 let text = addchar text c in
466 let text = addchar text c in
470 state
.text <- Printf.sprintf
"invalid char (%d, `%c')" key
c;
475 let s = Bytes.create
4 in
476 let n = tempfailureretry
(Unix.read fd
s 0) 4 in
477 if n != 4 then error
"incomplete read(len) = %d" n;
478 let len = (Char.code
(Bytes.get
s 0) lsl 24)
479 lor (Char.code
(Bytes.get
s 1) lsl 16)
480 lor (Char.code
(Bytes.get
s 2) lsl 8)
481 lor (Char.code
(Bytes.get
s 3))
483 let s = Bytes.create
len in
484 let n = tempfailureretry
(Unix.read fd
s 0) len in
485 if n != len then error
"incomplete read(data) %d vs %d" n len;
489 let btod b = if b then 1 else 0;;
492 let b = Buffer.create
16 in
493 Buffer.add_string
b "llll";
496 let s = Buffer.to_bytes
b in
497 let n = Bytes.length
s in
499 (* dolog "wcmd %S" (String.sub s 4 len); *)
500 Bytes.set
s 0 (Char.chr
((len lsr 24) land 0xff));
501 Bytes.set
s 1 (Char.chr
((len lsr 16) land 0xff));
502 Bytes.set
s 2 (Char.chr
((len lsr 8) land 0xff));
503 Bytes.set
s 3 (Char.chr
(len land 0xff));
504 let n'
= tempfailureretry
(Unix.write state
.ss
s 0) n in
505 if n'
!= n then error
"write failed %d vs %d" n'
n;
509 let nogeomcmds cmds
=
511 | s, [] -> emptystr
s
515 let layoutN ((columns
, coverA
, coverB
), b) y sh
=
516 let sh = sh - (hscrollh ()) in
517 let wadj = wadjsb () in
518 let rec fold accu
n =
519 if n = Array.length
b
522 let pdimno, dx, vy
, (_
, w
, h
, xoff
) = b.(n) in
525 || n = state
.pagecount
- coverB
526 || (n - coverA
) mod columns
= columns
- 1)
532 let pagey = max
0 (y - vy
) in
533 let pagedispy = if pagey > 0 then 0 else vy
- y in
534 let pagedispx, pagex
=
536 if n = coverA
- 1 || n = state
.pagecount
- coverB
537 then state
.x + (wadj + state
.winw
- w
) / 2
538 else dx + xoff
+ state
.x
545 let vw = wadj + state
.winw
- pagedispx in
546 let pw = w
- pagex
in
549 let pagevh = min
(h
- pagey) (sh - pagedispy) in
550 if pagevw > 0 && pagevh > 0
561 ; pagedispx = pagedispx
562 ; pagedispy = pagedispy
574 if Array.length
b = 0
576 else List.rev
(fold [] (page_of_y
y))
579 let layoutS (columns
, b) y sh =
580 let sh = sh - hscrollh () in
581 let wadj = wadjsb () in
582 let rec fold accu n =
583 if n = Array.length
b
586 let pdimno, px, vy
, (_
, pagew
, pageh
, xoff
) = b.(n) in
593 let x = xoff
+ state
.x in
594 let pagey = max
0 (y - vy
) in
595 let pagedispy = if pagey > 0 then 0 else vy
- y in
596 let pagedispx, pagex
=
610 let pagecolw = pagew
/columns
in
612 if pagecolw < state
.winw
613 then pagedispx + ((wadj + state
.winw
- pagecolw) / 2)
617 let vw = wadj + state
.winw
- pagedispx in
618 let pw = pagew
- pagex
in
621 let pagevw = min
pagevw pagecolw in
622 let pagevh = min
(pageh
- pagey) (sh - pagedispy) in
623 if pagevw > 0 && pagevh > 0
634 ; pagedispx = pagedispx
635 ; pagedispy = pagedispy
636 ; pagecol
= n mod columns
651 if nogeomcmds state
.geomcmds
653 match conf
.columns
with
654 | Csingle
b -> layoutN ((1, 0, 0), b) y sh
655 | Cmulti
c -> layoutN c y sh
656 | Csplit
s -> layoutS s y sh
661 let y = state
.y + incr
in
663 let y = min
y (state
.maxy
- (if conf
.maxhfit
then state
.winh
else 0)) in
668 let tilex = l.pagex
mod conf
.tilew
in
669 let tiley = l.pagey mod conf
.tileh
in
671 let col = l.pagex
/ conf
.tilew
in
672 let row = l.pagey / conf
.tileh
in
674 let xadj = xadjsb () in
675 let rec rowloop row y0 dispy h
=
679 let dh = conf
.tileh
- y0 in
681 let rec colloop col x0 dispx w
=
685 let dw = conf
.tilew
- x0 in
687 let dispx'
= xadj + dispx in
688 f col row dispx' dispy
x0 y0 dw dh;
689 colloop (col+1) 0 (dispx+dw) (w
-dw)
692 colloop col tilex l.pagedispx l.pagevw;
693 rowloop (row+1) 0 (dispy
+dh) (h
-dh)
696 if l.pagevw > 0 && l.pagevh > 0
697 then rowloop row tiley l.pagedispy l.pagevh;
700 let gettileopaque l col row =
702 l.pageno
, state
.gen
, conf
.colorspace
, conf
.angle
, l.pagew
, l.pageh
, col, row
704 try Some
(Hashtbl.find state
.tilemap
key)
705 with Not_found
-> None
708 let puttileopaque l col row gen colorspace angle opaque size elapsed
=
709 let key = l.pageno
, gen
, colorspace
, angle
, l.pagew
, l.pageh
, col, row in
710 Hashtbl.add state
.tilemap
key (opaque
, size
, elapsed
)
713 let filledrect x0 y0 x1 y1 =
714 GlArray.disable `texture_coord
;
715 Raw.sets_float state
.vraw ~pos
:0 [| x0; y0; x0; y1; x1; y0; x1; y1 |];
716 GlArray.vertex `two state
.vraw
;
717 GlArray.draw_arrays `triangle_strip ~first
:0 ~count
:4;
718 GlArray.enable `texture_coord
;
721 let linerect x0 y0 x1 y1 =
722 GlArray.disable `texture_coord
;
723 Raw.sets_float state
.vraw ~pos
:0 [| x0; y0; x0; y1; x1; y1; x1; y0 |];
724 GlArray.vertex `two state
.vraw
;
725 GlArray.draw_arrays `line_loop ~first
:0 ~count
:4;
726 GlArray.enable `texture_coord
;
729 let drawtiles l color
=
731 let wadj = wadjsb () in
733 let f col row x y tilex tiley w h
=
734 match gettileopaque l col row with
735 | Some
(opaque
, _
, t
) ->
736 let params = x, y, w
, h
, tilex, tiley in
738 then GlTex.env
(`mode `blend
);
739 drawtile
params opaque
;
741 then GlTex.env
(`mode `modulate
);
745 let s = Printf.sprintf
749 let w = measurestr fstate
.fontsize
s in
750 GlDraw.color
(0.0, 0.0, 0.0);
751 filledrect (float (x-2))
754 (float (y + fstate
.fontsize
+ 2));
755 GlDraw.color
(1.0, 1.0, 1.0);
756 drawstring fstate
.fontsize
x (y + fstate
.fontsize
- 1) s;
766 let lw = wadj + state
.winw
- x in
769 let lh = state
.winh
- y in
773 then GlTex.env
(`mode `blend
);
774 begin match state
.checkerstexid
with
776 Gl.enable `texture_2d
;
777 GlTex.bind_texture ~target
:`texture_2d id
;
781 and y1 = float (y+h
) in
783 let tw = float w /. 16.0
784 and th
= float h
/. 16.0 in
785 let tx0 = float tilex /. 16.0
786 and ty0
= float tiley /. 16.0 in
788 and ty1
= ty0
+. th
in
789 Raw.sets_float state
.vraw ~pos
:0
790 [| x0; y0; x0; y1; x1; y0; x1; y1 |];
791 Raw.sets_float state
.traw ~pos
:0
792 [| tx0; ty0
; tx0; ty1
; tx1; ty0
; tx1; ty1
|];
793 GlArray.vertex `two state
.vraw
;
794 GlArray.tex_coord `two state
.traw
;
795 GlArray.draw_arrays `triangle_strip ~first
:0 ~count
:4;
796 Gl.disable `texture_2d
;
799 GlDraw.color
(1.0, 1.0, 1.0);
800 filledrect (float x) (float y) (float (x+w)) (float (y+h
));
803 then GlTex.env
(`mode `modulate
);
804 if w > 128 && h
> fstate
.fontsize
+ 10
806 let c = if conf
.invert
then 1.0 else 0.0 in
807 GlDraw.color
(c, c, c);
810 then (col*conf
.tilew
, row*conf
.tileh
)
813 drawstring2 fstate
.fontsize
x y "Loading %d [%d,%d]" l.pageno
c r
;
822 let pagevisible layout n = List.exists
(fun l -> l.pageno
= n) layout;;
824 let tilevisible1 l x y =
826 and ax1
= l.pagex
+ l.pagevw
828 and ay1
= l.pagey + l.pagevh in
832 let bx1 = min
(bx0 + conf
.tilew
) l.pagew
833 and by1
= min
(by0
+ conf
.tileh
) l.pageh
in
835 let rx0 = max
ax0 bx0
836 and ry0
= max ay0 by0
837 and rx1
= min ax1
bx1
838 and ry1
= min ay1 by1
in
840 let nonemptyintersection = rx1
> rx0 && ry1
> ry0
in
844 let tilevisible layout n x y =
845 let rec findpageinlayout m
= function
846 | l :: rest
when l.pageno
= n ->
847 tilevisible1 l x y || (
848 match conf
.columns
with
849 | Csplit
(c, _
) when c > m
-> findpageinlayout (m
+1) rest
854 | _
:: rest
-> findpageinlayout 0 rest
857 findpageinlayout 0 layout;
860 let tileready l x y =
861 tilevisible1 l x y &&
862 gettileopaque l (x/conf
.tilew
) (y/conf
.tileh
) != None
865 let tilepage n p
layout =
866 let rec loop = function
870 let f col row _ _ _ _ _ _
=
871 if state
.currently
= Idle
873 match gettileopaque l col row with
876 let x = col*conf
.tilew
877 and y = row*conf
.tileh
in
879 let w = l.pagew
- x in
883 let h = l.pageh
- y in
888 then getpbo
w h conf
.colorspace
891 wcmd "tile %s %d %d %d %d %s"
892 (~
> p
) x y w h (~
> pbo);
895 l, p
, conf
.colorspace
, conf
.angle
,
896 state
.gen
, col, row, conf
.tilew
, conf
.tileh
905 if nogeomcmds state
.geomcmds
909 let preloadlayout y =
910 let y = if y < state
.winh
then 0 else y - state
.winh
in
911 let h = state
.winh
*3 in
917 if state
.currently
!= Idle
922 begin match getopaque l.pageno
with
924 wcmd "page %d %d" l.pageno
l.pagedimno
;
925 state
.currently
<- Loading
(l, state
.gen
);
927 tilepage l.pageno opaque pages
;
932 if nogeomcmds state
.geomcmds
938 if conf
.preload && state
.currently
= Idle
939 then load (preloadlayout state
.y);
942 let layoutready layout =
943 let rec fold all ls
=
946 let seen = ref false in
947 let allvisible = ref true in
948 let foo col row _ _ _ _ _ _
=
950 allvisible := !allvisible &&
951 begin match gettileopaque l col row with
957 fold (!seen && !allvisible) rest
960 let alltilesvisible = fold true layout in
965 let y = bound
y 0 state
.maxy
in
966 let y, layout, proceed
=
967 match conf
.maxwait
with
968 | Some time
when state
.ghyll
== noghyll
->
969 begin match state
.throttle
with
971 let layout = layout y state
.winh
in
972 let ready = layoutready layout in
976 state
.throttle
<- Some
(layout, y, now
());
978 else G.postRedisplay "gotoy showall (None)";
980 | Some
(_
, _
, started
) ->
981 let dt = now
() -. started
in
984 state
.throttle
<- None
;
985 let layout = layout y state
.winh
in
987 G.postRedisplay "maxwait";
994 let layout = layout y state
.winh
in
995 if not
!wtmode || layoutready layout
996 then G.postRedisplay "gotoy ready";
1002 state
.layout <- layout;
1003 begin match state
.mode
with
1006 | Ltexact
(pageno
, linkno
) ->
1007 let rec loop = function
1009 state
.mode
<- LinkNav
(Ltgendir
0)
1010 | l :: _
when l.pageno
= pageno
->
1011 begin match getopaque pageno
with
1012 | None
-> state
.mode
<- LinkNav
(Ltnotready
(pageno
, 0))
1014 let x0, y0, x1, y1 = getlinkrect opaque linkno
in
1015 if not
(x0 >= l.pagex
&& x1 <= l.pagex
+ l.pagevw
1016 && y0 >= l.pagey && y1 <= l.pagey + l.pagevh)
1017 then state
.mode
<- LinkNav
(Ltgendir
0)
1019 | _
:: rest
-> loop rest
1022 | Ltnotready _
| Ltgendir _
-> ()
1028 begin match state
.mode
with
1029 | Birdseye
(conf
, leftx
, pageno
, hooverpageno
, anchor
) ->
1030 if not
(pagevisible layout pageno
)
1032 match state
.layout with
1035 state
.mode
<- Birdseye
(
1036 conf
, leftx
, l.pageno
, hooverpageno
, anchor
1041 | Ltnotready
(_
, dir
)
1044 let rec loop = function
1047 match getopaque l.pageno
with
1048 | None
-> Ltnotready
(l.pageno
, dir
)
1053 then LDfirstvisible
(l.pagex
, l.pagey, dir
)
1055 if dir
> 0 then LDfirst
else LDlast
1061 | Lnotfound
-> loop rest
1063 showlinktype (getlink opaque
n);
1064 Ltexact
(l.pageno
, n)
1068 state
.mode
<- LinkNav
linknav
1076 state
.ghyll
<- noghyll
;
1079 let mx, my
= state
.mpos
in
1084 let conttiling pageno opaque
=
1085 tilepage pageno opaque
1086 (if conf
.preload then preloadlayout state
.y else state
.layout)
1089 let gotoy_and_clear_text y =
1090 if not conf
.verbose
then state
.text <- E.s;
1094 let getanchory (n, top
, dtop
) =
1095 let y, h = getpageyh
n in
1096 if conf
.presentation
1098 let ips = calcips
h in
1099 y + truncate
(top
*.float h -. dtop
*.float ips) + ips;
1101 y + truncate
(top
*.float h -. dtop
*.float conf
.interpagespace
)
1104 let gotoanchor anchor
=
1105 gotoy (getanchory anchor
);
1109 cbput state
.hists
.nav
(getanchor
());
1113 let anchor = cbgetc state
.hists
.nav dir
in
1117 let gotoghyll1 single
y =
1118 let scroll f n a
b =
1119 (* http://devmaster.net/forums/topic/9796-ease-in-ease-out-algorithm/ *)
1121 let s x = 3.0*.x**2.0 -. 2.0*.x**3.0 in
1123 then s (float f /. float a
)
1126 then 1.0 -. s ((float (f-b) /. float (n-b)))
1132 let ins = float a
*. 0.5
1133 and outs
= float (n-b) *. 0.5 in
1135 ins +. outs
+. float ones
1137 let rec set nab
y sy
=
1138 let (_N
, _A
, _B
), y =
1141 let scl = if y > sy
then 2 else -2 in
1142 let _N, _
, _
= nab
in
1143 (_N,0,_N), y+conf
.scrollstep
*scl
1145 let sum = summa
_N _A _B
in
1146 let dy = float (y - sy
) in
1150 then state
.ghyll
<- noghyll
1153 let s = scroll n _N _A _B
in
1154 let y1 = y1 +. ((s *. dy) /. sum) in
1155 gotoy_and_clear_text (truncate
y1);
1156 state
.ghyll
<- gf (n+1) y1;
1160 | Some
y'
when single
-> set nab
y' state
.y
1161 | Some
y'
-> set (_N/2, 1, 1) y' state
.y
1163 gf 0 (float state
.y)
1166 match conf
.ghyllscroll
with
1167 | Some nab
when not conf
.presentation
->
1168 if state
.ghyll
== noghyll
1169 then set nab
y state
.y
1170 else state
.ghyll
(Some
y)
1172 gotoy_and_clear_text y
1175 let gotoghyll = gotoghyll1 false;;
1177 let gotopage n top
=
1178 let y, h = getpageyh
n in
1179 let y = y + (truncate
(top
*. float h)) in
1183 let gotopage1 n top
=
1184 let y = getpagey
n in
1189 let invalidate s f =
1194 match state
.geomcmds
with
1195 | ps
, [] when emptystr ps
->
1197 state
.geomcmds
<- s, [];
1200 state
.geomcmds
<- ps
, [s, f];
1202 | ps
, (s'
, _
) :: rest
when s'
= s ->
1203 state
.geomcmds
<- ps
, ((s, f) :: rest
);
1206 state
.geomcmds
<- ps
, ((s, f) :: cmds
);
1210 Hashtbl.iter
(fun _ opaque
->
1211 wcmd "freepage %s" (~
> opaque
);
1213 Hashtbl.clear state
.pagemap
;
1217 if not
(Queue.is_empty state
.tilelru
)
1219 Queue.iter
(fun (k
, p
, s) ->
1220 wcmd "freetile %s" (~
> p
);
1221 state
.memused
<- state
.memused
- s;
1222 Hashtbl.remove state
.tilemap k
;
1224 state
.uioh#infochanged Memused
;
1225 Queue.clear state
.tilelru
;
1231 let h = truncate
(float h*.conf
.zoom
) in
1232 let d = conf
.interpagespace
lsl (if conf
.presentation
then 1 else 0) in
1236 let opendoc path password
=
1238 state
.password
<- password
;
1239 state
.gen
<- state
.gen
+ 1;
1240 state
.docinfo
<- [];
1241 state
.outlines
<- [||];
1244 setaalevel conf
.aalevel
;
1246 if emptystr state
.origin
1250 Wsi.settitle
("llpp " ^
(mbtoutf8
(Filename.basename
titlepath)));
1251 wcmd "open %d %d %s\000%s\000" (btod !wtmode) (btod !cxack) path password
;
1252 invalidate "reqlayout"
1254 wcmd "reqlayout %d %d %d %s\000"
1255 conf
.angle
(FMTE.to_int conf
.fitmodel
)
1256 (stateh state
.winh
) state
.nameddest
1261 state
.anchor <- getanchor
();
1262 opendoc state
.path state
.password
;
1266 let c = c *. conf
.colorscale
in
1270 let scalecolor2 (r
, g, b) =
1271 (r
*. conf
.colorscale
, g *. conf
.colorscale
, b *. conf
.colorscale
);
1274 let docolumns columns
=
1275 let wadj = wadjsb () in
1278 let a = Array.make state
.pagecount
(-1, -1, -1, (-1, -1, -1, -1)) in
1279 let wadj = wadjsb () in
1280 let rec loop pageno
pdimno pdim
y ph pdims
=
1281 if pageno
= state
.pagecount
1284 let pdimno, ((_
, w, h, xoff
) as pdim
), pdims
=
1286 | ((pageno'
, _
, _
, _
) as pdim
) :: rest
when pageno'
= pageno
->
1287 pdimno+1, pdim
, rest
1291 let x = max
0 (((wadj + state
.winw
- w) / 2) - xoff
) in
1293 (if conf
.presentation
1294 then (if pageno
= 0 then calcips
h else calcips ph
+ calcips
h)
1295 else (if pageno
= 0 then 0 else conf
.interpagespace
)
1298 a.(pageno
) <- (pdimno, x, y, pdim
);
1299 loop (pageno
+1) pdimno pdim
(y + h) h pdims
1301 loop 0 ~
-1 (-1,-1,-1,-1) 0 0 state
.pdims
;
1302 conf
.columns
<- Csingle
a;
1304 | Cmulti
((columns
, coverA
, coverB
), _
) ->
1305 let a = Array.make state
.pagecount
(-1, -1, -1, (-1, -1, -1, -1)) in
1306 let rec loop pageno
pdimno pdim
x y rowh pdims
=
1307 let rec fixrow m
= if m
= pageno
then () else
1308 let (pdimno, x, y, ((_
, _
, h, _
) as pdim
)) = a.(m
) in
1311 let y = y + (rowh
- h) / 2 in
1312 a.(m
) <- (pdimno, x, y, pdim
);
1316 if pageno
= state
.pagecount
1317 then fixrow (((pageno
- 1) / columns
) * columns
)
1319 let pdimno, ((_
, w, h, xoff
) as pdim
), pdims
=
1321 | ((pageno'
, _
, _
, _
) as pdim
) :: rest
when pageno'
= pageno
->
1322 pdimno+1, pdim
, rest
1327 if pageno
= coverA
- 1 || pageno
= state
.pagecount
- coverB
1329 let x = (wadj + state
.winw
- w) / 2 in
1331 if conf
.presentation
then calcips
h else conf
.interpagespace
in
1332 x, y + ips + rowh
, h
1335 if (pageno
- coverA
) mod columns
= 0
1337 let x = max
0 (wadj + state
.winw
- state
.w) / 2 in
1339 if conf
.presentation
1341 let ips = calcips
h in
1342 y + (if pageno
= 0 then 0 else calcips rowh
+ ips)
1344 y + (if pageno
= 0 then 0 else conf
.interpagespace
)
1348 else x, y, max rowh
h
1352 if pageno
> 1 && (pageno
- coverA
) mod columns
= 0
1355 if pageno
= columns
&& conf
.presentation
1357 let ips = calcips rowh
in
1358 for i
= 0 to pred columns
1360 let (pdimno, x, y, pdim
) = a.(i
) in
1361 a.(i
) <- (pdimno, x, y+ips, pdim
)
1367 fixrow (pageno
- columns
);
1372 a.(pageno
) <- (pdimno, x, y, pdim
);
1373 let x = x + w + xoff
*2 + conf
.interpagespace
in
1374 loop (pageno
+1) pdimno pdim
x y rowh' pdims
1376 loop 0 ~
-1 (-1,-1,-1,-1) 0 0 0 state
.pdims
;
1377 conf
.columns
<- Cmulti
((columns
, coverA
, coverB
), a);
1380 let a = Array.make
(state
.pagecount
*c) (-1, -1, -1, (-1, -1, -1, -1)) in
1381 let rec loop pageno
pdimno pdim
y pdims
=
1382 if pageno
= state
.pagecount
1385 let pdimno, ((_
, w, h, _
) as pdim
), pdims
=
1387 | ((pageno'
, _
, _
, _
) as pdim
) :: rest
when pageno'
= pageno
->
1388 pdimno+1, pdim
, rest
1393 let rec loop1 n x y =
1394 if n = c then y else (
1395 a.(pageno
*c + n) <- (pdimno, x, y, pdim
);
1396 loop1 (n+1) (x+cw) (y + h + conf
.interpagespace
)
1399 let y = loop1 0 0 y in
1400 loop (pageno
+1) pdimno pdim
y pdims
1402 loop 0 ~
-1 (-1,-1,-1,-1) 0 state
.pdims
;
1403 conf
.columns
<- Csplit
(c, a);
1407 docolumns conf
.columns
;
1408 state
.maxy
<- calcheight
();
1409 if state
.reprf
== noreprf
1411 match state
.mode
with
1412 | Birdseye
(_
, _
, pageno
, _
, _
) ->
1413 let y, h = getpageyh pageno
in
1414 let top = (state
.winh
- h) / 2 in
1415 gotoy (max
0 (y - top))
1418 | LinkNav _
-> gotoanchor state
.anchor
1422 state
.reprf
<- noreprf
;
1427 GlDraw.viewport ~
x:0 ~
y:0 ~
w:w ~
h:h;
1428 let firsttime = state
.geomcmds
== firstgeomcmds
in
1429 if not
firsttime && nogeomcmds state
.geomcmds
1430 then state
.anchor <- getanchor
();
1433 let w = wadjsb () + (truncate
(float w *. conf
.zoom
)) in
1436 setfontsize fstate
.fontsize
;
1437 GlMat.mode `modelview
;
1438 GlMat.load_identity
();
1440 GlMat.mode `projection
;
1441 GlMat.load_identity
();
1442 GlMat.rotate ~
x:1.0 ~angle
:180.0 ();
1443 GlMat.translate ~
x:~
-.1.0 ~
y:~
-.1.0 ();
1444 GlMat.scale3
(2.0 /. float state
.winw
, 2.0 /. float state
.winh
, 1.0);
1449 else float state
.x /. float state
.w
1451 invalidate "geometry"
1455 then state
.x <- truncate
(relx *. float w);
1457 match conf
.columns
with
1459 | Cmulti
((c, _
, _
), _
) -> (w - (c-1)*conf
.interpagespace
) / c
1460 | Csplit
(c, _
) -> w * c
1462 wcmd "geometry %d %d %d"
1463 w (stateh h) (FMTE.to_int conf
.fitmodel
)
1468 let len = String.length state
.text in
1469 let x0 = xadjsb () in
1472 match state
.mode
with
1473 | Textentry _
| View
| LinkNav _
->
1474 let h, _
, _
= state
.uioh#scrollpw
in
1479 filledrect x (float (state
.winh
- (fstate
.fontsize
+ 4) - hscrollh))
1480 (x+.w) (float (state
.winh
- hscrollh))
1483 let w = float (wadjsb () + state
.winw
- 1) in
1484 if state
.progress
>= 0.0 && state
.progress
< 1.0
1486 GlDraw.color
(0.3, 0.3, 0.3);
1487 let w1 = w *. state
.progress
in
1489 GlDraw.color
(0.0, 0.0, 0.0);
1490 rect (float x0+.w1) (float x0+.w-.w1)
1493 GlDraw.color
(0.0, 0.0, 0.0);
1497 GlDraw.color
(1.0, 1.0, 1.0);
1498 drawstring fstate
.fontsize
1499 (if conf
.leftscroll
then x0 + 2 else x0 + if len > 0 then 8 else 2)
1500 (state
.winh
- hscrollh - 5) s;
1503 match state
.mode
with
1504 | Textentry
((prefix
, text, _
, _
, _
, _
), _
) ->
1508 Printf.sprintf
"%s%s_ [%s]" prefix
text state
.text
1510 Printf.sprintf
"%s%s_" prefix
text
1516 | LinkNav _
-> state
.text
1521 if not
(istextentry state
.mode
) && state
.uioh#eformsgs
1523 let s1 = "(press 'e' to review error messasges)" in
1524 if nonemptystr
s then s ^
" " ^
s1 else s1
1534 let len = Queue.length state
.tilelru
in
1536 match state
.throttle
with
1539 then preloadlayout state
.y
1541 | Some
(layout, _
, _
) ->
1545 if state
.memused
<= conf
.memlimit
1550 let (k
, p
, s) as lruitem
= Queue.pop state
.tilelru
in
1551 let n, gen
, colorspace
, angle
, pagew
, pageh
, col, row = k
in
1552 let (_
, pw, ph
, _
) = getpagedim
n in
1555 && colorspace
= conf
.colorspace
1556 && angle
= conf
.angle
1560 let x = col*conf
.tilew
1561 and y = row*conf
.tileh
in
1562 tilevisible (Lazy.force_val
layout) n x y
1564 then Queue.push lruitem state
.tilelru
1567 wcmd "freetile %s" (~
> p
);
1568 state
.memused
<- state
.memused
- s;
1569 state
.uioh#infochanged Memused
;
1570 Hashtbl.remove state
.tilemap k
;
1578 let logcurrently = function
1579 | Idle
-> dolog
"Idle"
1580 | Loading
(l, gen
) ->
1581 dolog
"Loading %d gen=%d curgen=%d" l.pageno gen state
.gen
1582 | Tiling
(l, pageopaque
, colorspace
, angle
, gen
, col, row, tilew
, tileh
) ->
1584 "Tiling %d[%d,%d] page=%s cs=%s angle"
1585 l.pageno
col row (~
> pageopaque
)
1586 (CSTE.to_string colorspace
)
1588 dolog
"gen=(%d,%d) (%d,%d) tile=(%d,%d) (%d,%d)"
1589 angle gen conf
.angle state
.gen
1591 conf
.tilew conf
.tileh
1598 let r = Str.regexp
" " in
1599 fun s -> Str.bounded_split
r s 2;
1602 let onpagerect pageno
f =
1604 match conf
.columns
with
1605 | Cmulti
(_
, b) -> b
1607 | Csplit
(_
, b) -> b
1609 if pageno
>= 0 && pageno
< Array.length
b
1611 let (_
, _
, _
, (w, h, _
, _
)) = b.(pageno
) in
1615 let gotopagexy1 pageno
x y =
1616 let _,w1,h1
,leftx
= getpagedim pageno
in
1617 let top = y /. (float h1
) in
1618 let left = x /. (float w1) in
1619 let py, w, h = getpageywh pageno
in
1620 let wh = state
.winh
- hscrollh () in
1621 let x = left *. (float w) in
1622 let x = leftx
+ state
.x + truncate
x in
1623 let wadj = wadjsb () in
1625 if x < 0 || x >= wadj + state
.winw
1629 let pdy = truncate
(top *. float h) in
1630 let y'
= py + pdy in
1631 let dy = y'
- state
.y in
1633 if x != state
.x || not
(dy > 0 && dy < wh)
1635 if conf
.presentation
1637 if abs
(py - y'
) > wh
1644 if state
.x != sx || state
.y != sy
1649 let ww = wadj + state
.winw
in
1651 and qy
= pdy / wh in
1653 and y = py + qy
* wh in
1654 let x = if -x + ww > w1 then -(w1-ww) else x
1655 and y'
= if y + wh > state
.maxy
then state
.maxy
- wh else y in
1657 if conf
.presentation
1659 if abs
(py - y'
) > wh
1669 gotoy_and_clear_text y;
1671 else gotoy_and_clear_text state
.y;
1674 let gotopagexy pageno
x y =
1675 match state
.mode
with
1676 | Birdseye
_ -> gotopage pageno
0.0
1679 | LinkNav
_ -> gotopagexy1 pageno
x y
1682 let getpassword () =
1683 let passcmd = getenvwithdef
"LLPP_ASKPASS" conf
.passcmd in
1687 match Unix.open_process_in
passcmd with
1688 | (exception exn
) ->
1691 "getpassword: open_process_in failed: %s" (exntos exn
));
1694 let s = try input_line ic
with End_of_file
-> E.s in
1696 match Unix.close_process_in ic
with
1697 | (exception exn
) ->
1699 (Printf.sprintf
"getpassword: close_process_in failed: %s"
1708 (* dolog "%S" cmds; *)
1709 let cl = splitatspace cmds
in
1711 try Scanf.sscanf
s fmt
f
1713 dolog
"error processing '%S': %s" cmds
(exntos exn
);
1716 let addoutline outline
=
1717 match state
.currently
with
1718 | Outlining outlines
->
1719 state
.currently
<- Outlining
(outline
:: outlines
)
1720 | Idle
-> state
.currently
<- Outlining
[outline
]
1723 dolog
"invalid outlining state";
1724 logcurrently state
.currently
1728 state
.uioh#infochanged Pdim
;
1731 | "clearrects" :: [] ->
1732 state
.rects
<- state
.rects1
;
1733 G.postRedisplay "clearrects";
1735 | "continue" :: args
:: [] ->
1736 let n = scan args
"%u" (fun n -> n) in
1737 state
.pagecount
<- n;
1738 begin match state
.currently
with
1740 state
.currently
<- Idle
;
1741 state
.outlines
<- Array.of_list
(List.rev
l)
1747 let cur, cmds
= state
.geomcmds
in
1749 then failwith
"umpossible";
1751 begin match List.rev cmds
with
1753 state
.geomcmds
<- E.s, [];
1754 state
.throttle
<- None
;
1758 state
.geomcmds
<- s, List.rev rest
;
1760 if conf
.maxwait
= None
&& not
!wtmode
1761 then G.postRedisplay "continue";
1763 | "msg" :: args
:: [] ->
1766 | "vmsg" :: args
:: [] ->
1768 then showtext ' ' args
1770 | "emsg" :: args
:: [] ->
1771 Buffer.add_string state
.errmsgs args
;
1772 state
.newerrmsgs
<- true;
1773 G.postRedisplay "error message"
1775 | "progress" :: args
:: [] ->
1776 let progress, text =
1779 f, String.sub args pos
(String.length args
- pos
))
1782 state
.progress <- progress;
1783 G.postRedisplay "progress"
1785 | "firstmatch" :: args
:: [] ->
1786 let pageno, c, x0, y0, x1, y1, x2
, y2
, x3
, y3
=
1787 scan args
"%u %d %f %f %f %f %f %f %f %f"
1788 (fun p
c x0 y0 x1 y1 x2 y2 x3 y3
->
1789 (p
, c, x0, y0, x1, y1, x2
, y2
, x3
, y3
))
1791 let xoff = float (xadjsb ()) in
1795 and x3
= x3
+. xoff in
1796 let y = (getpagey
pageno) + truncate
y0 in
1799 state
.rects1
<- [pageno, c, (x0, y0, x1, y1, x2
, y2
, x3
, y3
)]
1801 | "match" :: args
:: [] ->
1802 let pageno, c, x0, y0, x1, y1, x2
, y2
, x3
, y3
=
1803 scan args
"%u %d %f %f %f %f %f %f %f %f"
1804 (fun p
c x0 y0 x1 y1 x2 y2 x3 y3
->
1805 (p
, c, x0, y0, x1, y1, x2
, y2
, x3
, y3
))
1807 let xoff = float (xadjsb ()) in
1811 and x3
= x3
+. xoff in
1813 (pageno, c, (x0, y0, x1, y1, x2
, y2
, x3
, y3
)) :: state
.rects1
1815 | "page" :: args
:: [] ->
1816 let pageopaques, t
= scan args
"%s %f" (fun p t
-> p
, t
) in
1817 let pageopaque = ~
< pageopaques in
1818 begin match state
.currently
with
1819 | Loading
(l, gen
) ->
1820 vlog "page %d took %f sec" l.pageno t
;
1821 Hashtbl.replace state
.pagemap
(l.pageno, gen
) pageopaque;
1822 begin match state
.throttle
with
1824 let preloadedpages =
1826 then preloadlayout state
.y
1831 List.fold_left
(fun s l -> IntSet.add
l.pageno s)
1832 IntSet.empty
preloadedpages
1835 Hashtbl.fold (fun ((pageno, _) as key) opaque
accu ->
1836 if not
(IntSet.mem
pageno set)
1838 wcmd "freepage %s" (~
> opaque
);
1844 List.iter
(Hashtbl.remove state
.pagemap
) evictedpages;
1847 state
.currently
<- Idle
;
1850 tilepage l.pageno pageopaque state
.layout;
1852 load preloadedpages;
1853 let visible = pagevisible state
.layout l.pageno in
1856 match state
.mode
with
1857 | LinkNav
(Ltnotready
(pageno, dir
)) ->
1858 if pageno = l.pageno
1863 then LDfirstvisible
(l.pagex
, l.pagey, dir
)
1865 if dir
> 0 then LDfirst
else LDlast
1868 findlink
pageopaque ld
1873 showlinktype (getlink
pageopaque n);
1874 state
.mode
<- LinkNav
(Ltexact
(l.pageno, n))
1876 | LinkNav
(Ltgendir
_)
1877 | LinkNav
(Ltexact
_)
1883 if visible && layoutready state
.layout
1885 G.postRedisplay "page";
1889 | Some
(layout, _, _) ->
1890 state
.currently
<- Idle
;
1891 tilepage l.pageno pageopaque layout;
1898 dolog
"Inconsistent loading state";
1899 logcurrently state
.currently
;
1903 | "tile" :: args
:: [] ->
1904 let (x, y, opaques
, size
, t
) =
1905 scan args
"%u %u %s %u %f"
1906 (fun x y p size t
-> (x, y, p
, size
, t
))
1908 let opaque = ~
< opaques
in
1909 begin match state
.currently
with
1910 | Tiling
(l, pageopaque, cs
, angle
, gen
, col, row, tilew
, tileh
) ->
1911 vlog "tile %d [%d,%d] took %f sec" l.pageno col row t
;
1914 if tilew
!= conf
.tilew
|| tileh
!= conf
.tileh
1916 wcmd "freetile %s" (~
> opaque);
1917 state
.currently
<- Idle
;
1921 puttileopaque l col row gen cs angle
opaque size t
;
1922 state
.memused
<- state
.memused
+ size
;
1923 state
.uioh#infochanged Memused
;
1925 Queue.push
((l.pageno, gen
, cs
, angle
, l.pagew
, l.pageh
, col, row),
1926 opaque, size
) state
.tilelru
;
1929 match state
.throttle
with
1930 | None
-> state
.layout
1931 | Some
(layout, _, _) -> layout
1934 state
.currently
<- Idle
;
1936 && conf
.colorspace
= cs
1937 && conf
.angle
= angle
1938 && tilevisible layout l.pageno x y
1939 then conttiling l.pageno pageopaque;
1941 begin match state
.throttle
with
1943 preload state
.layout;
1945 && conf
.colorspace
= cs
1946 && conf
.angle
= angle
1947 && tilevisible state
.layout l.pageno x y
1948 && (not
!wtmode || layoutready state
.layout)
1949 then G.postRedisplay "tile nothrottle";
1951 | Some
(layout, y, _) ->
1952 let ready = layoutready layout in
1956 state
.layout <- layout;
1957 state
.throttle
<- None
;
1958 G.postRedisplay "throttle";
1967 dolog
"Inconsistent tiling state";
1968 logcurrently state
.currently
;
1972 | "pdim" :: args
:: [] ->
1973 let (n, w, h, _) as pdim
=
1974 scan args
"%u %u %u %u" (fun n w h x -> n, w, h, x)
1977 match conf
.fitmodel
with
1979 | FitPage
| FitProportional
->
1980 match conf
.columns
with
1981 | Csplit
_ -> (n, w, h, 0)
1982 | Csingle
_ | Cmulti
_ -> pdim
1984 state
.uioh#infochanged Pdim
;
1985 state
.pdims
<- pdim :: state
.pdims
1987 | "o" :: args
:: [] ->
1988 let (l, n, t
, h, pos
) =
1989 scan args
"%u %u %d %u %n"
1990 (fun l n t
h pos
-> l, n, t
, h, pos
)
1992 let s = String.sub args pos
(String.length args
- pos
) in
1993 addoutline (s, l, Oanchor
(n, float t
/. float h, 0.0))
1995 | "ou" :: args
:: [] ->
1996 let (l, len, pos
) = scan args
"%u %u %n" (fun l len pos
-> l, len, pos
) in
1997 let s = String.sub args pos
len in
1998 let pos2 = pos
+ len + 1 in
1999 let uri = String.sub args
pos2 (String.length args
- pos2) in
2000 addoutline (s, l, Ouri
uri)
2002 | "on" :: args
:: [] ->
2003 let (l, pos
) = scan args
"%u %n" (fun l pos
-> l, pos
) in
2004 let s = String.sub args pos
(String.length args
- pos
) in
2005 addoutline (s, l, Onone
)
2007 | "a" :: args
:: [] ->
2009 scan args
"%u %d %d" (fun n l t
-> n, l, t
)
2011 state
.reprf
<- (fun () -> gotopagexy n (float l) (float t
))
2013 | "info" :: args
:: [] ->
2014 let pos = nindex args '
\t'
in
2015 if pos >= 0 && String.sub args
0 pos = "Title"
2017 let s = String.sub args
(pos+1) @@ String.length args
- pos - 1 in
2020 state
.docinfo
<- (1, args
) :: state
.docinfo
2022 | "infoend" :: [] ->
2023 state
.uioh#infochanged Docinfo
;
2024 state
.docinfo
<- List.rev state
.docinfo
2028 then Wsi.settitle
"Wrong password";
2029 let password = getpassword () in
2031 then error
"document is password protected"
2032 else opendoc state
.path
password
2035 error
"unknown cmd `%S'" cmds
2040 let action = function
2041 | HCprev
-> cbget cb ~
-1
2042 | HCnext
-> cbget cb
1
2043 | HCfirst
-> cbget cb ~
-(cb
.rc)
2044 | HClast
-> cbget cb
(cb
.len - 1 - cb
.rc)
2045 and cancel
() = cb
.rc <- rc
2049 let search pattern forward
=
2050 match conf
.columns
with
2052 showtext '
!'
"searching does not work properly in split columns mode"
2055 if nonemptystr pattern
2058 match state
.layout with
2061 l.pageno, (l.pagey + if forward
then 0 else 0*l.pagevh)
2063 wcmd "search %d %d %d %d,%s\000"
2064 (btod conf
.icase
) pn py (btod forward
) pattern
;
2067 let intentry text key =
2069 if key >= 32 && key < 127
2075 let text = addchar text c in
2079 state
.text <- Printf.sprintf
"invalid char (%d, `%c')" key c;
2083 let linknentry text key =
2085 if key >= 32 && key < 127
2091 let text = addchar text c in
2095 state
.text <- Printf.sprintf
"invalid char (%d, `%c')" key c;
2103 let l = String.length
s in
2104 let rec loop pos n = if pos = l then n else
2105 let m = Char.code
s.[pos] - (if pos = 0 && l > 1 then 96 else 97) in
2106 loop (pos+1) (n*26 + m)
2109 let rec loop n = function
2112 match getopaque l.pageno with
2113 | None
-> loop n rest
2115 let m = getlinkcount
opaque in
2118 let under = getlink
opaque n in
2121 else loop (n-m) rest
2123 loop n state
.layout;
2127 let textentry text key =
2128 if key land 0xff00 = 0xff00
2130 else TEcont
(text ^ toutf8
key)
2133 let reqlayout angle fitmodel
=
2134 match state
.throttle
with
2136 if nogeomcmds state
.geomcmds
2137 then state
.anchor <- getanchor
();
2138 conf
.angle
<- angle
mod 360;
2141 match state
.mode
with
2142 | LinkNav
_ -> state
.mode
<- View
2147 conf
.fitmodel
<- fitmodel
;
2148 invalidate "reqlayout"
2150 wcmd "reqlayout %d %d %d"
2151 conf
.angle
(FMTE.to_int conf
.fitmodel
) (stateh state
.winh
)
2156 let settrim trimmargins trimfuzz
=
2157 if nogeomcmds state
.geomcmds
2158 then state
.anchor <- getanchor
();
2159 conf
.trimmargins
<- trimmargins
;
2160 conf
.trimfuzz
<- trimfuzz
;
2161 let x0, y0, x1, y1 = trimfuzz
in
2162 invalidate "settrim"
2164 wcmd "settrim %d %d %d %d %d" (btod conf
.trimmargins
) x0 y0 x1 y1);
2169 match state
.throttle
with
2171 let zoom = max
0.0001 zoom in
2172 if zoom <> conf
.zoom
2174 state
.prevzoom
<- (conf
.zoom, state
.x);
2176 reshape state
.winw state
.winh
;
2177 state
.text <- Printf.sprintf
"zoom is now %-5.2f" (zoom *. 100.0);
2180 | Some
(layout, y, started
) ->
2182 match conf
.maxwait
with
2186 let dt = now
() -. started
in
2194 let setcolumns mode columns coverA coverB
=
2195 state
.prevcolumns
<- Some
(conf
.columns
, conf
.zoom);
2199 then showtext '
!'
"split mode doesn't work in bird's eye"
2201 conf
.columns
<- Csplit
(-columns
, E.a);
2209 conf
.columns
<- Csingle
E.a;
2214 conf
.columns
<- Cmulti
((columns
, coverA
, coverB
), E.a);
2218 reshape state
.winw state
.winh
;
2221 let resetmstate () =
2222 state
.mstate
<- Mnone
;
2223 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
2226 let enterbirdseye () =
2227 let zoom = float conf
.thumbw
/. float state
.winw
in
2228 let birdseyepageno =
2229 let cy = state
.winh
/ 2 in
2233 let rec fold best
= function
2236 let d = cy - (l.pagedispy + l.pagevh/2)
2237 and dbest
= cy - (best
.pagedispy + best
.pagevh/2) in
2238 if abs
d < abs dbest
2245 state
.mode
<- Birdseye
(
2246 { conf
with zoom = conf
.zoom }, state
.x, birdseyepageno, -1, getanchor
()
2250 conf
.presentation
<- false;
2251 conf
.interpagespace
<- 10;
2252 conf
.hlinks
<- false;
2253 conf
.fitmodel
<- FitPage
;
2255 conf
.maxwait
<- None
;
2257 match conf
.beyecolumns
with
2260 Cmulti
((c, 0, 0), E.a)
2261 | None
-> Csingle
E.a
2265 state
.text <- Printf.sprintf
"birds eye mode on (zoom %3.1f%%)"
2270 reshape state
.winw state
.winh
;
2273 let leavebirdseye (c, leftx
, pageno, _, anchor) goback
=
2275 conf
.zoom <- c.zoom;
2276 conf
.presentation
<- c.presentation
;
2277 conf
.interpagespace
<- c.interpagespace
;
2278 conf
.maxwait
<- c.maxwait
;
2279 conf
.hlinks
<- c.hlinks
;
2280 conf
.fitmodel
<- c.fitmodel
;
2281 conf
.beyecolumns
<- (
2282 match conf
.columns
with
2283 | Cmulti
((c, _, _), _) -> Some
c
2285 | Csplit
_ -> failwith
"leaving bird's eye split mode"
2288 match c.columns
with
2289 | Cmulti
(c, _) -> Cmulti
(c, E.a)
2290 | Csingle
_ -> Csingle
E.a
2291 | Csplit
(c, _) -> Csplit
(c, E.a)
2295 state
.text <- Printf.sprintf
"birds eye mode off (zoom %3.1f%%)"
2298 reshape state
.winw state
.winh
;
2299 state
.anchor <- if goback
then anchor else (pageno, 0.0, 1.0);
2303 let togglebirdseye () =
2304 match state
.mode
with
2305 | Birdseye vals
-> leavebirdseye vals
true
2306 | View
-> enterbirdseye ()
2311 let upbirdseye incr
(conf
, leftx
, pageno, hooverpageno
, anchor) =
2312 let pageno = max
0 (pageno - incr
) in
2313 let rec loop = function
2314 | [] -> gotopage1 pageno 0
2315 | l :: _ when l.pageno = pageno ->
2316 if l.pagedispy >= 0 && l.pagey = 0
2317 then G.postRedisplay "upbirdseye"
2318 else gotopage1 pageno 0
2319 | _ :: rest
-> loop rest
2323 state
.mode
<- Birdseye
(conf
, leftx
, pageno, hooverpageno
, anchor)
2326 let downbirdseye incr
(conf
, leftx
, pageno, hooverpageno
, anchor) =
2327 let pageno = min
(state
.pagecount
- 1) (pageno + incr
) in
2328 state
.mode
<- Birdseye
(conf
, leftx
, pageno, hooverpageno
, anchor);
2329 let rec loop = function
2331 let y, h = getpageyh
pageno in
2332 let dy = (y - state
.y) - (state
.winh
- h - conf
.interpagespace
) in
2334 | l :: _ when l.pageno = pageno ->
2335 if l.pagevh != l.pageh
2336 then gotoy (clamp (l.pageh
- l.pagevh + conf
.interpagespace
))
2337 else G.postRedisplay "downbirdseye"
2338 | _ :: rest
-> loop rest
2344 let boundastep h step
=
2346 then bound step ~
-h 0
2350 let optentry mode
_ key =
2351 let btos b = if b then "on" else "off" in
2352 if key >= 32 && key < 127
2354 let c = Char.chr
key in
2358 try conf
.scrollstep
<- int_of_string
s with exc
->
2359 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2361 TEswitch
("scroll step: ", E.s, None
, intentry, ondone, true)
2366 conf
.autoscrollstep
<- boundastep state
.winh
(int_of_string
s);
2367 if state
.autoscroll
<> None
2368 then state
.autoscroll
<- Some conf
.autoscrollstep
2370 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2372 TEswitch
("auto scroll step: ", E.s, None
, intentry, ondone, true)
2377 let n, a, b = multicolumns_of_string
s in
2378 setcolumns mode
n a b;
2380 state
.text <- Printf.sprintf
"bad columns `%s': %s" s (exntos exc
)
2382 TEswitch
("columns: ", E.s, None
, textentry, ondone, true)
2387 let zoom = float (int_of_string
s) /. 100.0 in
2390 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2392 TEswitch
("zoom: ", E.s, None
, intentry, ondone, true)
2397 conf
.thumbw
<- bound
(int_of_string
s) 2 4096;
2399 Printf.sprintf
"thumbnail width is set to %d" conf
.thumbw
;
2400 begin match mode
with
2402 leavebirdseye beye
false;
2409 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2411 TEswitch
("thumbnail width: ", E.s, None
, intentry, ondone, true)
2416 Some
(int_of_string
s)
2418 state
.text <- Printf.sprintf
"bad integer `%s': %s"
2422 | Some angle
-> reqlayout angle conf
.fitmodel
2425 TEswitch
("rotation: ", E.s, None
, intentry, ondone, true)
2428 conf
.icase
<- not conf
.icase
;
2429 TEdone
("case insensitive search " ^
(btos conf
.icase
))
2432 conf
.preload <- not conf
.preload;
2434 TEdone
("preload " ^
(btos conf
.preload))
2437 conf
.verbose
<- not conf
.verbose
;
2438 TEdone
("verbose " ^
(btos conf
.verbose
))
2441 conf
.debug
<- not conf
.debug
;
2442 TEdone
("debug " ^
(btos conf
.debug
))
2445 conf
.maxhfit
<- not conf
.maxhfit
;
2446 state
.maxy
<- calcheight
();
2447 TEdone
("maxhfit " ^
(btos conf
.maxhfit
))
2450 conf
.crophack
<- not conf
.crophack
;
2451 TEdone
("crophack " ^
btos conf
.crophack
)
2455 match conf
.maxwait
with
2457 conf
.maxwait
<- Some infinity
;
2458 "always wait for page to complete"
2460 conf
.maxwait
<- None
;
2461 "show placeholder if page is not ready"
2466 conf
.underinfo
<- not conf
.underinfo
;
2467 TEdone
("underinfo " ^
btos conf
.underinfo
)
2470 conf
.savebmarks
<- not conf
.savebmarks
;
2471 TEdone
("persistent bookmarks " ^
btos conf
.savebmarks
)
2477 match state
.layout with
2482 conf
.interpagespace
<- int_of_string
s;
2483 docolumns conf
.columns
;
2484 state
.maxy
<- calcheight
();
2485 let y = getpagey
pageno in
2488 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2490 TEswitch
("vertical margin: ", E.s, None
, intentry, ondone, true)
2494 match conf
.fitmodel
with
2495 | FitProportional
-> FitWidth
2496 | FitWidth
| FitPage
-> FitProportional
2498 reqlayout conf
.angle
fm;
2499 TEdone
("proportional display " ^
btos (fm == FitProportional
))
2502 settrim (not conf
.trimmargins
) conf
.trimfuzz
;
2503 TEdone
("trim margins " ^
btos conf
.trimmargins
)
2506 conf
.invert
<- not conf
.invert
;
2507 TEdone
("invert colors " ^
btos conf
.invert
)
2511 cbput state
.hists
.sel
s;
2514 TEswitch
("selection command: ", E.s, Some
(onhist state
.hists
.sel
),
2515 textentry, ondone, true)
2519 then conf
.pax
<- Some
(ref (0.0, 0, 0))
2520 else conf
.pax
<- None
;
2521 TEdone
("PAX " ^
btos (conf
.pax
!= None
))
2524 state
.text <- Printf.sprintf
"bad option %d `%c'" key c;
2530 class type lvsource
= object
2531 method getitemcount
: int
2532 method getitem
: int -> (string * int)
2533 method hasaction
: int -> bool
2541 method getactive
: int
2542 method getfirst
: int
2544 method getminfo
: (int * int) array
2547 class virtual lvsourcebase
= object
2548 val mutable m_active
= 0
2549 val mutable m_first
= 0
2550 val mutable m_pan
= 0
2551 method getactive
= m_active
2552 method getfirst
= m_first
2553 method getpan
= m_pan
2554 method getminfo
: (int * int) array
= E.a
2557 let withoutlastutf8 s =
2558 let len = String.length
s in
2566 let b = Char.code
s.[pos] in
2567 if b land 0b11000000 = 0b11000000
2572 if Char.code
s.[len-1] land 0x80 = 0
2576 String.sub
s 0 first;
2579 let textentrykeyboard
2580 key _mask
((c, text, opthist
, onkey
, ondone, cancelonempty
), onleave
) =
2582 if key >= 0xffb0 && key <= 0xffb9
2583 then key - 0xffb0 + 48 else key
2586 state
.mode
<- Textentry
(te
, onleave
);
2589 G.postRedisplay "textentrykeyboard enttext";
2591 let histaction cmd
=
2594 | Some
(action, _) ->
2595 state
.mode
<- Textentry
(
2596 (c, action cmd
, opthist
, onkey
, ondone, cancelonempty
), onleave
2598 G.postRedisplay "textentry histaction"
2602 if emptystr
text && cancelonempty
2605 G.postRedisplay "textentrykeyboard after cancel";
2608 let s = withoutlastutf8 text in
2609 enttext (c, s, opthist
, onkey
, ondone, cancelonempty
)
2611 | @enter
| @kpenter
->
2614 G.postRedisplay "textentrykeyboard after confirm"
2616 | @up
| @kpup
-> histaction HCprev
2617 | @down
| @kpdown
-> histaction HCnext
2618 | @home
| @kphome
-> histaction HCfirst
2619 | @jend
| @kpend
-> histaction HClast
2624 begin match opthist
with
2626 | Some
(_, onhistcancel
) -> onhistcancel
()
2630 G.postRedisplay "textentrykeyboard after cancel2"
2633 enttext (c, E.s, opthist
, onkey
, ondone, cancelonempty
)
2636 | @delete
| @kpdelete
-> ()
2639 && key land 0xff00 != 0xff00 (* keyboard *)
2640 && key land 0xfe00 != 0xfe00 (* xkb *)
2641 && key land 0xfd00 != 0xfd00 (* 3270 *)
2643 begin match onkey
text key with
2647 G.postRedisplay "textentrykeyboard after confirm2";
2650 enttext (c, text, opthist
, onkey
, ondone, cancelonempty
);
2654 G.postRedisplay "textentrykeyboard after cancel3"
2657 state
.mode
<- Textentry
(te
, onleave
);
2658 G.postRedisplay "textentrykeyboard switch";
2662 vlog "unhandled key %s" (Wsi.keyname
key)
2665 let firstof first active
=
2666 if first > active
|| abs
(first - active
) > fstate
.maxrows
- 1
2667 then max
0 (active
- (fstate
.maxrows
/2))
2671 let calcfirst first active
=
2674 let rows = active
- first in
2675 if rows > fstate
.maxrows
then active
- fstate
.maxrows
else first
2679 let scrollph y maxy
=
2680 let sh = float (maxy
+ state
.winh
) /. float state
.winh
in
2681 let sh = float state
.winh
/. sh in
2682 let sh = max
sh (float conf
.scrollh
) in
2684 let percent = float y /. float maxy
in
2685 let position = (float state
.winh
-. sh) *. percent in
2688 if position +. sh > float state
.winh
2689 then float state
.winh
-. sh
2695 let coe s = (s :> uioh
);;
2697 class listview ~zebra ~helpmode ~
(source
:lvsource
) ~trusted ~modehash
=
2699 val m_pan
= source#getpan
2700 val m_first
= source#getfirst
2701 val m_active
= source#getactive
2703 val m_prev_uioh
= state
.uioh
2705 method private elemunder
y =
2709 let n = y / (fstate
.fontsize
+1) in
2710 if m_first
+ n < source#getitemcount
2712 if source#hasaction
(m_first
+ n)
2713 then Some
(m_first
+ n)
2720 GlFunc.blend_func ~src
:`src_alpha ~dst
:`one_minus_src_alpha
;
2721 GlDraw.color
(0., 0., 0.) ~alpha
:0.85;
2722 filledrect 0. 0. (float state
.winw
) (float state
.winh
);
2723 GlDraw.color
(1., 1., 1.);
2724 Gl.enable `texture_2d
;
2725 let fs = fstate
.fontsize
in
2727 let hw = (wadjsb () + xadjsb () + state
.winw
)/3 in
2728 let ww = fstate
.wwidth
in
2729 let tabw = 17.0*.ww in
2730 let itemcount = source#getitemcount
in
2731 let minfo = source#getminfo
in
2734 then float (xadjsb ()), float (state
.winw
- 1)
2735 else 0.0, float (state
.winw
- conf
.scrollbw
- 1)
2737 let xadj = xadjsb () in
2739 if (row - m_first
) > fstate
.maxrows
2742 if row >= 0 && row < itemcount
2744 let (s, level
) = source#getitem
row in
2745 let y = (row - m_first
) * nfs in
2747 (if conf
.leftscroll
then float xadj else 5.0)
2748 +. (float (level
+ m_pan
)) *. ww in
2751 (let c = if row land 1 = 0 then 1.0 else 0.92 in (c,c,c));
2755 Gl.disable `texture_2d
;
2756 let alpha = if source#hasaction
row then 0.9 else 0.3 in
2757 GlDraw.color
(1., 1., 1.) ~
alpha;
2758 linerect (x0 +. 1.) (float (y + 1)) (x1) (float (y + fs + 3));
2759 Gl.enable `texture_2d
;
2762 if zebra
&& row land 1 = 1
2766 GlDraw.color
(c,c,c);
2767 let drawtabularstring s =
2769 let x'
= truncate
(x0 +. x) in
2770 let pos = nindex
s '
\000'
in
2772 then drawstring1 fs x'
(y+nfs) s
2774 let s1 = String.sub
s 0 pos
2775 and s2
= String.sub
s (pos+1) (String.length
s - pos - 1) in
2780 let s'
= withoutlastutf8 s in
2781 let s = s' ^
"@Uellipsis" in
2782 let w = measurestr
fs s in
2783 if float x'
+. w +. ww < float (hw + x'
)
2788 if float x'
+. ww +. measurestr
fs s1 > float (hw + x'
)
2792 ignore
(drawstring1 fs x'
(y+nfs) s1);
2793 drawstring1 fs (hw + x'
) (y+nfs) s2
2797 let x = if helpmode
&& row > 0 then x +. ww else x in
2798 let tabpos = nindex
s '
\t'
in
2801 let len = String.length
s - tabpos - 1 in
2802 let s1 = String.sub
s 0 tabpos
2803 and s2
= String.sub
s (tabpos + 1) len in
2804 let nx = drawstr x s1 in
2806 let x = x +. (max
tabw sw) in
2809 let len = String.length
s - 2 in
2810 if len > 0 && s.[0] = '
\xc2'
&& s.[1] = '
\xb7'
2812 let s = String.sub
s 2 len in
2813 let x = if not helpmode
then x +. ww else x in
2814 GlDraw.color
(1.2, 1.2, 1.2);
2815 let vinc = drawstring1 (fs+fs/4)
2816 (truncate
(x -. ww)) (y+nfs) s in
2817 GlDraw.color
(1., 1., 1.);
2818 vinc +. (float fs *. 0.8)
2824 ignore
(drawtabularstring s);
2830 GlDraw.color
(1.0, 1.0, 1.0) ~
alpha:0.5;
2831 let xadj = float (xadjsb () + 5) in
2833 if (row - m_first
) > fstate
.maxrows
2836 if row >= 0 && row < itemcount
2838 let (s, level
) = source#getitem
row in
2839 let pos0 = nindex
s '
\000'
in
2840 let y = (row - m_first
) * nfs in
2841 let x = float (level
+ m_pan
) *. ww in
2842 let (first, last
) = minfo.(row) in
2844 if pos0 > 0 && first > pos0
2845 then String.sub
s (pos0+1) (first-pos0-1)
2846 else String.sub
s 0 first
2848 let suffix = String.sub
s first (last
- first) in
2849 let w1 = measurestr fstate
.fontsize
prefix in
2850 let w2 = measurestr fstate
.fontsize
suffix in
2851 let x = x +. if conf
.leftscroll
then xadj else 5.0 in
2852 let x = if pos0 > 0 && first > pos0 then x +. float hw else x in
2854 and y0 = float (y+2) in
2856 and y1 = float (y+fs+3) in
2857 filledrect x0 y0 x1 y1;
2862 Gl.disable `texture_2d
;
2863 if Array.length
minfo > 0 then loop m_first
;
2866 method updownlevel incr
=
2867 let len = source#getitemcount
in
2869 if m_active
>= 0 && m_active
< len
2870 then snd
(source#getitem m_active
)
2874 if i
= len then i
-1 else if i
= -1 then 0 else
2875 let _, l = source#getitem i
in
2876 if l != curlevel then i
else flow (i
+incr
)
2878 let active = flow m_active
in
2879 let first = calcfirst m_first
active in
2880 G.postRedisplay "outline updownlevel";
2881 {< m_active
= active; m_first
= first >}
2883 method private key1
key mask
=
2884 let set1 active first qsearch
=
2885 coe {< m_active
= active; m_first
= first; m_qsearch
= qsearch
>}
2887 let search active pattern incr
=
2888 let active = if active = -1 then m_first
else active in
2891 if n >= 0 && n < source#getitemcount
2893 let s, _ = source#getitem
n in
2895 (try ignore
(Str.search_forward
re s 0); true
2896 with Not_found
-> false)
2898 else loop (n + incr
)
2905 let re = Str.regexp_case_fold pattern
in
2911 let itemcount = source#getitemcount
in
2912 let find start incr
=
2914 if i
= -1 || i
= itemcount
2917 if source#hasaction i
2919 else find (i
+ incr
)
2924 let set active first =
2925 let first = bound
first 0 (itemcount - fstate
.maxrows
) in
2927 coe {< m_active
= active; m_first
= first; m_qsearch
= E.s >}
2930 let isvisible first n = n >= first && n - first <= fstate
.maxrows
in
2932 let incr1 = if incr
> 0 then 1 else -1 in
2933 if isvisible m_first m_active
2936 let next = m_active
+ incr
in
2938 if next < 0 || next >= itemcount
2940 else find next incr1
2942 if abs
(m_active
- next) > fstate
.maxrows
2948 let first = m_first
+ incr
in
2949 let first = bound
first 0 (itemcount - fstate
.maxrows
) in
2951 let next = m_active
+ incr
in
2952 let next = bound
next 0 (itemcount - 1) in
2959 if isvisible first next
2966 let first = min
next m_first
in
2968 if abs
(next - first) > fstate
.maxrows
2974 let first = m_first
+ incr
in
2975 let first = bound
first 0 (itemcount - 1) in
2977 let next = m_active
+ incr
in
2978 let next = bound
next 0 (itemcount - 1) in
2979 let next = find next incr1 in
2981 if next = -1 || abs
(m_active
- first) > fstate
.maxrows
2983 let active = if m_active
= -1 then next else m_active
in
2988 if isvisible first active
2994 G.postRedisplay "listview navigate";
2998 | (@r|@s) when Wsi.withctrl mask
->
2999 let incr = if key = @r then -1 else 1 in
3001 match search (m_active
+ incr) m_qsearch
incr with
3003 state
.text <- m_qsearch ^
" [not found]";
3006 state
.text <- m_qsearch
;
3007 active, firstof m_first
active
3009 G.postRedisplay "listview ctrl-r/s";
3010 set1 active first m_qsearch
;
3012 | @insert
when Wsi.withctrl mask
->
3013 if m_active
>= 0 && m_active
< source#getitemcount
3015 let s, _ = source#getitem m_active
in
3021 if emptystr m_qsearch
3024 let qsearch = withoutlastutf8 m_qsearch
in
3028 G.postRedisplay "listview empty qsearch";
3029 set1 m_active m_first
E.s;
3033 match search m_active
qsearch ~
-1 with
3035 state
.text <- qsearch ^
" [not found]";
3038 state
.text <- qsearch;
3039 active, firstof m_first
active
3041 G.postRedisplay "listview backspace qsearch";
3042 set1 active first qsearch
3045 | key when (key != 0 && key land 0xff00 != 0xff00) ->
3046 let pattern = m_qsearch ^ toutf8
key in
3048 match search m_active
pattern 1 with
3050 state
.text <- pattern ^
" [not found]";
3053 state
.text <- pattern;
3054 active, firstof m_first
active
3056 G.postRedisplay "listview qsearch add";
3057 set1 active first pattern;
3061 if emptystr m_qsearch
3063 G.postRedisplay "list view escape";
3066 source#exit ~uioh
:(coe self
)
3067 ~cancel
:true ~
active:m_active ~
first:m_first ~pan
:m_pan
3069 | None
-> m_prev_uioh
3074 G.postRedisplay "list view kill qsearch";
3075 coe {< m_qsearch
= E.s >}
3078 | @enter
| @kpenter
->
3080 let self = {< m_qsearch
= E.s >} in
3082 G.postRedisplay "listview enter";
3083 if m_active
>= 0 && m_active
< source#getitemcount
3085 source#exit ~uioh
:(coe self) ~cancel
:false
3086 ~
active:m_active ~
first:m_first ~pan
:m_pan
;
3089 source#exit ~uioh
:(coe self) ~cancel
:true
3090 ~
active:m_active ~
first:m_first ~pan
:m_pan
;
3093 begin match opt with
3094 | None
-> m_prev_uioh
3098 | @delete
| @kpdelete
->
3101 | @up
| @kpup
-> navigate ~
-1
3102 | @down
| @kpdown
-> navigate 1
3103 | @prior
| @kpprior
-> navigate ~
-(fstate
.maxrows
)
3104 | @next | @kpnext
-> navigate fstate
.maxrows
3106 | @right
| @kpright
->
3108 G.postRedisplay "listview right";
3109 coe {< m_pan
= m_pan
- 1 >}
3111 | @left | @kpleft
->
3113 G.postRedisplay "listview left";
3114 coe {< m_pan
= m_pan
+ 1 >}
3116 | @home
| @kphome
->
3117 let active = find 0 1 in
3118 G.postRedisplay "listview home";
3122 let first = max
0 (itemcount - fstate
.maxrows
) in
3123 let active = find (itemcount - 1) ~
-1 in
3124 G.postRedisplay "listview end";
3127 | key when (key = 0 || key land 0xff00 = 0xff00) ->
3131 dolog
"listview unknown key %#x" key; coe self
3133 method key key mask
=
3134 match state
.mode
with
3135 | Textentry te
-> textentrykeyboard key mask te
; coe self
3138 | LinkNav
_ -> self#key1
key mask
3140 method button button down
x y _ =
3143 | 1 when x > state
.winw
- conf
.scrollbw
->
3144 G.postRedisplay "listview scroll";
3147 let _, position, sh = self#
scrollph in
3148 if y > truncate
position && y < truncate
(position +. sh)
3150 state
.mstate
<- Mscrolly
;
3154 let s = float (max
0 (y - conf
.scrollh
)) /. float state
.winh
in
3155 let first = truncate
(s *. float source#getitemcount
) in
3156 let first = min source#getitemcount
first in
3157 Some
(coe {< m_first
= first; m_active
= first >})
3159 state
.mstate
<- Mnone
;
3163 begin match self#elemunder
y with
3165 G.postRedisplay "listview click";
3166 source#exit ~uioh
:(coe {< m_active
= n >})
3167 ~cancel
:false ~
active:n ~
first:m_first ~pan
:m_pan
3171 | n when (n == 4 || n == 5) && not down
->
3172 let len = source#getitemcount
in
3174 if n = 5 && m_first
+ fstate
.maxrows
>= len
3178 let first = m_first
+ (if n == 4 then -1 else 1) in
3179 bound
first 0 (len - 1)
3181 G.postRedisplay "listview wheel";
3182 Some
(coe {< m_first
= first >})
3183 | n when (n = 6 || n = 7) && not down
->
3184 let inc = if n = 7 then -1 else 1 in
3185 G.postRedisplay "listview hwheel";
3186 Some
(coe {< m_pan
= m_pan
+ inc >})
3191 | None
-> m_prev_uioh
3194 method multiclick
_ x y = self#button
1 true x y
3197 match state
.mstate
with
3199 let s = float (max
0 (y - conf
.scrollh
)) /. float state
.winh
in
3200 let first = truncate
(s *. float source#getitemcount
) in
3201 let first = min source#getitemcount
first in
3202 G.postRedisplay "listview motion";
3203 coe {< m_first
= first; m_active
= first >}
3211 method pmotion
x y =
3212 if x < state
.winw
- conf
.scrollbw
3215 match self#elemunder
y with
3216 | None
-> Wsi.setcursor
Wsi.CURSOR_INHERIT
; m_active
3217 | Some
n -> Wsi.setcursor
Wsi.CURSOR_INFO
; n
3221 then (G.postRedisplay "listview pmotion"; {< m_active
= n >})
3226 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
3230 method infochanged
_ = ()
3232 method scrollpw
= (0, 0.0, 0.0)
3234 let nfs = fstate
.fontsize
+ 1 in
3235 let y = m_first
* nfs in
3236 let itemcount = source#getitemcount
in
3237 let maxi = max
0 (itemcount - fstate
.maxrows
) in
3238 let maxy = maxi * nfs in
3239 let p, h = scrollph y maxy in
3242 method modehash
= modehash
3243 method eformsgs
= false
3244 method alwaysscrolly
= true
3247 class outlinelistview ~zebra ~source
=
3248 let settext autonarrow
s =
3251 let ss = source#statestr
in
3255 else "{" ^
ss ^
"} [" ^
s ^
"]"
3256 else state
.text <- s
3262 ~source
:(source
:> lvsource
)
3264 ~modehash
:(findkeyhash conf
"outline")
3267 val m_autonarrow
= false
3269 method! key key mask
=
3271 if emptystr state
.text
3273 else fstate
.maxrows - 2
3275 let calcfirst first active =
3278 let rows = active - first in
3279 if rows > maxrows then active - maxrows else first
3283 let active = m_active
+ incr in
3284 let active = bound
active 0 (source#getitemcount
- 1) in
3285 let first = calcfirst m_first
active in
3286 G.postRedisplay "outline navigate";
3287 coe {< m_active
= active; m_first
= first >}
3289 let navscroll first =
3291 let dist = m_active
- first in
3297 else first + maxrows
3300 G.postRedisplay "outline navscroll";
3301 coe {< m_first
= first; m_active
= active >}
3303 let ctrl = Wsi.withctrl mask
in
3308 then (source#denarrow
; E.s)
3310 let pattern = source#renarrow
in
3311 if nonemptystr m_qsearch
3312 then (source#narrow m_qsearch
; m_qsearch
)
3316 settext (not m_autonarrow
) text;
3317 G.postRedisplay "toggle auto narrowing";
3318 coe {< m_first
= 0; m_active
= 0; m_autonarrow
= not m_autonarrow
>}
3320 | @slash
when emptystr m_qsearch
&& not m_autonarrow
->
3322 G.postRedisplay "toggle auto narrowing";
3323 coe {< m_first
= 0; m_active
= 0; m_autonarrow
= true >}
3326 source#narrow m_qsearch
;
3328 then source#add_narrow_pattern m_qsearch
;
3329 G.postRedisplay "outline ctrl-n";
3330 coe {< m_first
= 0; m_active
= 0 >}
3333 let active = source#calcactive
(getanchor
()) in
3334 let first = firstof m_first
active in
3335 G.postRedisplay "outline ctrl-s";
3336 coe {< m_first
= first; m_active
= active >}
3339 G.postRedisplay "outline ctrl-u";
3340 if m_autonarrow
&& nonemptystr m_qsearch
3342 ignore
(source#renarrow
);
3343 settext m_autonarrow
E.s;
3344 coe {< m_first
= 0; m_active
= 0; m_qsearch
= E.s >}
3347 source#del_narrow_pattern
;
3348 let pattern = source#renarrow
in
3350 if emptystr
pattern then E.s else "Narrowed to " ^
pattern
3352 settext m_autonarrow
text;
3353 coe {< m_first
= 0; m_active
= 0; m_qsearch
= E.s >}
3357 let first = max
0 (m_active
- (fstate
.maxrows / 2)) in
3358 G.postRedisplay "outline ctrl-l";
3359 coe {< m_first
= first >}
3361 | @tab
when m_autonarrow
->
3362 if nonemptystr m_qsearch
3364 G.postRedisplay "outline list view tab";
3365 source#add_narrow_pattern m_qsearch
;
3367 coe {< m_qsearch
= E.s >}
3371 | @escape
when m_autonarrow
->
3372 if nonemptystr m_qsearch
3373 then source#add_narrow_pattern m_qsearch
;
3376 | @enter
| @kpenter
when m_autonarrow
->
3377 if nonemptystr m_qsearch
3378 then source#add_narrow_pattern m_qsearch
;
3381 | key when m_autonarrow
&& (key != 0 && key land 0xff00 != 0xff00) ->
3382 let pattern = m_qsearch ^ toutf8
key in
3383 G.postRedisplay "outlinelistview autonarrow add";
3384 source#narrow
pattern;
3385 settext true pattern;
3386 coe {< m_first
= 0; m_active
= 0; m_qsearch
= pattern >}
3388 | key when m_autonarrow
&& key = @backspace
->
3389 if emptystr m_qsearch
3392 let pattern = withoutlastutf8 m_qsearch
in
3393 G.postRedisplay "outlinelistview autonarrow backspace";
3394 ignore
(source#renarrow
);
3395 source#narrow
pattern;
3396 settext true pattern;
3397 coe {< m_first
= 0; m_active
= 0; m_qsearch
= pattern >}
3399 | @delete
| @kpdelete
->
3400 source#remove m_active
;
3401 G.postRedisplay "outline delete";
3402 let active = max
0 (m_active
-1) in
3403 coe {< m_first
= firstof m_first
active;
3404 m_active
= active >}
3406 | @up
| @kpup
when ctrl ->
3407 navscroll (max
0 (m_first
- 1))
3409 | @down
| @kpdown
when ctrl ->
3410 navscroll (min
(source#getitemcount
- 1) (m_first
+ 1))
3412 | @up
| @kpup
-> navigate ~
-1
3413 | @down
| @kpdown
-> navigate 1
3414 | @prior
| @kpprior
-> navigate ~
-(fstate
.maxrows)
3415 | @next | @kpnext
-> navigate fstate
.maxrows
3417 | @right
| @kpright
->
3421 G.postRedisplay "outline ctrl right";
3422 {< m_pan
= m_pan
+ 1 >}
3424 else self#updownlevel
1
3428 | @left | @kpleft
->
3432 G.postRedisplay "outline ctrl left";
3433 {< m_pan
= m_pan
- 1 >}
3435 else self#updownlevel ~
-1
3439 | @home
| @kphome
->
3440 G.postRedisplay "outline home";
3441 coe {< m_first
= 0; m_active
= 0 >}
3444 let active = source#getitemcount
- 1 in
3445 let first = max
0 (active - fstate
.maxrows) in
3446 G.postRedisplay "outline end";
3447 coe {< m_active
= active; m_first
= first >}
3449 | _ -> super#
key key mask
3452 let genhistoutlines =
3453 let order ty
(p1
, c1
, _, _, _) (p2
, c2
, _, _, _) =
3455 | `lastvisit
-> compare c1
.lastvisit c2
.lastvisit
3456 | `path
-> compare p2 p1
3457 | `file
-> compare
(Filename.basename p2
) (Filename.basename p1
)
3459 let e1 = emptystr c1
.title
3460 and e2
= emptystr c2
.title
in
3462 then compare
(Filename.basename p2
) (Filename.basename p1
)
3465 else compare c1
.title c2
.title
3467 let showfullpath = ref false in
3470 let s = if orderty
= t
then "[@Uradical] " ^
s else "[ ] " ^
s in
3471 s, 0, Oaction
(fun () -> Config.historder
:= t
; reeenterhist := true)
3473 let list = ref [] in
3474 if Config.gethist
list
3478 (fun accu (path
, c, b, x, a) ->
3479 let hist = (path
, (c, b, x, a)) in
3480 let s = if !showfullpath then path
else Filename.basename path
in
3481 let base = mbtoutf8
s in
3482 (base ^
"\000" ^
c.title
, 1, Ohistory
hist) :: accu
3484 [ setorty "Sort by time of last visit" `lastvisit
;
3485 setorty "Sort by file name" `file
;
3486 setorty "Sort by path" `path
;
3487 setorty "Sort by title" `title
;
3488 (if !showfullpath then "@Uradical "
3489 else " ") ^
"Show full path", 0, Oaction
(fun () ->
3490 showfullpath := not
!showfullpath; reeenterhist := true)
3491 ] (List.sort
(order orderty
) !list)
3497 let gotohist (path
, (c, bookmarks
, x, anchor)) =
3498 Config.save
leavebirdseye;
3499 state
.anchor <- anchor;
3501 state
.bookmarks
<- bookmarks
;
3502 state
.origin
<- E.s;
3504 let x0, y0, x1, y1 = conf
.trimfuzz
in
3505 wcmd "trimset %d %d %d %d %d" (btod conf
.trimmargins
) x0 y0 x1 y1;
3509 let makecheckers () =
3510 (* Based on lablGL-1.04/LablGlut/examples/lablGL/checker.ml which had
3512 converted by Issac Trotts. July 25, 2002 *)
3513 let image = GlPix.create `ubyte ~format
:`luminance ~width
:2 ~height
:2 in
3514 Raw.sets_string
(GlPix.to_raw
image) ~
pos:0 "\255\200\200\255";
3515 let id = GlTex.gen_texture
() in
3516 GlTex.bind_texture ~target
:`texture_2d
id;
3517 GlPix.store
(`unpack_alignment
1);
3518 GlTex.image2d
image;
3519 List.iter
(GlTex.parameter ~target
:`texture_2d
)
3520 [ `mag_filter `nearest
; `min_filter `nearest
];
3524 let setcheckers enabled
=
3525 match state
.checkerstexid
with
3527 if enabled
then state
.checkerstexid
<- Some
(makecheckers ())
3529 | Some checkerstexid
->
3532 GlTex.delete_texture checkerstexid
;
3533 state
.checkerstexid
<- None
;
3537 let describe_location () =
3538 let fn = page_of_y state
.y in
3539 let ln = page_of_y
(state
.y + state
.winh
- hscrollh () - 1) in
3540 let maxy = state
.maxy - (if conf
.maxhfit
then state
.winh
else 0) in
3544 else (100. *. (float state
.y /. float maxy))
3548 Printf.sprintf
"page %d of %d [%.2f%%]"
3549 (fn+1) state
.pagecount
percent
3552 "pages %d-%d of %d [%.2f%%]"
3553 (fn+1) (ln+1) state
.pagecount
percent
3556 let setpresentationmode v
=
3557 let n = page_of_y state
.y in
3558 state
.anchor <- (n, 0.0, 1.0);
3559 conf
.presentation
<- v
;
3560 if conf
.fitmodel
= FitPage
3561 then reqlayout conf
.angle conf
.fitmodel
;
3566 let btos b = if b then "@Uradical" else E.s in
3567 let showextended = ref false in
3568 let leave mode
_ = state
.mode
<- mode
in
3571 val mutable m_first_time
= true
3572 val mutable m_l
= []
3573 val mutable m_a
= E.a
3574 val mutable m_prev_uioh
= nouioh
3575 val mutable m_prev_mode
= View
3577 inherit lvsourcebase
3579 method reset prev_mode prev_uioh
=
3580 m_a
<- Array.of_list
(List.rev m_l
);
3582 m_prev_mode
<- prev_mode
;
3583 m_prev_uioh
<- prev_uioh
;
3587 if n >= Array.length m_a
3591 | _, _, _, Action
_ -> m_active
<- n
3592 | _, _, _, Noaction
-> loop (n+1)
3595 m_first_time
<- false;
3598 method int name get
set =
3600 (name
, `
int get
, 1, Action
(
3603 try set (int_of_string
s)
3605 state
.text <- Printf.sprintf
"bad integer `%s': %s"
3609 let te = name ^
": ", E.s, None
, intentry, ondone, true in
3610 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3614 method int_with_suffix name get
set =
3616 (name
, `intws get
, 1, Action
(
3619 try set (int_of_string_with_suffix
s)
3621 state
.text <- Printf.sprintf
"bad integer `%s': %s"
3626 name ^
": ", E.s, None
, intentry_with_suffix, ondone, true
3628 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3632 method bool ?
(offset
=1) ?
(btos=btos) name get
set =
3634 (name
, `
bool (btos, get
), offset
, Action
(
3641 method color name get
set =
3643 (name
, `color get
, 1, Action
(
3645 let invalid = (nan
, nan
, nan
) in
3648 try color_of_string
s
3650 state
.text <- Printf.sprintf
"bad color `%s': %s"
3657 let te = name ^
": ", E.s, None
, textentry, ondone, true in
3658 state
.text <- color_to_string
(get
());
3659 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3663 method string name get
set =
3665 (name
, `
string get
, 1, Action
(
3667 let ondone s = set s in
3668 let te = name ^
": ", E.s, None
, textentry, ondone, true in
3669 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3673 method colorspace name get
set =
3675 (name
, `
string get
, 1, Action
(
3679 inherit lvsourcebase
3682 m_active
<- CSTE.to_int conf
.colorspace
;
3685 method getitemcount
=
3686 Array.length
CSTE.names
3689 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3690 ignore
(uioh
, first, pan
);
3691 if not cancel
then set active;
3693 method hasaction
_ = true
3697 let modehash = findkeyhash conf
"info" in
3698 coe (new listview ~zebra
:false ~helpmode
:false
3699 ~
source ~trusted
:true ~
modehash)
3702 method paxmark name get
set =
3704 (name
, `
string get
, 1, Action
(
3708 inherit lvsourcebase
3711 m_active
<- MTE.to_int conf
.paxmark
;
3714 method getitemcount
= Array.length
MTE.names
3715 method getitem
n = (MTE.names
.(n), 0)
3716 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3717 ignore
(uioh
, first, pan
);
3718 if not cancel
then set active;
3720 method hasaction
_ = true
3724 let modehash = findkeyhash conf
"info" in
3725 coe (new listview ~zebra
:false ~helpmode
:false
3726 ~
source ~trusted
:true ~
modehash)
3729 method fitmodel name get
set =
3731 (name
, `
string get
, 1, Action
(
3735 inherit lvsourcebase
3738 m_active
<- FMTE.to_int conf
.fitmodel
;
3741 method getitemcount
= Array.length
FMTE.names
3742 method getitem
n = (FMTE.names
.(n), 0)
3743 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3744 ignore
(uioh
, first, pan
);
3745 if not cancel
then set active;
3747 method hasaction
_ = true
3751 let modehash = findkeyhash conf
"info" in
3752 coe (new listview ~zebra
:false ~helpmode
:false
3753 ~
source ~trusted
:true ~
modehash)
3756 method caption
s offset
=
3757 m_l
<- (s, `empty
, offset
, Noaction
) :: m_l
3759 method caption2
s f offset
=
3760 m_l
<- (s, `
string f, offset
, Noaction
) :: m_l
3762 method getitemcount
= Array.length m_a
3765 let tostr = function
3766 | `
int f -> string_of_int
(f ())
3767 | `intws
f -> string_with_suffix_of_int
(f ())
3769 | `color
f -> color_to_string
(f ())
3770 | `
bool (btos, f) -> btos (f ())
3773 let name, t
, offset
, _ = m_a
.(n) in
3774 ((let s = tostr t
in
3776 then Printf.sprintf
"%s\t%s" name s
3780 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3785 match m_a
.(active) with
3786 | _, _, _, Action
f -> f uioh
3787 | _, _, _, Noaction
-> uioh
3798 method hasaction
n =
3800 | _, _, _, Action
_ -> true
3801 | _, _, _, Noaction
-> false
3804 let rec fillsrc prevmode prevuioh
=
3805 let sep () = src#caption
E.s 0 in
3806 let colorp name get
set =
3808 (fun () -> color_to_string
(get
()))
3811 let c = color_of_string
v in
3814 state
.text <- Printf.sprintf
"bad color `%s': %s" v (exntos exn
)
3817 let oldmode = state
.mode
in
3818 let birdseye = isbirdseye state
.mode
in
3820 src#caption
(if birdseye then "Setup (Bird's eye)" else "Setup") 0;
3822 src#
bool "presentation mode"
3823 (fun () -> conf
.presentation
)
3824 (fun v -> setpresentationmode v);
3826 src#
bool "ignore case in searches"
3827 (fun () -> conf
.icase
)
3828 (fun v -> conf
.icase
<- v);
3831 (fun () -> conf
.preload)
3832 (fun v -> conf
.preload <- v);
3834 src#
bool "highlight links"
3835 (fun () -> conf
.hlinks
)
3836 (fun v -> conf
.hlinks
<- v);
3838 src#
bool "under info"
3839 (fun () -> conf
.underinfo
)
3840 (fun v -> conf
.underinfo
<- v);
3842 src#
bool "persistent bookmarks"
3843 (fun () -> conf
.savebmarks
)
3844 (fun v -> conf
.savebmarks
<- v);
3846 src#fitmodel
"fit model"
3847 (fun () -> FMTE.to_string conf
.fitmodel
)
3848 (fun v -> reqlayout conf
.angle
(FMTE.of_int
v));
3850 src#
bool "trim margins"
3851 (fun () -> conf
.trimmargins
)
3852 (fun v -> settrim v conf
.trimfuzz
; fillsrc prevmode prevuioh
);
3854 src#
bool "persistent location"
3855 (fun () -> conf
.jumpback
)
3856 (fun v -> conf
.jumpback
<- v);
3859 src#
int "inter-page space"
3860 (fun () -> conf
.interpagespace
)
3862 conf
.interpagespace
<- n;
3863 docolumns conf
.columns
;
3865 match state
.layout with
3870 state
.maxy <- calcheight
();
3871 let y = getpagey
pageno in
3876 (fun () -> conf
.pagebias
)
3877 (fun v -> conf
.pagebias
<- v);
3879 src#
int "scroll step"
3880 (fun () -> conf
.scrollstep
)
3881 (fun n -> conf
.scrollstep
<- n);
3883 src#
int "horizontal scroll step"
3884 (fun () -> conf
.hscrollstep
)
3885 (fun v -> conf
.hscrollstep
<- v);
3887 src#
int "auto scroll step"
3889 match state
.autoscroll
with
3891 | _ -> conf
.autoscrollstep
)
3893 let n = boundastep state
.winh
n in
3894 if state
.autoscroll
<> None
3895 then state
.autoscroll
<- Some
n;
3896 conf
.autoscrollstep
<- n);
3899 (fun () -> truncate
(conf
.zoom *. 100.))
3900 (fun v -> setzoom ((float v) /. 100.));
3903 (fun () -> conf
.angle
)
3904 (fun v -> reqlayout v conf
.fitmodel
);
3906 src#
int "scroll bar width"
3907 (fun () -> conf
.scrollbw
)
3910 reshape state
.winw state
.winh
;
3913 src#
int "scroll handle height"
3914 (fun () -> conf
.scrollh
)
3915 (fun v -> conf
.scrollh
<- v;);
3917 src#
int "thumbnail width"
3918 (fun () -> conf
.thumbw
)
3920 conf
.thumbw
<- min
4096 v;
3923 leavebirdseye beye
false;
3930 let mode = state
.mode in
3931 src#
string "columns"
3933 match conf
.columns
with
3935 | Cmulti
(multi
, _) -> multicolumns_to_string multi
3936 | Csplit
(count
, _) -> "-" ^ string_of_int count
3939 let n, a, b = multicolumns_of_string
v in
3940 setcolumns mode n a b);
3943 src#caption
"Pixmap cache" 0;
3944 src#int_with_suffix
"size (advisory)"
3945 (fun () -> conf
.memlimit
)
3946 (fun v -> conf
.memlimit
<- v);
3949 (fun () -> Printf.sprintf
"%s bytes, %d tiles"
3950 (string_with_suffix_of_int state
.memused
)
3951 (Hashtbl.length state
.tilemap
)) 1;
3954 src#caption
"Layout" 0;
3955 src#caption2
"Dimension"
3957 Printf.sprintf
"%dx%d (virtual %dx%d)"
3958 state
.winw state
.winh
3963 src#caption2
"Position" (fun () ->
3964 Printf.sprintf
"%dx%d" state
.x state
.y
3967 src#caption2
"Position" (fun () -> describe_location ()) 1
3971 src#
bool ~offset
:0 ~
btos:(fun v -> if v then "(on)" else "(off)")
3972 "Save these parameters as global defaults at exit"
3973 (fun () -> conf
.bedefault
)
3974 (fun v -> conf
.bedefault
<- v)
3978 let btos b = if b then "@Ulguillemet" else "@Urguillemet" in
3979 src#
bool ~offset
:0 ~
btos "Extended parameters"
3980 (fun () -> !showextended)
3981 (fun v -> showextended := v; fillsrc prevmode prevuioh
);
3985 (fun () -> conf
.checkers
)
3986 (fun v -> conf
.checkers
<- v; setcheckers v);
3987 src#
bool "update cursor"
3988 (fun () -> conf
.updatecurs
)
3989 (fun v -> conf
.updatecurs
<- v);
3990 src#
bool "scroll-bar on the left"
3991 (fun () -> conf
.leftscroll
)
3992 (fun v -> conf
.leftscroll
<- v);
3994 (fun () -> conf
.verbose
)
3995 (fun v -> conf
.verbose
<- v);
3996 src#
bool "invert colors"
3997 (fun () -> conf
.invert
)
3998 (fun v -> conf
.invert
<- v);
4000 (fun () -> conf
.maxhfit
)
4001 (fun v -> conf
.maxhfit
<- v);
4002 src#
bool "redirect stderr"
4003 (fun () -> conf
.redirectstderr)
4004 (fun v -> conf
.redirectstderr <- v; redirectstderr ());
4006 (fun () -> conf
.pax
!= None
)
4009 then conf
.pax
<- Some
(ref (now
(), 0, 0))
4010 else conf
.pax
<- None
);
4011 src#
string "uri launcher"
4012 (fun () -> conf
.urilauncher
)
4013 (fun v -> conf
.urilauncher
<- v);
4014 src#
string "path launcher"
4015 (fun () -> conf
.pathlauncher
)
4016 (fun v -> conf
.pathlauncher
<- v);
4017 src#
string "tile size"
4018 (fun () -> Printf.sprintf
"%dx%d" conf
.tilew conf
.tileh
)
4021 let w, h = Scanf.sscanf
v "%dx%d" (fun w h -> w, h) in
4022 conf
.tilew
<- max
64 w;
4023 conf
.tileh
<- max
64 h;
4026 state
.text <- Printf.sprintf
"bad tile size `%s': %s"
4029 src#
int "texture count"
4030 (fun () -> conf
.texcount
)
4033 then conf
.texcount
<- v
4034 else showtext '
!'
" Failed to set texture count please retry later"
4036 src#
int "slice height"
4037 (fun () -> conf
.sliceheight
)
4039 conf
.sliceheight
<- v;
4040 wcmd "sliceh %d" conf
.sliceheight
;
4042 src#
int "anti-aliasing level"
4043 (fun () -> conf
.aalevel
)
4045 conf
.aalevel
<- bound
v 0 8;
4046 state
.anchor <- getanchor
();
4047 opendoc state
.path state
.password;
4049 src#
string "page scroll scaling factor"
4050 (fun () -> string_of_float conf
.pgscale)
4053 let s = float_of_string
v in
4056 state
.text <- Printf.sprintf
4057 "bad page scroll scaling factor `%s': %s" v (exntos exn
)
4060 src#
int "ui font size"
4061 (fun () -> fstate
.fontsize
)
4062 (fun v -> setfontsize (bound
v 5 100));
4063 src#
int "hint font size"
4064 (fun () -> conf
.hfsize
)
4065 (fun v -> conf
.hfsize
<- bound
v 5 100);
4066 colorp "background color"
4067 (fun () -> conf
.bgcolor
)
4068 (fun v -> conf
.bgcolor
<- v);
4069 src#
bool "crop hack"
4070 (fun () -> conf
.crophack
)
4071 (fun v -> conf
.crophack
<- v);
4072 src#
string "trim fuzz"
4073 (fun () -> irect_to_string conf
.trimfuzz
)
4076 conf
.trimfuzz
<- irect_of_string
v;
4078 then settrim true conf
.trimfuzz
;
4080 state
.text <- Printf.sprintf
"bad irect `%s': %s" v (exntos exn
)
4082 src#
string "throttle"
4084 match conf
.maxwait
with
4085 | None
-> "show place holder if page is not ready"
4088 then "wait for page to fully render"
4090 "wait " ^ string_of_float
time
4091 ^
" seconds before showing placeholder"
4095 let f = float_of_string
v in
4097 then conf
.maxwait
<- None
4098 else conf
.maxwait
<- Some
f
4100 state
.text <- Printf.sprintf
"bad time `%s': %s" v (exntos exn
)
4102 src#
string "ghyll scroll"
4104 match conf
.ghyllscroll
with
4106 | Some nab
-> ghyllscroll_to_string nab
4109 try conf
.ghyllscroll
<- ghyllscroll_of_string
v
4111 state
.text <- Printf.sprintf
"bad ghyll `%s': %s" v (exntos exn
)
4113 src#
string "selection command"
4114 (fun () -> conf
.selcmd
)
4115 (fun v -> conf
.selcmd
<- v);
4116 src#
string "synctex command"
4117 (fun () -> conf
.stcmd
)
4118 (fun v -> conf
.stcmd
<- v);
4119 src#
string "pax command"
4120 (fun () -> conf
.paxcmd
)
4121 (fun v -> conf
.paxcmd
<- v);
4122 src#
string "ask password command"
4123 (fun () -> conf
.passcmd)
4124 (fun v -> conf
.passcmd <- v);
4125 src#
string "save path command"
4126 (fun () -> conf
.savecmd
)
4127 (fun v -> conf
.savecmd
<- v);
4128 src#colorspace
"color space"
4129 (fun () -> CSTE.to_string conf
.colorspace
)
4131 conf
.colorspace
<- CSTE.of_int
v;
4135 src#paxmark
"pax mark method"
4136 (fun () -> MTE.to_string conf
.paxmark
)
4137 (fun v -> conf
.paxmark
<- MTE.of_int
v);
4141 (fun () -> conf
.usepbo
)
4142 (fun v -> conf
.usepbo
<- v);
4143 src#
bool "mouse wheel scrolls pages"
4144 (fun () -> conf
.wheelbypage
)
4145 (fun v -> conf
.wheelbypage
<- v);
4146 src#
bool "open remote links in a new instance"
4147 (fun () -> conf
.riani
)
4148 (fun v -> conf
.riani
<- v);
4152 src#caption
"Document" 0;
4153 List.iter
(fun (_, s) -> src#caption
s 1) state
.docinfo
;
4154 src#caption2
"Pages"
4155 (fun () -> string_of_int state
.pagecount
) 1;
4156 src#caption2
"Dimensions"
4157 (fun () -> string_of_int
(List.length state
.pdims
)) 1;
4161 src#caption
"Trimmed margins" 0;
4162 src#caption2
"Dimensions"
4163 (fun () -> string_of_int
(List.length state
.pdims
)) 1;
4167 src#caption
"OpenGL" 0;
4168 src#caption
(Printf.sprintf
"Vendor\t%s" (GlMisc.get_string `vendor
)) 1;
4169 src#caption
(Printf.sprintf
"Renderer\t%s" (GlMisc.get_string `renderer
)) 1;
4172 src#caption
"Location" 0;
4173 if nonemptystr state
.origin
4174 then src#caption
("Orign\t" ^ mbtoutf8 state
.origin
) 1;
4175 src#caption
("Path\t" ^ mbtoutf8 state
.path
) 1;
4177 src#reset prevmode prevuioh
;
4182 let prevmode = state
.mode
4183 and prevuioh
= state
.uioh in
4184 fillsrc prevmode prevuioh
;
4185 let source = (src :> lvsource
) in
4186 let modehash = findkeyhash conf
"info" in
4187 state
.uioh <- coe (object (self)
4188 inherit listview ~zebra
:false ~helpmode
:false
4189 ~
source ~trusted
:true ~
modehash as super
4190 val mutable m_prevmemused
= 0
4191 method! infochanged
= function
4193 if m_prevmemused
!= state
.memused
4195 m_prevmemused
<- state
.memused
;
4196 G.postRedisplay "memusedchanged";
4198 | Pdim
-> G.postRedisplay "pdimchanged"
4199 | Docinfo
-> fillsrc prevmode prevuioh
4201 method! key key mask
=
4202 if not
(Wsi.withctrl mask
)
4205 | @left | @kpleft
-> coe (self#updownlevel ~
-1)
4206 | @right
| @kpright
-> coe (self#updownlevel
1)
4207 | _ -> super#
key key mask
4208 else super#
key key mask
4210 G.postRedisplay "info";
4216 inherit lvsourcebase
4217 method getitemcount
= Array.length state
.help
4219 let s, l, _ = state
.help
.(n) in
4222 method exit ~
uioh ~cancel ~
active ~
first ~pan
=
4226 match state
.help
.(active) with
4227 | _, _, Action
f -> Some
(f uioh)
4228 | _, _, Noaction
-> Some
uioh
4237 method hasaction
n =
4238 match state
.help
.(n) with
4239 | _, _, Action
_ -> true
4240 | _, _, Noaction
-> false
4246 let modehash = findkeyhash conf
"help" in
4248 state
.uioh <- coe (new listview
4249 ~zebra
:false ~helpmode
:true
4250 ~
source ~trusted
:true ~
modehash);
4251 G.postRedisplay "help";
4257 inherit lvsourcebase
4258 val mutable m_items
= E.a
4260 method getitemcount
= 1 + Array.length m_items
4265 else m_items
.(n-1), 0
4267 method exit ~
uioh ~cancel ~
active ~
first ~pan
=
4272 then Buffer.clear state
.errmsgs
;
4279 method hasaction
n =
4283 state
.newerrmsgs
<- false;
4284 let l = Str.split newlinere
(Buffer.contents state
.errmsgs
) in
4285 m_items
<- Array.of_list
l
4294 let source = (msgsource :> lvsource
) in
4295 let modehash = findkeyhash conf
"listview" in
4296 state
.uioh <- coe (object
4297 inherit listview ~zebra
:false ~helpmode
:false
4298 ~
source ~trusted
:false ~
modehash as super
4301 then msgsource#reset
;
4304 G.postRedisplay "msgs";
4307 let enterannotmode =
4310 inherit lvsourcebase
4311 val mutable m_text
= E.s
4312 val mutable m_items
= E.a
4314 method getitemcount
= 1 + Array.length m_items
4317 if n = Array.length m_items
4318 then "[Copy text to the clipboard]", 0
4321 method exit ~
uioh ~cancel ~
active ~
first ~pan
=
4322 ignore
(uioh, first, pan
);
4323 if not cancel
&& active = Array.length m_items
4324 then selstring m_text
;
4327 method hasaction
_ = true
4330 let rec split accu b i
=
4332 if p = String.length
s
4333 then String.sub
s b (p-b) :: accu
4335 if (i
> 70 && s.[p] = ' '
) || s.[p] = '
\r'
|| s.[p] = '
\n'
4337 let ss = if i
= 0 then E.s else String.sub
s b i
in
4338 split (ss::accu) (p+1) 0
4343 m_items
<- split [] 0 0 |> List.rev
|> Array.of_list
4352 let source = (msgsource :> lvsource
) in
4353 let modehash = findkeyhash conf
"listview" in
4354 state
.uioh <- coe (object
4355 inherit listview ~zebra
:false ~helpmode
:false
4356 ~
source ~trusted
:false ~
modehash
4358 G.postRedisplay "annot";
4361 let gotounder under =
4362 let getpath filename
=
4364 if nonemptystr filename
4366 if Filename.is_relative filename
4368 let dir = Filename.dirname state
.path in
4370 if Filename.is_implicit
dir
4371 then Filename.concat
(Sys.getcwd
()) dir
4374 Filename.concat
dir filename
4378 if Sys.file_exists
path
4383 | Ulinkgoto
(pageno, top) ->
4387 gotopage1 pageno top;
4393 | Uremote
(filename
, pageno) ->
4394 let path = getpath filename
in
4399 let command = Printf.sprintf
"%s -page %d %S" !selfexec pageno path in
4400 try addpid @@ popen
command []
4402 Printf.eprintf
"failed to execute `%s': %s\n" command (exntos exn
);
4405 let anchor = getanchor
() in
4406 let ranchor = state
.path, state
.password, anchor, state
.origin
in
4407 state
.origin
<- E.s;
4408 state
.anchor <- (pageno, 0.0, 0.0);
4409 state
.ranchors
<- ranchor :: state
.ranchors
;
4412 else showtext '
!'
("Could not find " ^ filename
)
4414 | Uremotedest
(filename
, destname
) ->
4415 let path = getpath filename
in
4420 let command = !selfexec ^
" " ^
path ^
" -dest " ^ destname
in
4421 try addpid @@ popen
command []
4424 "failed to execute `%s': %s\n" command (exntos exn
);
4427 let anchor = getanchor
() in
4428 let ranchor = state
.path, state
.password, anchor, state
.origin
in
4429 state
.origin
<- E.s;
4430 state
.nameddest
<- destname
;
4431 state
.ranchors
<- ranchor :: state
.ranchors
;
4434 else showtext '
!'
("Could not find " ^ filename
)
4436 | Uunexpected
_ | Ulaunch
_ | Unamed
_ | Utext
_ | Unone
-> ()
4437 | Uannotation annot
-> enterannotmode annot
4440 let gotooutline (_, _, kind
) =
4444 let (pageno, y, _) = anchor in
4446 (if conf
.presentation
then (pageno, y, 1.0) else anchor)
4450 | Ouri
uri -> gotounder (Ulinkuri
uri)
4451 | Olaunch cmd
-> gotounder (Ulaunch cmd
)
4452 | Oremote remote
-> gotounder (Uremote remote
)
4453 | Ohistory
hist -> gotohist hist
4454 | Oremotedest remotedest
-> gotounder (Uremotedest remotedest
)
4458 let outlinesource sourcetype
=
4460 inherit lvsourcebase
4461 val mutable m_items
= E.a
4462 val mutable m_minfo
= E.a
4463 val mutable m_orig_items
= E.a
4464 val mutable m_orig_minfo
= E.a
4465 val mutable m_narrow_patterns
= []
4466 val mutable m_hadremovals
= false
4467 val mutable m_gen
= -1
4469 method getitemcount
=
4470 Array.length m_items
+ (if m_hadremovals
then 1 else 0)
4473 if n == Array.length m_items
&& m_hadremovals
4475 ("[Confirm removal]", 0)
4477 let s, n, _ = m_items
.(n) in
4480 method exit ~
uioh ~cancel ~
active ~
first ~pan
=
4481 ignore
(uioh, first);
4482 let confrimremoval = m_hadremovals
&& active = Array.length m_items
in
4484 if m_narrow_patterns
= []
4485 then m_orig_items
, m_orig_minfo
4486 else m_items
, m_minfo
4490 if not
confrimremoval
4492 gotooutline m_items
.(active);
4497 state
.bookmarks
<- Array.to_list m_items
;
4498 m_orig_items
<- m_items
;
4499 m_orig_minfo
<- m_minfo
;
4509 method hasaction
_ = true
4512 if Array.length m_items
!= Array.length m_orig_items
4515 match m_narrow_patterns
with
4517 | many
-> String.concat
"@Uellipsis" (List.rev many
)
4519 "Narrowed to " ^
s ^
" (ctrl-u to restore)"
4523 match m_narrow_patterns
with
4526 | head
:: _ -> "@Uellipsis" ^ head
4528 method narrow
pattern =
4529 let reopt = try Some
(Str.regexp_case_fold
pattern) with _ -> None
in
4533 let rec loop accu minfo n =
4536 m_items
<- Array.of_list
accu;
4537 m_minfo
<- Array.of_list
minfo;
4540 let (s, _, t
) as o = m_items
.(n) in
4543 | Oaction
_ -> o :: accu, (0, 0) :: minfo
4544 | Onone
| Oanchor
_ | Ouri
_ | Olaunch
_
4545 | Oremote
_ | Oremotedest
_ | Ohistory
_ ->
4547 try Str.search_forward
re s 0
4548 with Not_found
-> -1
4551 then o :: accu, (first, Str.match_end
()) :: minfo
4554 loop accu minfo (n-1)
4556 loop [] [] (Array.length m_items
- 1)
4558 method! getminfo
= m_minfo
4562 match sourcetype
with
4563 | `bookmarks
-> Array.of_list state
.bookmarks
4564 | `outlines
-> state
.outlines
4565 | `history
-> genhistoutlines !Config.historder
4567 m_minfo
<- m_orig_minfo
;
4568 m_items
<- m_orig_items
4571 if sourcetype
= `bookmarks
4573 if m >= 0 && m < Array.length m_items
4575 m_hadremovals
<- true;
4576 m_items
<- Array.init
(Array.length m_items
- 1) (fun n ->
4577 let n = if n >= m then n+1 else n in
4582 method add_narrow_pattern
pattern =
4583 m_narrow_patterns
<- pattern :: m_narrow_patterns
4585 method del_narrow_pattern
=
4586 match m_narrow_patterns
with
4587 | _ :: rest
-> m_narrow_patterns
<- rest
4592 match m_narrow_patterns
with
4593 | pattern :: [] -> self#narrow
pattern; pattern
4595 List.fold_left
(fun accu pattern ->
4596 self#narrow
pattern;
4597 pattern ^
"@Uellipsis" ^
accu) E.s list
4599 method calcactive
anchor =
4600 let rely = getanchory anchor in
4601 let rec loop n best bestd
=
4602 if n = Array.length m_items
4605 let _, _, kind
= m_items
.(n) in
4608 let orely = getanchory anchor in
4609 let d = abs
(orely - rely) in
4612 else loop (n+1) best bestd
4613 | Onone
| Oremote
_ | Olaunch
_
4614 | Oremotedest
_ | Ouri
_ | Ohistory
_ | Oaction
_ ->
4615 loop (n+1) best bestd
4619 method reset
anchor items =
4620 m_hadremovals
<- false;
4621 if state
.gen
!= m_gen
4623 m_orig_items
<- items;
4625 m_narrow_patterns
<- [];
4627 m_orig_minfo
<- E.a;
4631 if items != m_orig_items
4633 m_orig_items
<- items;
4634 if m_narrow_patterns
== []
4635 then m_items
<- items;
4638 let active = self#calcactive
anchor in
4640 m_first
<- firstof m_first
active
4644 let enterselector sourcetype
=
4646 let source = outlinesource sourcetype
in
4649 match sourcetype
with
4650 | `bookmarks
-> Array.of_list state
.bookmarks
4651 | `
outlines -> state
.outlines
4652 | `history
-> genhistoutlines !Config.historder
4654 if Array.length
outlines = 0
4656 showtext ' ' errmsg
;
4659 state
.text <- source#greetmsg
;
4660 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
4661 let anchor = getanchor
() in
4662 source#reset
anchor outlines;
4664 coe (new outlinelistview ~zebra
:(sourcetype
=`history
) ~
source);
4665 G.postRedisplay "enter selector";
4669 let enteroutlinemode =
4670 let f = enterselector `
outlines in
4671 fun () -> f "Document has no outline";
4674 let enterbookmarkmode =
4675 let f = enterselector `bookmarks
in
4676 fun () -> f "Document has no bookmarks (yet)";
4679 let enterhistmode () = enterselector `history
"No history (yet)";;
4681 let quickbookmark ?title
() =
4682 match state
.layout with
4688 let tm = Unix.localtime
(now
()) in
4689 Printf.sprintf
"Quick (page %d) (bookmarked at %d/%d/%d %d:%d)"
4693 (tm.Unix.tm_year
+ 1900)
4696 | Some
title -> title
4698 state
.bookmarks
<- (title, 0, Oanchor
(getanchor1
l)) :: state
.bookmarks
4701 let setautoscrollspeed step goingdown
=
4702 let incr = max
1 ((abs step
) / 2) in
4703 let incr = if goingdown
then incr else -incr in
4704 let astep = boundastep state
.winh
(step
+ incr) in
4705 state
.autoscroll
<- Some
astep;
4709 match conf
.columns
with
4711 | Csingle
_ | Cmulti
_ -> state
.x != 0 || conf
.zoom > 1.0
4714 let panbound x = bound
x (-state
.w) (wadjsb () + state
.winw
);;
4716 let existsinrow pageno (columns
, coverA
, coverB
) p =
4717 let last = ((pageno - coverA
) mod columns
) + columns
in
4718 let rec any = function
4721 if l.pageno = coverA
- 1 || l.pageno = state
.pagecount
- coverB
4725 then (if l.pageno = last then false else any rest
)
4733 match state
.layout with
4735 let pageno = page_of_y state
.y in
4736 gotoghyll (getpagey
(pageno+1))
4738 match conf
.columns
with
4740 if conf
.presentation
&& rest
== [] && l.pageh
> l.pagey + l.pagevh
4742 let y = clamp (pgscale state
.winh
) in
4745 let pageno = min
(l.pageno+1) (state
.pagecount
-1) in
4746 gotoghyll (getpagey
pageno)
4747 | Cmulti
((c, _, _) as cl, _) ->
4748 if conf
.presentation
4749 && (existsinrow l.pageno cl
4750 (fun l -> l.pageh
> l.pagey + l.pagevh))
4752 let y = clamp (pgscale state
.winh
) in
4755 let pageno = min
(l.pageno+c) (state
.pagecount
-1) in
4756 gotoghyll (getpagey
pageno)
4758 if l.pageno < state
.pagecount
- 1 || l.pagecol
< n - 1
4760 let pagey, pageh
= getpageyh
l.pageno in
4761 let pagey = pagey + pageh
* l.pagecol
in
4762 let ips = if l.pagecol
= 0 then 0 else conf
.interpagespace
in
4763 gotoghyll (pagey + pageh
+ ips)
4767 match state
.layout with
4769 let pageno = page_of_y state
.y in
4770 gotoghyll (getpagey
(pageno-1))
4772 match conf
.columns
with
4774 if conf
.presentation
&& l.pagey != 0
4776 gotoghyll (clamp (pgscale ~
-(state
.winh
)))
4778 let pageno = max
0 (l.pageno-1) in
4779 gotoghyll (getpagey
pageno)
4780 | Cmulti
((c, _, coverB
) as cl, _) ->
4781 if conf
.presentation
&&
4782 (existsinrow l.pageno cl (fun l -> l.pagey != 0))
4784 gotoghyll (clamp (pgscale ~
-(state
.winh
)))
4787 if l.pageno = state
.pagecount
- coverB
4791 let pageno = max
0 (l.pageno-decr) in
4792 gotoghyll (getpagey
pageno)
4800 let pageno = max
0 (l.pageno-1) in
4801 let pagey, pageh
= getpageyh
pageno in
4804 let pagey, pageh
= getpageyh
l.pageno in
4805 pagey + pageh
* (l.pagecol
-1) - conf
.interpagespace
4810 let viewkeyboard key mask
=
4812 let mode = state
.mode in
4813 state
.mode <- Textentry
(te, fun _ -> state
.mode <- mode);
4816 G.postRedisplay "view:enttext"
4818 let ctrl = Wsi.withctrl mask
in
4820 if key >= 0xffb0 && key < 0xffb9 then key - 0xffb0 + 48 else key
4825 if conf
.angle
mod 360 = 0 && not
(isbirdseye state
.mode)
4827 state
.mode <- LinkNav
(Ltgendir
0);
4830 else showtext '
!'
"Keyboard link navigation does not work under rotation"
4833 begin match state
.mstate
with
4836 G.postRedisplay "kill rect";
4839 | Mscrolly
| Mscrollx
4842 begin match state
.mode with
4845 G.postRedisplay "esc leave linknav"
4849 match state
.ranchors
with
4851 | (path, password, anchor, origin
) :: rest
->
4852 state
.ranchors
<- rest
;
4853 state
.anchor <- anchor;
4854 state
.origin
<- origin
;
4855 state
.nameddest
<- E.s;
4856 opendoc path password
4861 gotoghyll (getnav ~
-1)
4872 Hashtbl.iter
(fun _ opaque -> clearmark
opaque) state
.pagemap
;
4873 G.postRedisplay "dehighlight";
4875 | @slash
| @question
->
4876 let ondone isforw
s =
4877 cbput state
.hists
.pat
s;
4878 state
.searchpattern
<- s;
4881 let s = String.make
1 (Char.chr
key) in
4882 enttext (s, E.s, Some
(onhist state
.hists
.pat
),
4883 textentry, ondone (key = @slash
), true)
4885 | @plus
| @kpplus
| @equals
when ctrl ->
4886 let incr = if conf
.zoom +. 0.01 > 0.1 then 0.1 else 0.01 in
4887 setzoom (conf
.zoom +. incr)
4889 | @plus
| @kpplus
->
4892 try int_of_string
s with exc
->
4893 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
);
4899 state
.text <- "page bias is now " ^ string_of_int
n;
4902 enttext ("page bias: ", E.s, None
, intentry, ondone, true)
4904 | @minus
| @kpminus
when ctrl ->
4905 let decr = if conf
.zoom -. 0.1 < 0.1 then 0.01 else 0.1 in
4906 setzoom (max
0.01 (conf
.zoom -. decr))
4908 | @minus
| @kpminus
->
4909 let ondone msg
= state
.text <- msg
in
4911 "option [acfhilpstvxACFPRSZTISM]: ", E.s, None
,
4912 optentry state
.mode, ondone, true
4923 | (@1 | @2) when ctrl && conf
.fitmodel
!= FitPage
-> (* ctrl-1/2 *)
4925 match conf
.columns
with
4926 | Csingle
_ | Cmulti
_ -> 1
4927 | Csplit
(n, _) -> n
4929 let h = state
.winh
-
4930 conf
.interpagespace
lsl (if conf
.presentation
then 1 else 0)
4932 let zoom = zoomforh state
.winw
h (vscrollw ()) cols in
4933 if zoom > 0.0 && (key = 50 || zoom < 1.0)
4938 match conf
.fitmodel
with
4939 | FitWidth
-> FitProportional
4940 | FitProportional
-> FitPage
4941 | FitPage
-> FitWidth
4943 state
.text <- "fit model: " ^
FMTE.to_string
fm;
4944 reqlayout conf
.angle
fm
4952 | (48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57)
4953 when not
ctrl -> (* 0..9 *)
4956 try int_of_string
s with exc
->
4957 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
);
4963 cbput state
.hists
.pag
(string_of_int
n);
4964 gotopage1 (n + conf
.pagebias
- 1) 0;
4967 let pageentry text key =
4968 match Char.unsafe_chr
key with
4969 | '
g'
-> TEdone
text
4970 | _ -> intentry text key
4972 let text = String.make
1 (Char.chr
key) in
4973 enttext (":", text, Some
(onhist state
.hists
.pag
),
4974 pageentry, ondone, true)
4977 conf
.scrollb
<- if conf
.scrollb
= 0 then (scrollbvv
lor scrollbhv
) else 0;
4978 reshape state
.winw state
.winh
;
4981 state
.bzoom
<- not state
.bzoom
;
4983 showtext ' '
("block zoom " ^
if state
.bzoom
then "on" else "off")
4986 conf
.hlinks
<- not conf
.hlinks
;
4987 state
.text <- "highlightlinks " ^
if conf
.hlinks
then "on" else "off";
4988 G.postRedisplay "toggle highlightlinks";
4991 state
.glinks
<- true;
4992 let mode = state
.mode in
4993 state
.mode <- Textentry
(
4994 (":", E.s, None
, linknentry, linkndone gotounder, false),
4996 state
.glinks
<- false;
5000 G.postRedisplay "view:linkent(F)"
5003 state
.glinks
<- true;
5004 let mode = state
.mode in
5005 state
.mode <- Textentry
(
5007 ":", E.s, None
, linknentry, linkndone (fun under ->
5008 selstring (undertext under);
5012 state
.glinks
<- false;
5016 G.postRedisplay "view:linkent"
5019 begin match state
.autoscroll
with
5021 conf
.autoscrollstep
<- step
;
5022 state
.autoscroll
<- None
5024 if conf
.autoscrollstep
= 0
5025 then state
.autoscroll
<- Some
1
5026 else state
.autoscroll
<- Some conf
.autoscrollstep
5033 setpresentationmode (not conf
.presentation
);
5034 showtext ' '
("presentation mode " ^
5035 if conf
.presentation
then "on" else "off");
5038 if List.mem
Wsi.Fullscreen state
.winstate
5039 then Wsi.reshape conf
.cwinw conf
.cwinh
5040 else Wsi.fullscreen
()
5043 search state
.searchpattern
false
5046 search state
.searchpattern
true
5049 begin match state
.layout with
5052 gotoghyll (getpagey
l.pageno)
5058 | @delete
| @kpdelete
-> (* delete *)
5062 showtext ' '
(describe_location ());
5065 begin match state
.layout with
5068 Wsi.reshape (l.pagew
+ vscrollw ()) l.pageh
;
5073 enterbookmarkmode ()
5081 | @e when Buffer.length state
.errmsgs
> 0 ->
5086 match state
.layout with
5091 (s, 0, Oanchor
(getanchor1
l)) :: state
.bookmarks
5094 enttext ("bookmark: ", E.s, None
, textentry, ondone, true)
5098 showtext ' '
"Quick bookmark added";
5101 begin match state
.layout with
5103 let rect = getpdimrect
l.pagedimno
in
5107 (truncate
(1.8 *. (rect.(1) -. rect.(0))),
5108 truncate
(1.2 *. (rect.(3) -. rect.(0))))
5110 (truncate
(rect.(1) -. rect.(0)),
5111 truncate
(rect.(3) -. rect.(0)))
5113 let w = truncate
((float w)*.conf
.zoom)
5114 and h = truncate
((float h)*.conf
.zoom) in
5117 state
.anchor <- getanchor
();
5118 Wsi.reshape (w + vscrollw ()) (h + conf
.interpagespace
)
5120 G.postRedisplay "z";
5125 | @x -> state
.roam
()
5128 reqlayout (conf
.angle
+
5129 (if key = @Gt
then 30 else -30)) conf
.fitmodel
5133 bound
(conf
.colorscale
+. (if key = 93 then 0.1 else -0.1)) 0.0 1.0
5135 G.postRedisplay "brightness";
5137 | @c when state
.mode = View
->
5142 let m = (wadjsb () + state
.winw
- state
.w) / 2 in
5144 gotoy_and_clear_text state
.y
5148 match state
.prevcolumns
with
5149 | None
-> (1, 0, 0), 1.0
5150 | Some
(columns
, z
) ->
5153 | Csplit
(c, _) -> -c, 0, 0
5154 | Cmulti
((c, a, b), _) -> c, a, b
5155 | Csingle
_ -> 1, 0, 0
5159 setcolumns View
c a b;
5162 | @down
| @up
when ctrl && Wsi.withshift mask
->
5163 let zoom, x = state
.prevzoom
in
5167 | @k
| @up
| @kpup
->
5168 begin match state
.autoscroll
with
5170 begin match state
.mode with
5171 | Birdseye beye
-> upbirdseye 1 beye
5176 then gotoy_and_clear_text (clamp ~
-(state
.winh
/2))
5178 if not
(Wsi.withshift mask
) && conf
.presentation
5180 else gotoghyll1 true (clamp (-conf
.scrollstep
))
5184 setautoscrollspeed n false
5187 | @j
| @down
| @kpdown
->
5188 begin match state
.autoscroll
with
5190 begin match state
.mode with
5191 | Birdseye beye
-> downbirdseye 1 beye
5196 then gotoy_and_clear_text (clamp (state
.winh
/2))
5198 if not
(Wsi.withshift mask
) && conf
.presentation
5200 else gotoghyll1 true (clamp (conf
.scrollstep
))
5204 setautoscrollspeed n true
5207 | @left | @right
| @kpleft
| @kpright
when not
(Wsi.withalt mask
) ->
5213 else conf
.hscrollstep
5215 let dx = if key = @left || key = @kpleft
then dx else -dx in
5216 state
.x <- panbound (state
.x + dx);
5217 gotoy_and_clear_text state
.y
5220 G.postRedisplay "left/right"
5223 | @prior
| @kpprior
->
5227 match state
.layout with
5229 | l :: _ -> state
.y - l.pagey
5231 clamp (pgscale (-state
.winh
))
5235 | @next | @kpnext
->
5239 match List.rev state
.layout with
5241 | l :: _ -> getpagey
l.pageno
5243 clamp (pgscale state
.winh
)
5247 | @g | @home
| @kphome
->
5250 | @G
| @jend
| @kpend
->
5252 gotoghyll (clamp state
.maxy)
5254 | @right
| @kpright
when Wsi.withalt mask
->
5255 gotoghyll (getnav 1)
5256 | @left | @kpleft
when Wsi.withalt mask
->
5257 gotoghyll (getnav ~
-1)
5262 | @v when conf
.debug
->
5265 match getopaque l.pageno with
5268 let x0, y0, x1, y1 = pagebbox
opaque in
5269 let a,b = float x0, float y0 in
5270 let c,d = float x1, float y0 in
5271 let e,f = float x1, float y1 in
5272 let h,j
= float x0, float y1 in
5273 let rect = (a,b,c,d,e,f,h,j
) in
5275 state
.rects
<- (l.pageno, l.pageno mod 3, rect) :: state
.rects
;
5277 G.postRedisplay "v";
5280 let mode = state
.mode in
5281 let cmd = ref E.s in
5282 let onleave = function
5283 | Cancel
-> state
.mode <- mode
5286 match getopaque l.pageno with
5287 | Some
opaque -> pipesel opaque !cmd
5288 | None
-> ()) state
.layout;
5292 cbput state
.hists
.sel
s;
5296 "| ", !cmd, Some
(onhist state
.hists
.sel
), textentry, ondone, true
5298 G.postRedisplay "|";
5299 state
.mode <- Textentry
(te, onleave);
5302 vlog "huh? %s" (Wsi.keyname
key)
5305 let linknavkeyboard key mask
linknav =
5306 let getpage pageno =
5307 let rec loop = function
5309 | l :: _ when l.pageno = pageno -> Some
l
5310 | _ :: rest
-> loop rest
5311 in loop state
.layout
5313 let doexact (pageno, n) =
5314 match getopaque pageno, getpage pageno with
5315 | Some
opaque, Some
l ->
5316 if key = @enter
|| key = @kpenter
5318 let under = getlink
opaque n in
5319 G.postRedisplay "link gotounder";
5326 Some
(findlink
opaque LDfirst
), -1
5329 Some
(findlink
opaque LDlast
), 1
5332 Some
(findlink
opaque (LDleft
n)), -1
5335 Some
(findlink
opaque (LDright
n)), 1
5338 Some
(findlink
opaque (LDup
n)), -1
5341 Some
(findlink
opaque (LDdown
n)), 1
5346 begin match findpwl
l.pageno dir with
5350 state
.mode <- LinkNav
(Ltgendir
dir);
5351 let y, h = getpageyh
pageno in
5354 then y + h - state
.winh
5359 begin match getopaque pageno, getpage pageno with
5360 | Some
opaque, Some
_ ->
5362 let ld = if dir > 0 then LDfirst
else LDlast
in
5365 begin match link with
5367 showlinktype (getlink
opaque m);
5368 state
.mode <- LinkNav
(Ltexact
(pageno, m));
5369 G.postRedisplay "linknav jpage";
5370 | Lnotfound
-> notfound dir
5376 begin match opt with
5377 | Some Lnotfound
-> pwl l dir;
5378 | Some
(Lfound
m) ->
5382 let _, y0, _, y1 = getlinkrect
opaque m in
5384 then gotopage1 l.pageno y0
5386 let d = fstate
.fontsize
+ 1 in
5387 if y1 - l.pagey > l.pagevh - d
5388 then gotopage1 l.pageno (y1 - state
.winh
- hscrollh () + d)
5389 else G.postRedisplay "linknav";
5391 showlinktype (getlink
opaque m);
5392 state
.mode <- LinkNav
(Ltexact
(l.pageno, m));
5395 | None
-> viewkeyboard key mask
5397 | _ -> viewkeyboard key mask
5402 G.postRedisplay "leave linknav"
5406 | Ltgendir
_ | Ltnotready
_ -> viewkeyboard key mask
5407 | Ltexact exact
-> doexact exact
5410 let keyboard key mask
=
5411 if (key = 103 && Wsi.withctrl mask
) && not
(istextentry state
.mode)
5412 then wcmd "interrupt"
5413 else state
.uioh <- state
.uioh#
key key mask
5416 let birdseyekeyboard key mask
5417 ((oconf
, leftx
, pageno, hooverpageno
, anchor) as beye
) =
5419 match conf
.columns
with
5421 | Cmulti
((c, _, _), _) -> c
5422 | Csplit
_ -> failwith
"bird's eye split mode"
5424 let pgh layout = List.fold_left
5425 (fun m l -> max
l.pageh
m) state
.winh
layout in
5427 | @l when Wsi.withctrl mask
->
5428 let y, h = getpageyh
pageno in
5429 let top = (state
.winh
- h) / 2 in
5430 gotoy (max
0 (y - top))
5431 | @enter
| @kpenter
-> leavebirdseye beye
false
5432 | @escape
-> leavebirdseye beye
true
5433 | @up
-> upbirdseye incr beye
5434 | @down
-> downbirdseye incr beye
5435 | @left -> upbirdseye 1 beye
5436 | @right
-> downbirdseye 1 beye
5439 begin match state
.layout with
5443 state
.mode <- Birdseye
(
5444 oconf
, leftx
, l.pageno, hooverpageno
, anchor
5446 gotopage1 l.pageno 0;
5449 let layout = layout (state
.y-state
.winh
) (pgh state
.layout) in
5451 | [] -> gotoy (clamp (-state
.winh
))
5453 state
.mode <- Birdseye
(
5454 oconf
, leftx
, l.pageno, hooverpageno
, anchor
5456 gotopage1 l.pageno 0
5459 | [] -> gotoy (clamp (-state
.winh
))
5463 begin match List.rev state
.layout with
5465 let layout = layout (state
.y + (pgh state
.layout)) state
.winh
in
5466 begin match layout with
5468 let incr = l.pageh
- l.pagevh in
5473 oconf
, leftx
, state
.pagecount
- 1, hooverpageno
, anchor
5475 G.postRedisplay "birdseye pagedown";
5477 else gotoy (clamp (incr + conf
.interpagespace
*2));
5481 Birdseye
(oconf
, leftx
, l.pageno, hooverpageno
, anchor);
5482 gotopage1 l.pageno 0;
5485 | [] -> gotoy (clamp state
.winh
)
5489 state
.mode <- Birdseye
(oconf
, leftx
, 0, hooverpageno
, anchor);
5493 let pageno = state
.pagecount
- 1 in
5494 state
.mode <- Birdseye
(oconf
, leftx
, pageno, hooverpageno
, anchor);
5495 if not
(pagevisible state
.layout pageno)
5498 match List.rev state
.pdims
with
5500 | (_, _, h, _) :: _ -> h
5502 gotoy (max
0 (getpagey
pageno - (state
.winh
- h - conf
.interpagespace
)))
5503 else G.postRedisplay "birdseye end";
5505 | _ -> viewkeyboard key mask
5510 match state
.mode with
5511 | Textentry
_ -> scalecolor 0.4
5513 | View
-> scalecolor 1.0
5514 | Birdseye
(_, _, pageno, hooverpageno
, _) ->
5515 if l.pageno = hooverpageno
5518 if l.pageno = pageno
5520 let c = scalecolor 1.0 in
5522 GlDraw.line_width
3.0;
5523 let dispx = xadjsb () + l.pagedispx in
5525 (float (dispx-1)) (float (l.pagedispy-1))
5526 (float (dispx+l.pagevw+1))
5527 (float (l.pagedispy+l.pagevh+1))
5529 GlDraw.line_width
1.0;
5538 let postdrawpage l linkindexbase
=
5539 match getopaque l.pageno with
5541 if tileready l l.pagex
l.pagey
5543 let x = l.pagedispx - l.pagex
+ xadjsb ()
5544 and y = l.pagedispy - l.pagey in
5546 match conf
.columns
with
5547 | Csingle
_ | Cmulti
_ ->
5548 (if conf
.hlinks
then 1 else 0)
5550 && not
(isbirdseye state
.mode) then 2 else 0)
5554 match state
.mode with
5555 | Textentry
((_, s, _, _, _, _), _) when state
.glinks
-> s
5561 postprocess
opaque hlmask x y (linkindexbase
, s, conf
.hfsize
);
5566 let scrollindicator () =
5567 let sbw, ph
, sh = state
.uioh#
scrollph in
5568 let sbh, pw, sw = state
.uioh#scrollpw
in
5573 else ((state
.winw
- sbw), state
.winw
, 0)
5576 GlDraw.color (0.64, 0.64, 0.64);
5577 filledrect (float x0) 0. (float x1) (float state
.winh
);
5579 (float hx0
) (float (state
.winh
- sbh))
5580 (float (hx0
+ wadjsb () + state
.winw
)) (float state
.winh
)
5582 GlDraw.color (0.0, 0.0, 0.0);
5584 filledrect (float x0) ph
(float x1) (ph
+. sh);
5585 let pw = pw +. float hx0
in
5586 filledrect pw (float (state
.winh
- sbh)) (pw +. sw) (float state
.winh
);
5590 match state
.mstate
with
5591 | Mnone
| Mscrolly
| Mscrollx
| Mpan
_ | Mzoom
_ | Mzoomrect
_ ->
5594 | Msel
((x0, y0), (x1, y1)) ->
5595 let identify opaque l px py = Some
(opaque, l.pageno, px, py) in
5596 let o0,n0
,px0
,py0
= onppundermouse identify x0 y0 (~
< E.s, -1, 0, 0) in
5597 let _o1,n1
,px1
,py1
= onppundermouse identify x1 y1 (~
< E.s, -1, 0, 0) in
5598 if n0
!= -1 && n0
= n1
then seltext
o0 (px0
, py0
, px1
, py1
);
5601 let showrects = function [] -> () | rects
->
5603 GlDraw.color (0.0, 0.0, 1.0) ~
alpha:0.5;
5604 GlFunc.blend_func ~
src:`src_alpha ~dst
:`one_minus_src_alpha
;
5606 (fun (pageno, c, (x0, y0, x1, y1, x2
, y2
, x3
, y3
)) ->
5608 if l.pageno = pageno
5610 let dx = float (l.pagedispx - l.pagex
) in
5611 let dy = float (l.pagedispy - l.pagey) in
5612 GlDraw.color (0.0, 0.0, 1.0 /. float c) ~
alpha:0.5;
5613 Raw.sets_float state
.vraw ~
pos:0
5618 GlArray.vertex `two state
.vraw
;
5619 GlArray.draw_arrays `triangle_strip ~
first:0 ~count
:4;
5628 GlClear.color (scalecolor2 conf
.bgcolor
);
5629 GlClear.clear
[`
color];
5630 List.iter
drawpage state
.layout;
5632 match state
.mode with
5633 | LinkNav
(Ltexact
(pageno, linkno
)) ->
5634 begin match getopaque pageno with
5636 let dx = xadjsb () in
5637 let x0, y0, x1, y1 = getlinkrect
opaque linkno
in
5638 let x0 = x0 + dx and x1 = x1 + dx in
5645 | None
-> state
.rects
5647 | LinkNav
(Ltgendir
_) | LinkNav
(Ltnotready
_)
5650 | View
-> state
.rects
5653 let rec postloop linkindexbase
= function
5655 let linkindexbase = linkindexbase + postdrawpage l linkindexbase in
5656 postloop linkindexbase rest
5660 postloop 0 state
.layout;
5662 begin match state
.mstate
with
5663 | Mzoomrect
((x0, y0), (x1, y1)) ->
5665 GlDraw.color (0.3, 0.3, 0.3) ~
alpha:0.5;
5666 GlFunc.blend_func ~
src:`src_alpha ~dst
:`one_minus_src_alpha
;
5667 filledrect (float x0) (float y0) (float x1) (float y1);
5671 | Mscrolly
| Mscrollx
5680 let zoomrect x y x1 y1 =
5683 and y0 = min
y y1 in
5684 gotoy (state
.y + y0);
5685 state
.anchor <- getanchor
();
5686 let zoom = (float state
.w) /. float (x1 - x0) in
5689 let adjw = wadjsb () + state
.winw
in
5691 then (adjw - state
.w) / 2
5694 match conf
.fitmodel
with
5695 | FitWidth
| FitProportional
-> simple ()
5697 match conf
.columns
with
5699 onppundermouse (fun _ l _ _ -> Some
l.pagedispx) x0 y0 x0
5700 | Cmulti
_ | Csingle
_ -> simple ()
5702 state
.x <- (state
.x + margin) - x0;
5707 let filecontents path =
5708 let ic = open_in
path in
5709 let b = Buffer.create
(in_channel_length
ic) in
5711 match input_line
ic with
5712 | (exception End_of_file
) -> Buffer.contents
b
5714 if Buffer.length
b > 0
5715 then Buffer.add_char
b '
\n'
;
5716 Buffer.add_string
b line
;
5722 let getusertext () =
5723 let editor = getenvwithdef
"EDITOR" E.s in
5727 let tmppath = Filename.temp_file
"llpp" "note" in
5728 let execstr = editor ^
" " ^
tmppath in
5730 match Unix.system
execstr with
5731 | (exception exn
) ->
5733 Printf.sprintf
"Unix.system(%S) failed: %s" execstr (exntos exn
);
5735 | Unix.WEXITED
0 -> filecontents tmppath
5738 Printf.sprintf
"editor process(%s) exited abnormally: %d"
5741 | Unix.WSIGNALED
n ->
5743 Printf.sprintf
"editor process(%s) was killed by signal %d"
5746 | Unix.WSTOPPED
n ->
5748 Printf.sprintf
"editor(%s) process was stopped by signal %d"
5752 match Unix.unlink
tmppath with
5753 | (exception exn
) ->
5755 Printf.sprintf
"failed to ulink %S: %s"
5756 tmppath (exntos exn
);
5762 match unproject x y with
5763 | Some
(opaque, n, ux
, uy
) ->
5765 let s = getusertext () in
5766 let l = Str.split newlinere
s in
5769 addannot
opaque ux uy
text;
5770 wcmd "freepage %s" (~
> opaque);
5771 Hashtbl.remove state
.pagemap
(n, state
.gen
);
5778 let g opaque l px py =
5779 match rectofblock
opaque px py with
5781 let x0 = a.(0) -. 20. in
5782 let x1 = a.(1) +. 20. in
5783 let y0 = a.(2) -. 20. in
5784 let zoom = (float state
.w) /. (x1 -. x0) in
5785 let pagey = getpagey
l.pageno in
5786 gotoy_and_clear_text (pagey + truncate
y0);
5787 state
.anchor <- getanchor
();
5788 let margin = (state
.w - l.pagew
)/2 in
5789 state
.x <- -truncate
x0 - margin;
5794 match conf
.columns
with
5796 showtext '
!'
"block zooming does not work properly in split columns mode"
5797 | Cmulti
_ | Csingle
_ -> onppundermouse g x y ()
5801 let winw = wadjsb () + state
.winw - 1 in
5802 let s = float x /. float winw in
5803 let destx = truncate
(float (state
.w + winw) *. s) in
5804 state
.x <- winw - destx;
5805 gotoy_and_clear_text state
.y;
5806 state
.mstate
<- Mscrollx
;
5810 let s = float y /. float state
.winh
in
5811 let desty = truncate
(float (state
.maxy - state
.winh
) *. s) in
5812 gotoy_and_clear_text desty;
5813 state
.mstate
<- Mscrolly
;
5816 let viewmulticlick clicks
x y mask
=
5817 let g opaque l px py =
5825 if markunder
opaque px py mark
5829 match getopaque l.pageno with
5831 | Some
opaque -> pipesel opaque cmd
5833 state
.roam
<- (fun () -> dopipe conf
.paxcmd
);
5834 if not
(Wsi.withctrl mask
) then dopipe conf
.selcmd
;
5839 G.postRedisplay "viewmulticlick";
5840 onppundermouse g x y (fun () -> showtext '
!'
"Nothing to select") ();
5844 match conf
.columns
with
5846 | Csingle
_ | Cmulti
_ -> conf
.angle
mod 360 = 0
5849 let viewmouse button down
x y mask
=
5851 | n when (n == 4 || n == 5) && not down
->
5852 if Wsi.withctrl mask
5854 match state
.mstate
with
5855 | Mzoom
(oldn
, i
) ->
5863 if conf
.zoom +. 0.01 > 0.1 then 0.1 else 0.01
5865 if conf
.zoom -. 0.1 < 0.1 then -0.01 else -0.1
5867 let zoom = conf
.zoom -. incr in
5869 state
.mstate
<- Mzoom
(n, 0);
5871 state
.mstate
<- Mzoom
(n, i
+1);
5873 else state
.mstate
<- Mzoom
(n, 0)
5877 | Mscrolly
| Mscrollx
5879 | Mnone
-> state
.mstate
<- Mzoom
(n, 0)
5882 match state
.autoscroll
with
5883 | Some step
-> setautoscrollspeed step
(n=4)
5885 if conf
.wheelbypage
|| conf
.presentation
5894 then -conf
.scrollstep
5895 else conf
.scrollstep
5897 let incr = incr * 2 in
5898 let y = clamp incr in
5899 gotoy_and_clear_text y
5902 | n when (n = 6 || n = 7) && not down
&& canpan () ->
5904 panbound (state
.x + (if n = 7 then -2 else 2) * conf
.hscrollstep
);
5905 gotoy_and_clear_text state
.y
5907 | 1 when Wsi.withshift mask
->
5908 state
.mstate
<- Mnone
;
5911 match unproject x y with
5912 | Some
(_, pageno, ux
, uy
) ->
5913 let cmd = Printf.sprintf
5915 conf
.stcmd state
.path pageno ux uy
5917 addpid @@ popen
cmd []
5921 | 1 when Wsi.withctrl mask
->
5924 Wsi.setcursor
Wsi.CURSOR_CROSSHAIR
;
5925 state
.mstate
<- Mpan
(x, y)
5928 state
.mstate
<- Mnone
5933 if Wsi.withshift mask
5936 G.postRedisplay "addannot"
5940 Wsi.setcursor
Wsi.CURSOR_CYCLE
;
5941 state
.mstate
<- Mzoomrect
(p, p)
5944 match state
.mstate
with
5945 | Mzoomrect
((x0, y0), _) ->
5946 if abs
(x-x0) > 10 && abs
(y - y0) > 10
5947 then zoomrect x0 y0 x y
5950 G.postRedisplay "kill accidental zoom rect";
5954 | Mscrolly
| Mscrollx
5960 | 1 when x > state
.winw - vscrollw () ->
5963 let _, position, sh = state
.uioh#
scrollph in
5964 if y > truncate
position && y < truncate
(position +. sh)
5965 then state
.mstate
<- Mscrolly
5968 state
.mstate
<- Mnone
5970 | 1 when y > state
.winh
- hscrollh () ->
5973 let _, position, sw = state
.uioh#scrollpw
in
5974 if x > truncate
position && x < truncate
(position +. sw)
5975 then state
.mstate
<- Mscrollx
5978 state
.mstate
<- Mnone
5980 | 1 when state
.bzoom
-> if not down
then zoomblock x y
5983 let dest = if down
then getunder x y else Unone
in
5984 begin match dest with
5987 | Uremote
_ | Uremotedest
_
5988 | Uunexpected
_ | Ulaunch
_ | Unamed
_ ->
5991 | Unone
when down
->
5992 Wsi.setcursor
Wsi.CURSOR_CROSSHAIR
;
5993 state
.mstate
<- Mpan
(x, y);
5995 | Uannotation contents
-> enterannotmode contents
5997 | Unone
| Utext
_ ->
6002 state
.mstate
<- Msel
((x, y), (x, y));
6003 G.postRedisplay "mouse select";
6007 match state
.mstate
with
6010 | Mzoom
_ | Mscrollx
| Mscrolly
->
6011 state
.mstate
<- Mnone
6013 | Mzoomrect
((x0, y0), _) ->
6017 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
6018 state
.mstate
<- Mnone
6020 | Msel
((x0, y0), (x1, y1)) ->
6021 let rec loop = function
6025 let a0 = l.pagedispy in
6026 let a1 = a0 + l.pagevh in
6027 let b0 = l.pagedispx in
6028 let b1 = b0 + l.pagevw in
6029 ((y0 >= a0 && y0 <= a1) || (y1 >= a0 && y1 <= a1))
6030 && ((x0 >= b0 && x0 <= b1) || (x1 >= b0 && x1 <= b1))
6034 match getopaque l.pageno with
6037 match Unix.pipe
() with
6041 "can not create sel pipe: %s"
6045 Ne.clo fd
(fun msg
->
6046 dolog
"%s close failed: %s" what msg
)
6049 try popen
cmd [r, 0; w, -1]
6051 dolog
"can not execute %S: %s"
6059 G.postRedisplay "copysel";
6061 else clo "Msel pipe/w" w;
6062 clo "Msel pipe/r" r;
6064 dosel conf
.selcmd
();
6065 state
.roam
<- dosel conf
.paxcmd
;
6077 let birdseyemouse button down
x y mask
6078 (conf
, leftx
, _, hooverpageno
, anchor) =
6081 let rec loop = function
6084 if y > l.pagedispy && y < l.pagedispy + l.pagevh
6085 && x > l.pagedispx && x < l.pagedispx + l.pagevw
6087 leavebirdseye (conf
, leftx
, l.pageno, hooverpageno
, anchor) false;
6093 | _ -> viewmouse button down
x y mask
6099 method key key mask
=
6100 begin match state
.mode with
6101 | Textentry
textentry -> textentrykeyboard key mask
textentry
6102 | Birdseye
birdseye -> birdseyekeyboard key mask
birdseye
6103 | View
-> viewkeyboard key mask
6104 | LinkNav
linknav -> linknavkeyboard key mask
linknav
6108 method button button bstate
x y mask
=
6109 begin match state
.mode with
6111 | View
-> viewmouse button bstate
x y mask
6112 | Birdseye beye
-> birdseyemouse button bstate
x y mask beye
6117 method multiclick clicks
x y mask
=
6118 begin match state
.mode with
6120 | View
-> viewmulticlick clicks
x y mask
6127 begin match state
.mode with
6129 | View
| Birdseye
_ | LinkNav
_ ->
6130 match state
.mstate
with
6131 | Mzoom
_ | Mnone
-> ()
6136 state
.mstate
<- Mpan
(x, y);
6138 then state
.x <- panbound (state
.x + dx);
6140 gotoy_and_clear_text y
6143 state
.mstate
<- Msel
(a, (x, y));
6144 G.postRedisplay "motion select";
6147 let y = min state
.winh
(max
0 y) in
6151 let x = min state
.winw (max
0 x) in
6154 | Mzoomrect
(p0
, _) ->
6155 state
.mstate
<- Mzoomrect
(p0
, (x, y));
6156 G.postRedisplay "motion zoomrect";
6160 method pmotion
x y =
6161 begin match state
.mode with
6162 | Birdseye
(conf
, leftx
, pageno, hooverpageno
, anchor) ->
6163 let rec loop = function
6165 if hooverpageno
!= -1
6167 state
.mode <- Birdseye
(conf
, leftx
, pageno, -1, anchor);
6168 G.postRedisplay "pmotion birdseye no hoover";
6171 if y > l.pagedispy && y < l.pagedispy + l.pagevh
6172 && x > l.pagedispx && x < l.pagedispx + l.pagevw
6174 state
.mode <- Birdseye
(conf
, leftx
, pageno, l.pageno, anchor);
6175 G.postRedisplay "pmotion birdseye hoover";
6185 match state
.mstate
with
6186 | Mpan
_ | Msel
_ | Mzoom
_ | Mscrolly
| Mscrollx
| Mzoomrect
_ -> ()
6194 let past, _, _ = !r in
6196 let delta = now -. past in
6199 else r := (now, x, y)
6203 method infochanged
_ = ()
6206 let maxy = state
.maxy - (if conf
.maxhfit
then state
.winh
else 0) in
6209 then 0.0, float state
.winh
6210 else scrollph state
.y maxy
6215 let winw = wadjsb () + state
.winw in
6216 let fwinw = float winw in
6218 let sw = fwinw /. float state
.w in
6219 let sw = fwinw *. sw in
6220 max
sw (float conf
.scrollh
)
6223 let maxx = state
.w + winw in
6224 let x = winw - state
.x in
6225 let percent = float x /. float maxx in
6226 (fwinw -. sw) *. percent
6228 hscrollh (), position, sw
6232 match state
.mode with
6233 | LinkNav
_ -> "links"
6234 | Textentry
_ -> "textentry"
6235 | Birdseye
_ -> "birdseye"
6238 findkeyhash conf
modename
6240 method eformsgs
= true
6241 method alwaysscrolly
= false
6244 let adderrmsg src msg
=
6245 Buffer.add_string state
.errmsgs msg
;
6246 state
.newerrmsgs
<- true;
6250 let adderrfmt src fmt
=
6251 Format.ksprintf
(fun s -> adderrmsg src s) fmt
;
6255 let cl = splitatspace cmds
in
6257 try Scanf.sscanf
s fmt
f
6259 adderrfmt "remote exec"
6260 "error processing '%S': %s\n" cmds
(exntos exn
)
6263 | "reload" :: [] -> reload ()
6264 | "goto" :: args
:: [] ->
6265 scan args
"%u %f %f"
6267 let cmd, _ = state
.geomcmds
in
6269 then gotopagexy pageno x y
6272 gotopagexy pageno x y;
6275 state
.reprf
<- f state
.reprf
6277 | "goto1" :: args
:: [] -> scan args
"%u %f" gotopage
6278 | "gotor" :: args
:: [] ->
6280 (fun filename
pageno -> gotounder (Uremote
(filename
, pageno)))
6281 | "gotord" :: args
:: [] ->
6283 (fun filename
dest -> gotounder (Uremotedest
(filename
, dest)))
6284 | "rect" :: args
:: [] ->
6285 scan args
"%u %u %f %f %f %f"
6286 (fun pageno color x0 y0 x1 y1 ->
6287 onpagerect pageno (fun w h ->
6288 let _,w1,h1
,_ = getpagedim
pageno in
6289 let sw = float w1 /. float w
6290 and sh = float h1
/. float h in
6294 and y1s
= y1 *. sh in
6295 let rect = (x0s,y0s
,x1s
,y0s
,x1s
,y1s
,x0s,y1s
) in
6297 state
.rects <- (pageno, color, rect) :: state
.rects;
6298 G.postRedisplay "rect";
6301 | "activatewin" :: [] -> Wsi.activatewin
()
6302 | "quit" :: [] -> raise Quit
6304 adderrfmt "remote command"
6305 "error processing remote command: %S\n" cmds
;
6309 let scratch = Bytes.create
80 in
6310 let buf = Buffer.create
80 in
6313 try Some
(Unix.read fd
scratch 0 80)
6315 | Unix.Unix_error
(Unix.EAGAIN
, _, _) -> None
6316 | Unix.Unix_error
(Unix.EINTR
, _, _) -> tempfr ()
6319 match tempfr () with
6325 if Buffer.length
buf > 0
6327 let s = Buffer.contents
buf in
6337 let pos = Bytes.index_from
scratch ppos '
\n'
in
6338 if pos >= n then -1 else pos
6339 with Not_found
-> -1
6343 Buffer.add_subbytes
buf scratch ppos
(nlpos-ppos
);
6344 let s = Buffer.contents
buf in
6350 Buffer.add_subbytes
buf scratch ppos
(n-ppos
);
6356 let remoteopen path =
6357 try Some
(Unix.openfile
path [Unix.O_NONBLOCK
; Unix.O_RDONLY
] 0o0)
6359 adderrfmt "remoteopen" "error opening %S: %s" path (exntos exn
);
6364 if emptystr conf
.savecmd
6365 then error
"don't know how to save modfied document"
6367 match Unix.open_process_in conf
.savecmd
with
6368 | (exception exn
) ->
6370 (Printf.sprintf
"savecmd open_process_in failed: %s"
6373 let path = try input_line
ic with End_of_file
-> E.s in
6375 match Unix.close_process_in
ic with
6376 | (exception exn
) ->
6377 error
"error obtaining save path: %s" (exntos exn
)
6384 let gcconfig = ref E.s in
6385 let trimcachepath = ref E.s in
6386 let rcmdpath = ref E.s in
6387 let pageno = ref None
in
6388 let rootwid = ref 0 in
6389 let openlast = ref false in
6390 let nofc = ref false in
6391 selfexec := Sys.executable_name
;
6394 [("-p", Arg.String
(fun s -> state
.password <- s),
6395 "<password> Set password");
6399 Config.fontpath
:= s;
6400 selfexec := !selfexec ^
" -f " ^
Filename.quote
s;
6402 "<path> Set path to the user interface font");
6406 selfexec := !selfexec ^
" -c " ^
Filename.quote
s;
6407 Config.confpath
:= s),
6408 "<path> Set path to the configuration file");
6410 ("-last", Arg.Set
openlast, " Open last document");
6412 ("-page", Arg.Int
(fun pageno1
-> pageno := Some
(pageno1
-1)),
6413 "<page-number> Jump to page");
6415 ("-tcf", Arg.String
(fun s -> trimcachepath := s),
6416 "<path> Set path to the trim cache file");
6418 ("-dest", Arg.String
(fun s -> state
.nameddest
<- s),
6419 "<named-destination> Set named destination");
6421 ("-wtmode", Arg.Set
wtmode, " Operate in wt mode");
6422 ("-cxack", Arg.Set
cxack, " Cut corners");
6424 ("-remote", Arg.String
(fun s -> rcmdpath := s),
6425 "<path> Set path to the remote commands source");
6427 ("-origin", Arg.String
(fun s -> state
.origin
<- s),
6428 "<original-path> Set original path");
6430 ("-gc", Arg.Set_string
gcconfig,
6431 "<script-path> Collect garbage with the help of a script");
6433 ("-nofc", Arg.Set
nofc, " Do not use fontconfig");
6435 ("-v", Arg.Unit
(fun () ->
6437 "%s\nconfiguration path: %s\n"
6441 exit
0), " Print version and exit");
6443 ("-embed", Arg.Set_int
rootwid,
6444 "<window-id> Embed into window")
6447 (fun s -> state
.path <- s)
6448 ("Usage: " ^
Sys.argv
.(0) ^
" [options] some.pdf\nOptions:")
6451 then selfexec := !selfexec ^
" -wtmode";
6453 let histmode = emptystr state
.path && not
!openlast in
6455 if not
(Config.load !openlast)
6456 then prerr_endline
"failed to load configuration";
6457 begin match !pageno with
6458 | Some
pageno -> state
.anchor <- (pageno, 0.0, 0.0)
6462 if not
(emptystr
!gcconfig)
6465 match Unix.socketpair
Unix.PF_UNIX
Unix.SOCK_STREAM
0 with
6467 error
"gc socketpair failed: %s" (exntos exn
)
6470 match addpid @@ popen
!gcconfig [(c, 0); (c, 1)] with
6472 error
"failed to popen gc script: %s" (exntos exn
);
6478 let wsfd, winw, winh
= Wsi.init
(object (self)
6479 val mutable m_clicks
= 0
6480 val mutable m_click_x
= 0
6481 val mutable m_click_y
= 0
6482 val mutable m_lastclicktime
= infinity
6484 method private cleanup
=
6485 state
.roam
<- noroam
;
6486 Hashtbl.iter
(fun _ opaque -> clearmark
opaque) state
.pagemap
6487 method expose
= G.postRedisplay"expose"
6491 | Wsi.Unobscured
-> "unobscured"
6492 | Wsi.PartiallyObscured
-> "partiallyobscured"
6493 | Wsi.FullyObscured
-> "fullyobscured"
6495 vlog "visibility change %s" name
6496 method display = display ()
6497 method map mapped
= vlog "mappped %b" mapped
6498 method reshape w h =
6501 method mouse
b d x y m =
6502 if d && canselect ()
6504 (* http://blogs.msdn.com/b/oldnewthing/archive/2004/10/18/243925.aspx *)
6510 if abs
x - m_click_x
> 10
6511 || abs
y - m_click_y
> 10
6512 || abs_float
(t -. m_lastclicktime
) > 0.3
6514 m_clicks
<- m_clicks
+ 1;
6515 m_lastclicktime
<- t;
6519 G.postRedisplay "cleanup";
6520 state
.uioh <- state
.uioh#button
b d x y m;
6522 else state
.uioh <- state
.uioh#multiclick m_clicks
x y m
6527 m_lastclicktime
<- infinity
;
6528 state
.uioh <- state
.uioh#button
b d x y m
6532 state
.uioh <- state
.uioh#button
b d x y m
6535 state
.mpos
<- (x, y);
6536 state
.uioh <- state
.uioh#motion
x y
6537 method pmotion
x y =
6538 state
.mpos
<- (x, y);
6539 state
.uioh <- state
.uioh#pmotion
x y
6541 let mascm = m land (
6542 Wsi.altmask
+ Wsi.shiftmask
+ Wsi.ctrlmask
+ Wsi.metamask
6545 let x = state
.x and y = state
.y in
6547 if x != state
.x || y != state
.y then self#cleanup
6549 match state
.keystate
with
6551 let km = k
, mascm in
6554 let modehash = state
.uioh#
modehash in
6555 try Hashtbl.find modehash km
6557 try Hashtbl.find (findkeyhash conf
"global") km
6558 with Not_found
-> KMinsrt
(k
, m)
6560 | KMinsrt
(k
, m) -> keyboard k
m
6561 | KMinsrl
l -> List.iter
(fun (k
, m) -> keyboard k
m) l
6562 | KMmulti
(l, r) -> state
.keystate
<- KSinto
(l, r)
6564 | KSinto
((k'
, m'
) :: [], insrt
) when k'
=k
&& m'
land mascm = m'
->
6565 List.iter
(fun (k
, m) -> keyboard k
m) insrt
;
6566 state
.keystate
<- KSnone
6567 | KSinto
((k'
, m'
) :: keys
, insrt
) when k'
=k
&& m'
land mascm = m'
->
6568 state
.keystate
<- KSinto
(keys
, insrt
)
6569 | KSinto
_ -> state
.keystate
<- KSnone
6572 state
.mpos
<- (x, y);
6573 state
.uioh <- state
.uioh#pmotion
x y
6574 method leave = state
.mpos
<- (-1, -1)
6575 method winstate wsl
= state
.winstate
<- wsl
6576 method quit
= raise Quit
6577 end) !rootwid conf
.cwinw conf
.cwinh platform
in
6582 List.exists
GlMisc.check_extension
6583 [ "GL_ARB_texture_rectangle"
6584 ; "GL_EXT_texture_recangle"
6585 ; "GL_NV_texture_rectangle" ]
6587 then (prerr_endline
"OpenGL does not suppport rectangular textures"; exit
1);
6590 let r = GlMisc.get_string `renderer
in
6591 let p = "Mesa DRI Intel(" in
6592 let l = String.length
p in
6593 String.length
r > l && String.sub
r 0 l = p
6596 defconf
.sliceheight
<- 1024;
6597 defconf
.texcount
<- 32;
6598 defconf
.usepbo
<- true;
6602 match Unix.socketpair
Unix.PF_UNIX
Unix.SOCK_STREAM
0 with
6604 Printf.eprintf
"socketpair failed: %s" (exntos exn
);
6612 setcheckers conf
.checkers
;
6614 if conf
.redirectstderr
6618 (Buffer.to_bytes state
.errmsgs
)
6619 (match state
.errfd
with
6621 let s = Bytes.create
(80*24) in
6624 let r, _, _ = Unix.select
[fd
] [] [] 0.0 in
6626 then Unix.read fd
s 0 (Bytes.length
s)
6632 else Bytes.sub
s 0 n
6636 try ignore
(Unix.write state
.stderr
s 0 (Bytes.length
s))
6637 with exn
-> print_endline
(exntos exn
)
6642 conf
.angle
, conf
.fitmodel
, (conf
.trimmargins
, conf
.trimfuzz
),
6643 conf
.texcount
, conf
.sliceheight
, conf
.mustoresize
, conf
.colorspace
,
6644 !Config.fontpath
, !trimcachepath,
6645 GlMisc.check_extension
"GL_ARB_pixel_buffer_object",
6648 List.iter
GlArray.enable
[`texture_coord
; `vertex
];
6654 Wsi.settitle
"llpp (history)";
6658 state
.text <- "Opening " ^
(mbtoutf8 state
.path);
6659 opendoc state
.path state
.password;
6664 Sys.set_signal
Sys.sighup
(Sys.Signal_handle
(fun _ -> reload ()));
6667 if nonemptystr
!rcmdpath
6668 then remoteopen !rcmdpath
6673 let rec loop deadline
=
6675 if pidcount
.contents
> 0
6677 match Unix.wait
() with
6678 | (exception exn
) -> dolog
"Unix.wait: %s" @@ exntos exn
6680 dolog
"reaped %d pidcount %d" pid pidcount
.contents
;
6686 match state
.errfd
with
6687 | None
-> [state
.ss; state
.wsfd]
6688 | Some fd
-> [state
.ss; state
.wsfd; fd
]
6693 | Some fd
-> fd
:: r
6697 state
.redisplay
<- false;
6704 if deadline
= infinity
6706 else max
0.0 (deadline
-. now)
6711 try Unix.select
r [] [] timeout
6712 with Unix.Unix_error
(Unix.EINTR
, _, _) -> [], [], []
6718 if state
.ghyll
== noghyll
6720 match state
.autoscroll
with
6721 | Some step
when step
!= 0 ->
6722 let y = state
.y + step
in
6726 else if y >= state
.maxy then 0 else y
6729 if state
.mode = View
6730 then state
.text <- E.s;
6733 else deadline
+. 0.01
6738 let rec checkfds = function
6740 | fd
:: rest
when fd
= state
.ss ->
6741 let cmd = readcmd state
.ss in
6745 | fd
:: rest
when fd
= state
.wsfd ->
6749 | fd
:: rest
when Some fd
= !optrfd ->
6750 begin match remote fd
with
6751 | None
-> optrfd := remoteopen !rcmdpath;
6752 | opt -> optrfd := opt
6757 let s = Bytes.create
80 in
6758 let n = tempfailureretry
(Unix.read fd
s 0) 80 in
6759 if conf
.redirectstderr
6761 Buffer.add_substring state
.errmsgs
(Bytes.to_string
s) 0 n;
6762 state
.newerrmsgs
<- true;
6763 state
.redisplay
<- true;
6766 prerr_string
(String.sub
(Bytes.to_string
s) 0 n);
6772 if !reeenterhist then (
6774 reeenterhist := false;
6778 if deadline
= infinity
6782 match state
.autoscroll
with
6783 | Some step
when step
!= 0 -> deadline1
6784 | _ -> if state
.ghyll
== noghyll
then infinity
else deadline1
6792 Config.save leavebirdseye;
6793 if hasunsavedchanges
()