12 let reqlayout = '
\029'
18 let interrupt = '
\035'
19 let pgscale h
= truncate
(float h
*. conf
.pgscale)
20 let nogeomcmds = function | s
, [] -> emptystr s
| _
-> false
21 let maxy () = !S.maxy - if conf
.maxhfit
then !S.winh
else 0
22 let scalecolor c
= let c = c *. conf
.colorscale
in (c, c, c)
23 let panbound x
= bound x
(- !S.w
) !S.winw
24 let pagevisible layout n
= List.exists
(fun l
-> l
.pageno
= n
) layout
25 let add_to_y_and_clamp inc
= bound
(!S.y
+ inc
) 0 @@ maxy ()
28 let debugrect (x0
, y0
, x1
, y1
, x2
, y2
, x3
, y3
) =
34 }|} x0 y0 x1 y1 x2 y2 x3 y3
37 if ((conf
.scrollb
land scrollbhv
!= 0) && (!S.w
> !S.winw
))
38 || !S.uioh#alwaysscrolly
44 fstate
.wwidth
<- Ffi.measurestr fstate
.fontsize
"w";
45 fstate
.maxrows
<- (!S.winh
- fstate
.fontsize
- 1) / (fstate
.fontsize
+ 1)
48 S.text
:= Printf.sprintf
"%c%s" c s
;
49 Glutils.postRedisplay
"showtext"
51 let adderrmsg src msg
=
52 Buffer.add_string
S.errmsgs msg
;
54 Glutils.postRedisplay src
56 let settextfmt fmt
= Printf.kprintf
(fun s
-> S.text
:= s
) fmt
57 let impmsg fmt
= Printf.ksprintf
(fun s
-> showtext '
!' s
) fmt
58 let adderrfmt src fmt
= Printf.ksprintf
(fun s
-> adderrmsg src s
) fmt
61 if emptystr conf
.pathlauncher
62 then adderrmsg "path launcher" "command set"
64 let cmd = Str.global_replace
Re.percent
!S.path conf
.pathlauncher
in
65 match spawn
cmd [] with
67 adderrfmt "spawn" "failed to execute `%s': %s" cmd @@ exntos exn
70 let getopaque pageno
= Hashtbl.find
S.pagemap
(pageno
, !S.gen
)
72 let pagetranslatepoint l x y
=
73 let dy = y
- l
.pagedispy
in
74 let y = dy + l
.pagey
in
75 let dx = x
- l
.pagedispx
in
76 let x = dx + l
.pagex
in
79 let onppundermouse g
x y d
=
83 match getopaque l
.pageno
with
84 | exception Not_found
-> f rest
86 let x0 = l
.pagedispx
in
87 let x1 = x0 + l
.pagevw
in
88 let y0 = l
.pagedispy
in
89 let y1 = y0 + l
.pagevh
in
90 if y >= y0 && y <= y1 && x >= x0 && x <= x1
92 let px, py
= pagetranslatepoint l
x y in
93 match g opaque l
px py
with
101 let g opaque l
px py
=
104 match Ffi.rectofblock opaque
px py
with
105 | Some
[|x0;x1;y0;y1|] ->
106 let rect = (x0, y0, x1, y0, x1, y1, x0, y1) in
107 let color = (0.0, 0.0, 1.0 /. (l
.pageno
mod 3 |> float), 0.5) in
108 S.rects
:= [l
.pageno
, color, rect];
109 Glutils.postRedisplay
"getunder";
112 let under = Ffi.whatsunder opaque
px py
in
113 if under = Unone
then None
else Some
under
115 onppundermouse g x y Unone
119 match Ffi.unproject opaque
x y with
120 | Some
(x, y) -> Some
(Some
(opaque
, l
.pageno
, x, y))
123 onppundermouse g x y None
125 let pipesel opaque
cmd =
128 pipef ~closew
:false "pipesel"
130 Ffi.copysel w opaque
;
131 Glutils.postRedisplay
"pipesel"
135 let g opaque l
px py
=
136 if Ffi.markunder opaque
px py conf
.paxmark
139 match getopaque l
.pageno
with
140 | exception Not_found
-> ()
141 | opaque
-> pipesel opaque conf
.paxcmd
145 Glutils.postRedisplay
"paxunder";
146 if conf
.paxmark
= MarkPage
149 match getopaque l
.pageno
with
150 | exception Not_found
-> ()
151 | opaque
-> Ffi.clearmark opaque
) !S.layout
;
152 S.roamf
:= onppundermouse g x y (fun () -> impmsg "whoopsie daisy")
154 let undertext = function
157 | Utext s
-> "font: " ^ s
158 | Utextannot
(opaque
, slinkindex
) ->
159 "text annotation: " ^
Ffi.gettextannot opaque slinkindex
160 | Ufileannot
(opaque
, slinkindex
) ->
161 "file annotation: " ^
Ffi.getfileannot opaque slinkindex
163 let updateunder x y =
164 match getunder x y with
165 | Unone
-> Wsi.setcursor
Wsi.CURSOR_INHERIT
167 if conf
.underinfo
then showtext 'u'
("ri: " ^ uri
);
168 Wsi.setcursor
Wsi.CURSOR_INFO
170 if conf
.underinfo
then showtext '
f'
("ont: " ^ s
);
171 Wsi.setcursor
Wsi.CURSOR_TEXT
173 if conf
.underinfo
then showtext 't'
"ext annotation";
174 Wsi.setcursor
Wsi.CURSOR_INFO
176 if conf
.underinfo
then showtext '
f'
"ile annotation";
177 Wsi.setcursor
Wsi.CURSOR_INFO
179 let showlinktype under =
180 if conf
.underinfo
&& under != Unone
181 then showtext ' '
@@ undertext under
183 let intentry_with_suffix text key
=
185 match [@warning
"-fragile-match"] key
with
186 | Keys.Ascii
('
0'
..'
9'
as c) -> addchar
text c
187 | Keys.Ascii
('k'
| 'm'
| '
g'
| 'K'
| 'M'
| 'G'
as c) ->
188 addchar
text @@ Char.lowercase_ascii
c
190 S.text := "invalid key";
196 let b = Buffer.create
16 in
199 Buffer.add_char
b cmd;
200 let b = Buffer.to_bytes
b in
201 Ffi.wcmd !S.ss
b @@ Bytes.length
b
204 let wcmd1 cmd opaque
=
205 let s = Opaque.to_string opaque
in
206 let l = String.length
s in
207 let b = Bytes.create
(l+1) in
209 Bytes.blit_string
s 0 b 0 l;
210 Ffi.wcmd !S.ss
b @@ l + 1
212 let layoutN ((columns
, coverA
, coverB
), b) x y sw sh
=
213 let rec fold accu n
=
214 if n
= Array.length
b
217 let pdimno, dx, vy
, (_
, w
, h
, xoff
) = b.(n
) in
220 || n
= !S.pagecount
- coverB
221 || (n
- coverA
) mod columns
= columns
- 1)
227 let pagey = max
0 (y - vy
) in
228 let pagedispy = if pagey > 0 then 0 else vy
- y in
229 let pagedispx, pagex
=
231 if n
= coverA
- 1 || n
= !S.pagecount
- coverB
232 then x + (sw
- w
) / 2
240 let vw = sw
- pagedispx in
241 let pw = w
- pagex
in
244 let pagevh = min
(h
- pagey) (sh
- pagedispy) in
245 if pagevw > 0 && pagevh > 0
248 ; pagecol
= 0 ; pagedimno
= pdimno ; pagew
= w
; pageh
= h
249 ; pagex
; pagey ; pagevw ; pagevh ; pagedispx ; pagedispy
256 if Array.length
b = 0
258 else List.rev
(fold [] (page_of_y
y))
260 let layoutS (columns
, b) x y sw sh
=
261 let rec fold accu n
=
262 if n
= Array.length
b
265 let pdimno, px, vy
, (_
, pagew
, pageh
, xoff
) = b.(n
) in
273 let pagey = max
0 (y - vy
) in
274 let pagedispy = if pagey > 0 then 0 else vy
- y in
275 let pagedispx, pagex
=
289 let pagecolw = pagew
/columns
in
292 then pagedispx + ((sw
- pagecolw) / 2)
296 let vw = sw
- pagedispx in
297 let pw = pagew
- pagex
in
300 let pagevw = min
pagevw pagecolw in
301 let pagevh = min
(pageh
- pagey) (sh
- pagedispy) in
302 if pagevw > 0 && pagevh > 0
306 ; pagecol
= n
mod columns
307 ; pagew
; pageh
; pagex
; pagey ; pagedispx ; pagedispy
317 let layout x y sw sh
=
318 if U.nogeomcmds !S.geomcmds
320 match conf
.columns
with
321 | Csingle
b -> layoutN ((1, 0, 0), b) x y sw sh
322 | Cmulti
c -> layoutN c x y sw sh
323 | Csplit
s -> layoutS s x y sw sh
327 let tilex = l.pagex
mod conf
.tilew
in
328 let tiley = l.pagey mod conf
.tileh
in
330 let col = l.pagex
/ conf
.tilew
in
331 let row = l.pagey / conf
.tileh
in
333 let rec rowloop row y0 dispy h
=
336 let dh = conf
.tileh
- y0 in
338 let rec colloop col x0 dispx w
=
341 let dw = conf
.tilew
- x0 in
343 f col row dispx dispy
x0 y0 dw dh;
344 colloop (col+1) 0 (dispx
+dw) (w
-dw)
346 colloop col tilex l.pagedispx l.pagevw;
347 rowloop (row+1) 0 (dispy
+dh) (h
-dh)
349 if l.pagevw > 0 && l.pagevh > 0
350 then rowloop row tiley l.pagedispy l.pagevh
352 let gettileopaque l col row =
353 let key = l.pageno
, !S.gen
, conf
.colorspace
,
354 conf
.angle
, l.pagew
, l.pageh
, col, row in
355 Hashtbl.find_opt
S.tilemap
key
357 let puttileopaque l col row gen colorspace angle opaque size elapsed
=
358 let key = l.pageno
, gen
, colorspace
, angle
, l.pagew
, l.pageh
, col, row in
359 Hashtbl.add
S.tilemap
key (opaque
, size
, elapsed
)
361 let drawtiles l color =
362 let texe e
= if conf
.invert
then GlTex.env
(`mode e
) in
365 let f col row x y tilex tiley w h
=
366 match gettileopaque l col row with
367 | Some
(opaque
, _
, t
) ->
368 let params = x, y, w
, h
, tilex, tiley in
370 Ffi.drawtile
params opaque
;
375 let s = Printf.sprintf
"%d[%d,%d] %f sec" l.pageno
col row t
in
376 let w = Ffi.measurestr fstate
.fontsize
s in
377 GlDraw.color (0.0, 0.0, 0.0);
382 (float (y + fstate
.fontsize
+ 2));
384 Glutils.drawstring fstate
.fontsize
x (y + fstate
.fontsize
- 1) s;
390 let w = let lw = !S.winw
- x in min
lw w
391 and h
= let lh = !S.winh
- y in min
lh h
in
393 GlDraw.color (0.8, 0.8, 0.8);
394 Glutils.filledrect
(float x) (float y) (float (x+w)) (float (y+h
));
396 if w > 128 && h
> fstate
.fontsize
+ 10
398 let c = if conf
.invert
then 1.0 else 0.0 in
399 GlDraw.color (c, c, c);
402 then (col*conf
.tilew
, row*conf
.tileh
)
405 Glutils.drawstringf fstate
.fontsize
x y
406 "Loading %d [%d,%d]" l.pageno
c r
;
414 let tilevisible1 l x y =
416 and ax1
= l.pagex
+ l.pagevw
418 and ay1
= l.pagey + l.pagevh in
422 let bx1 = min
(bx0 + conf
.tilew
) l.pagew
423 and by1
= min
(by0
+ conf
.tileh
) l.pageh
in
425 let rx0 = max
ax0 bx0
426 and ry0
= max ay0 by0
427 and rx1
= min ax1
bx1
428 and ry1
= min ay1 by1
in
430 let nonemptyintersection = rx1
> rx0 && ry1
> ry0
in
433 let tilevisible layout n
x y =
434 let rec findpageinlayout m
= function
435 | l :: rest
when l.pageno
= n
->
436 tilevisible1 l x y || (
437 match conf
.columns
with
438 | Csplit
(c, _
) when c > m
-> findpageinlayout (m
+1) rest
439 | Csplit _
| Csingle _
| Cmulti _
-> false
441 | _
:: rest
-> findpageinlayout 0 rest
444 findpageinlayout 0 layout
446 let tileready l x y =
447 tilevisible1 l x y &&
448 gettileopaque l (x/conf
.tilew
) (y/conf
.tileh
) != None
450 let tilepage n p
layout =
451 let rec loop = function
455 let f col row _ _ _ _ _ _
=
456 if !S.currently
= Idle
458 match gettileopaque l col row with
461 let x = col*conf
.tilew
462 and y = row*conf
.tileh
in
464 let w = l.pagew
- x in
468 let h = l.pageh
- y in
471 wcmd U.tile "%s %d %d %d %d" (Opaque.to_string p
) x y w h;
474 l, p
, conf
.colorspace
, conf
.angle
,
475 !S.gen
, col, row, conf
.tilew
, conf
.tileh
483 if U.nogeomcmds !S.geomcmds
486 let preloadlayout x y sw sh
=
487 let y = if y < sh
then 0 else y - sh
in
488 let x = min
0 (x + sw
) in
495 if !S.currently
= Idle
499 begin match getopaque l.pageno
with
500 | exception Not_found
->
501 wcmd U.page "%d %d" l.pageno
l.pagedimno
;
502 S.currently
:= Loading
(l, !S.gen
);
504 tilepage l.pageno opaque pages
;
509 if U.nogeomcmds !S.geomcmds
514 if conf
.preload && !S.currently
= Idle
515 then load (preloadlayout !S.x !S.y !S.winw
!S.winh
)
517 let alltilesrendered layout =
523 let foo col row _ _ _ _ _ _
=
524 match gettileopaque l col row with
528 match itertiles l foo with
530 | exception E
-> false
535 let y = bound
y 0 !S.maxy in
537 let layout = layout x y !S.winw
!S.winh
in
538 Glutils.postRedisplay
"gotoxy ready";
544 begin match !S.mode
with
547 | Ltexact
(pageno
, linkno
) ->
548 let rec loop = function
550 S.lnava
:= Some
(pageno
, linkno
);
551 S.mode
:= LinkNav
(Ltgendir
0)
552 | l :: _
when l.pageno
= pageno
->
553 begin match getopaque pageno
with
554 | exception Not_found
->
555 S.mode
:= LinkNav
(Ltnotready
(pageno
, 0))
557 let x0, y0, x1, y1 = Ffi.getlinkrect opaque linkno
in
558 if not
(x0 >= l.pagex
&& x1 <= l.pagex
+ l.pagevw
559 && y0 >= l.pagey && y1 <= l.pagey + l.pagevh)
560 then S.mode
:= LinkNav
(Ltgendir
0)
562 | _
:: rest
-> loop rest
565 | Ltnotready _
| Ltgendir _
-> ()
567 | Birdseye _
| Textentry _
| View
-> ()
569 begin match !S.mode
with
570 | Birdseye
(conf
, leftx
, pageno
, hooverpageno
, anchor
) ->
571 if not
(U.pagevisible layout pageno
)
576 S.mode
:= Birdseye
(conf
, leftx
, l.pageno
, hooverpageno
, anchor
)
580 | Ltnotready
(_
, dir
)
583 let rec loop = function
586 match getopaque l.pageno
with
587 | exception Not_found
-> Ltnotready
(l.pageno
, dir
)
592 then LDfirstvisible
(l.pagex
, l.pagey, dir
)
593 else if dir
> 0 then LDfirst
else LDlast
595 Ffi.findlink opaque
ld
598 | Lnotfound
-> loop rest
600 showlinktype (Ffi.getlink opaque n
);
601 Ltexact
(l.pageno
, n
)
605 S.mode
:= LinkNav
linknav
608 | Textentry _
| View
-> ()
613 let mx, my
= !S.mpos
in
617 let conttiling pageno opaque
=
618 tilepage pageno opaque
620 then preloadlayout !S.x !S.y !S.winw
!S.winh
624 if not conf
.verbose
then S.text := E.s;
627 let getanchory (n
, top
, dtop
) =
628 let y, h = getpageyh n
in
631 let ips = calcips
h in
632 y + truncate
(top
*.float h -. dtop
*.float ips) + ips;
633 else y + truncate
(top
*.float h -. dtop
*.float conf
.interpagespace
)
635 let addnav () = S.nav
:= { past
= getanchor
() :: !S.nav
.past
; future
= []; }
638 let y, h = getpageyh n
in
639 let y = y + (truncate
(top
*. float h)) in
642 let gotopage1 n top
=
643 let y = getpagey n
in
648 Glutils.redisplay
:= false;
653 match !S.geomcmds
with
654 | ps
, [] when emptystr ps
->
657 | ps
, [] -> S.geomcmds
:= ps
, [s, f];
658 | ps
, (s'
, _
) :: rest
when s'
= s -> S.geomcmds
:= ps
, ((s, f) :: rest
);
659 | ps
, cmds
-> S.geomcmds
:= ps
, ((s, f) :: cmds
)
662 Hashtbl.iter
(fun _ opaque
-> wcmd1 U.freepage opaque
) S.pagemap
;
663 Hashtbl.clear
S.pagemap
666 if not
(Queue.is_empty
S.tilelru
)
668 Queue.iter
(fun (k
, p
, s) ->
670 S.memused
:= !S.memused
- s;
671 Hashtbl.remove
S.tilemap k
;
673 !S.uioh#infochanged Memused
;
674 Queue.clear
S.tilelru
;
679 let h = truncate
(float h*.conf
.zoom
) in
680 let d = conf
.interpagespace
lsl (if conf
.presentation
then 1 else 0) in
685 let sl = keystostrlist conf
in
687 function | [] -> accu
688 | s :: rest
-> loop ((s, 0, None
) :: accu) rest
689 in Help.makehelp conf
.urilauncher
690 @ (("", 0, None
) :: loop [] sl) |> Array.of_list
696 (if emptystr
!S.origin
then path
else !S.origin
)
697 |> Filename.basename
|> Ffi.mbtoutf8
701 if not
!S.ignoredoctitlte
702 then Wsi.settitle @@ title ^
" - llpp"
704 let opendoc path mimetype password
=
706 S.mimetype
:= mimetype
;
707 S.password
:= password
;
713 Ffi.setaalevel conf
.aalevel
;
714 Ffi.setpapercolor conf
.papercolor
;
717 settitle @@ titlify path
;
718 wcmd U.dopen "%d %d %d %d %s\000%s\000%s\000%s\000"
719 (btod conf
.usedoccss
) conf
.rlw conf
.rlh conf
.rlem
720 path mimetype password conf
.css
;
721 invalidate "reqlayout"
723 wcmd U.reqlayout " %d %d %d %s\000"
724 conf
.angle
(FMTE.to_int conf
.fitmodel
)
725 (stateh !S.winh
) !S.nameddest
730 S.anchor
:= getanchor
();
731 S.reload := Some
(!S.x, !S.y, now
());
732 opendoc !S.path
!S.mimetype
!S.password
734 let docolumns columns
=
737 let a = Array.make
!S.pagecount
(-1, -1, -1, (-1, -1, -1, -1)) in
738 let rec loop pageno
pdimno pdim
y ph pdims
=
739 if pageno
!= !S.pagecount
741 let pdimno, ((_
, w, h, xoff
) as pdim
), pdims
=
743 | ((pageno'
, _
, _
, _
) as pdim
) :: rest
when pageno'
= pageno
->
748 let x = max
0 (((!S.winw
- w) / 2) - xoff
) in
750 y + (if conf
.presentation
751 then (if pageno
= 0 then calcips
h else calcips ph
+ calcips
h)
752 else (if pageno
= 0 then 0 else conf
.interpagespace
))
754 a.(pageno
) <- (pdimno, x, y, pdim
);
755 loop (pageno
+1) pdimno pdim
(y + h) h pdims
757 loop 0 ~
-1 (-1,-1,-1,-1) 0 0 !S.pdims
;
758 conf
.columns
<- Csingle
a;
760 | Cmulti
((columns
, coverA
, coverB
), _
) ->
761 let a = Array.make
!S.pagecount
(-1, -1, -1, (-1, -1, -1, -1)) in
762 let rec loop pageno
pdimno pdim
x y rowh pdims
=
766 let (pdimno, x, y, ((_
, _
, h, _
) as pdim
)) = a.(m
) in
768 then a.(m
) <- (pdimno, x, y + (rowh
- h) / 2, pdim
);
771 if pageno
= !S.pagecount
772 then fixrow (((pageno
- 1) / columns
) * columns
)
774 let pdimno, ((_
, w, h, xoff
) as pdim
), pdims
=
776 | ((pageno'
, _
, _
, _
) as pdim
) :: rest
when pageno'
= pageno
->
778 | _
-> pdimno, pdim
, pdims
781 if pageno
= coverA
- 1 || pageno
= !S.pagecount
- coverB
783 let x = (!S.winw
- w) / 2 in
785 if conf
.presentation
then calcips
h else conf
.interpagespace
in
789 if (pageno
- coverA
) mod columns
= 0
791 let x = max
0 (!S.winw
- !S.w) / 2 in
795 let ips = calcips
h in
796 y + (if pageno
= 0 then 0 else calcips rowh
+ ips)
797 else y + (if pageno
= 0 then 0 else conf
.interpagespace
)
801 else x, y, max rowh
h
805 if pageno
> 1 && (pageno
- coverA
) mod columns
= 0
808 if pageno
= columns
&& conf
.presentation
810 let ips = calcips rowh
in
811 for i
= 0 to pred columns
813 let (pdimno, x, y, pdim
) = a.(i
) in
814 a.(i
) <- (pdimno, x, y+ips, pdim
)
820 fixrow (pageno
- columns
);
825 a.(pageno
) <- (pdimno, x, y, pdim
);
826 let x = x + w + xoff
*2 + conf
.interpagespace
in
827 loop (pageno
+1) pdimno pdim
x y rowh' pdims
829 loop 0 ~
-1 (-1,-1,-1,-1) 0 0 0 !S.pdims
;
830 conf
.columns
<- Cmulti
((columns
, coverA
, coverB
), a);
833 let a = Array.make
(!S.pagecount
*c) (-1, -1, -1, (-1, -1, -1, -1)) in
834 let rec loop pageno
pdimno pdim
y pdims
=
835 if pageno
!= !S.pagecount
837 let pdimno, ((_
, w, h, _
) as pdim
), pdims
=
839 | ((pageno'
, _
, _
, _
) as pdim
) :: rest
when pageno'
= pageno
->
841 | _
-> pdimno, pdim
, pdims
844 let rec loop1 n
x y =
845 if n
= c then y else (
846 a.(pageno
*c + n
) <- (pdimno, x, y, pdim
);
847 loop1 (n
+1) (x+cw) (y + h + conf
.interpagespace
)
850 let y = loop1 0 0 y in
851 loop (pageno
+1) pdimno pdim
y pdims
853 loop 0 ~
-1 (-1,-1,-1,-1) 0 !S.pdims
;
854 conf
.columns
<- Csplit
(c, a)
857 docolumns conf
.columns
;
858 S.maxy := calcheight
();
859 if !S.reprf
== noreprf
862 | Birdseye
(_
, _
, pageno
, _
, _
) ->
863 let y, h = getpageyh pageno
in
864 let top = (!S.winh
- h) / 2 in
865 gotoxy !S.x (max
0 (y - top))
866 | Textentry _
| View
| LinkNav _
->
867 let y = getanchory !S.anchor
in
868 let y = min
y (!S.maxy - !S.winh
) in
876 let reshape ?
(firsttime
=false) w h =
877 GlDraw.viewport ~
x:0 ~
y:0 ~
w ~
h;
878 if not firsttime
&& U.nogeomcmds !S.geomcmds
879 then S.anchor
:= getanchor
();
882 let w = truncate
(float w *. conf
.zoom
) in
885 setfontsize fstate
.fontsize
;
886 GlMat.mode `modelview
;
887 GlMat.load_identity
();
889 GlMat.mode `projection
;
890 GlMat.load_identity
();
891 GlMat.rotate ~
x:1.0 ~angle
:180.0 ();
892 GlMat.translate ~
x:~
-.1.0 ~
y:~
-.1.0 ();
893 GlMat.scale3
(2.0 /. float !S.winw
, 2.0 /. float !S.winh
, 1.0);
898 else float !S.x /. float !S.w
900 invalidate "geometry"
904 then S.x := truncate
(relx *. float w);
906 match conf
.columns
with
908 | Cmulti
((c, _
, _
), _
) -> (w - (c-1)*conf
.interpagespace
) / c
909 | Csplit
(c, _
) -> w * c
911 wcmd U.geometry "%d %d %d" w (stateh h) (FMTE.to_int conf
.fitmodel
)
914 let gctilesnotinlayout layout =
915 let len = Queue.length
S.tilelru
in
917 if !S.memused
> conf
.memlimit
921 let (k
, p
, s) as lruitem
= Queue.pop
S.tilelru
in
922 let n, gen
, colorspace
, angle
, pagew
, pageh
, col, row = k
in
923 let (_
, pw, ph
, _
) = getpagedim
n in
925 && colorspace
= conf
.colorspace
926 && angle
= conf
.angle
930 let x = col*conf
.tilew
and y = row*conf
.tileh
in
931 tilevisible layout n x y
933 then Queue.push lruitem
S.tilelru
936 S.memused
:= !S.memused
- s;
937 !S.uioh#infochanged Memused
;
938 Hashtbl.remove
S.tilemap k
;
945 let onpagerect pageno
f =
947 match conf
.columns
with
952 if pageno
>= 0 && pageno
< Array.length
b
954 let (_
, _
, _
, (_
, w, h, _
)) = b.(pageno
) in
957 let gotopagexy1 pageno
x y =
958 let _,w1
,h1
,leftx
= getpagedim pageno
in
959 let top = y /. (float h1
) in
960 let left = x /. (float w1
) in
961 let py, w, h = getpageywh pageno
in
963 let x = left *. (float w) in
964 let x = leftx
+ !S.x + truncate
x in
966 if x < 0 || x >= !S.winw
970 let pdy = truncate
(top *. float h) in
972 let dy = y'
- !S.y in
974 if x != !S.x || not
(dy > 0 && dy < wh)
978 if abs
(py - y'
) > wh
985 if !S.x != sx || !S.y != sy
987 else gotoxy !S.x !S.y
989 let gotopagexy pageno
x y =
991 | Birdseye
_ -> gotopage pageno
0.0
992 | Textentry
_ | View
| LinkNav
_ -> gotopagexy1 pageno
x y
995 let passcmd = getenvdef
"LLPP_ASKPASS" conf
.passcmd in
997 then (adderrmsg "askpass" "ask password program not set"; E.s)
998 else getcmdoutput
(adderrfmt passcmd "failed to obrain password: %s") passcmd
1000 let pgoto opaque pageno
x y =
1001 let pdimno = getpdimno pageno
in
1002 let x, y = Ffi.project opaque pageno
pdimno x y in
1003 gotopagexy pageno
x y
1006 (* dolog "%S" cmds; *)
1007 let spl = splitatchar cmds ' '
in
1009 try Scanf.sscanf
s fmt
f
1011 dolog
"error scanning %S: %s" cmds
@@ exntos exn
;
1014 let addoutline outline
=
1015 match !S.currently
with
1016 | Outlining outlines
-> S.currently
:= Outlining
(outline
:: outlines
)
1017 | Idle
-> S.currently
:= Outlining
[outline
]
1018 | Loading
_ | Tiling
_ ->
1019 dolog
"Invalid outlining state";
1020 logcurrently
!S.currently
1025 !S.uioh#infochanged Pdim
;
1027 | "clearrects", "" ->
1028 S.rects
:= !S.rects1
;
1029 Glutils.postRedisplay
"clearrects";
1031 | "continue", args
->
1032 let n = scan args
"%u" (fun n -> n) in
1034 begin match !S.currently
with
1036 S.currently
:= Idle
;
1037 S.outlines
:= Array.of_list
(List.rev
l)
1038 | Idle
| Loading
_ | Tiling
_ -> ()
1041 let cur, cmds
= !S.geomcmds
in
1042 if emptystr
cur then error
"empty geomcmd";
1044 begin match List.rev cmds
with
1046 S.geomcmds
:= E.s, [];
1050 S.geomcmds
:= s, List.rev rest
;
1052 Glutils.postRedisplay
"continue";
1055 if conf
.verbose
then showtext ' ' args
1058 if not
!S.redirstderr
1059 then Format.eprintf
"%s@." args
1061 Buffer.add_string
S.errmsgs args
;
1062 Buffer.add_char
S.errmsgs '
\n'
;
1063 if not
!S.newerrmsgs
1065 S.newerrmsgs
:= true;
1066 Glutils.postRedisplay
"error message";
1070 | "progress", args
->
1071 let progress, text =
1073 (fun f pos
-> f, String.sub args pos
(String.length args
- pos
))
1076 S.progress := progress;
1077 Glutils.postRedisplay
"progress"
1080 let pageno, n, x0, y0, x1, y1, x2
, y2
, x3
, y3
=
1081 scan args
"%u %d %f %f %f %f %f %f %f %f"
1082 (fun p
n x0 y0 x1 y1 x2 y2 x3 y3
->
1083 (p
, n, x0, y0, x1, y1, x2
, y2
, x3
, y3
))
1087 let y = (getpagey
pageno) + truncate
y0 in
1089 if (!S.x < - truncate
x0) || (!S.x > !S.winw
- truncate
x1)
1090 then !S.winw
/2 - truncate
(x0 /. 2. +. x1 /. 2.)
1096 let color = (0.0, 0.0, (if n = 0 then 1.0 else 0.5), 0.5) in
1098 (pageno, color, (x0, y0, x1, y1, x2
, y2
, x3
, y3
)) :: !S.rects1
1101 let pageopaques, t
= scan args
"%s %f" (fun p t
-> p
, t
) in
1102 let pageopaque = Opaque.of_string
pageopaques in
1103 begin match !S.currently
with
1104 | Loading
(l, gen
) ->
1105 vlog
"page %d took %f sec" l.pageno t
;
1106 Hashtbl.replace
S.pagemap
(l.pageno, gen
) pageopaque;
1107 let preloadedpages =
1109 then preloadlayout !S.x !S.y !S.winw
!S.winh
1113 let set = List.fold_left
(fun s l -> IntSet.add
l.pageno s)
1114 IntSet.empty
preloadedpages
1117 Hashtbl.fold (fun ((pageno, _) as key) opaque
accu ->
1118 if not
(IntSet.mem
pageno set)
1120 wcmd1 U.freepage opaque
;
1126 List.iter
(Hashtbl.remove
S.pagemap
) evictedpages;
1129 S.currently
:= Idle
;
1132 tilepage l.pageno pageopaque !S.layout;
1134 load preloadedpages;
1135 let visible = U.pagevisible !S.layout l.pageno in
1139 | LinkNav
(Ltnotready
(pageno, dir
)) ->
1140 if pageno = l.pageno
1145 then LDfirstvisible
(l.pagex
, l.pagey, dir
)
1146 else if dir
> 0 then LDfirst
else LDlast
1148 Ffi.findlink
pageopaque ld
1153 showlinktype (Ffi.getlink
pageopaque n);
1154 S.mode
:= LinkNav
(Ltexact
(l.pageno, n))
1156 | LinkNav
(Ltgendir
_)
1157 | LinkNav
(Ltexact
_)
1163 if visible && alltilesrendered !S.layout
1164 then assert false (* Glutils.postRedisplay "page"; *)
1167 | Idle
| Tiling
_ | Outlining
_ ->
1168 dolog
"Inconsistent loading state";
1169 logcurrently
!S.currently
;
1175 C part is notifying us that it has finished rendering a tile
1176 valid = the tile fits current config (i.e. the settings with which
1177 the tile has been rendered match current ones)
1179 if the tile is not valid free it and issue loading/rendering commands
1180 for the current layout
1182 evict all the tiles that aren't part of preloadlayout
1183 if tile is visible post redisplay
1186 let (x, y, opaques
, size
, t
) =
1187 scan args
"%u %u %s %u %f" (fun x y p size t
-> (x, y, p
, size
, t
))
1189 let opaque = Opaque.of_string opaques
in
1190 begin match !S.currently
with
1191 | Tiling
(l, pageopaque, cs, angle
, gen
, col, row, tilew
, tileh
) ->
1192 vlog
"tile %d [%d,%d] took %f sec" l.pageno col row t
;
1194 if conf
.preload && alltilesrendered !S.layout
1195 then preloadlayout !S.x !S.y !S.winw
!S.winh
1198 if tilew
!= conf
.tilew
|| tileh
!= conf
.tileh
1200 wcmd1 U.freetile opaque;
1201 S.currently
:= Idle
;
1205 puttileopaque l col row gen
cs angle
opaque size t
;
1206 S.memused
:= !S.memused
+ size
;
1207 !S.uioh#infochanged Memused
;
1208 gctilesnotinlayout !S.layout;
1209 Queue.push
((l.pageno, gen
, cs, angle
, l.pagew
, l.pageh
, col, row),
1210 opaque, size
) S.tilelru
;
1212 S.currently
:= Idle
;
1213 let visible = tilevisible layout l.pageno x y in
1214 let cont = gen
= !S.gen
&& conf
.colorspace
= cs
1215 && conf
.angle
= angle
&& visible
1219 then conttiling l.pageno pageopaque;
1222 then Glutils.postRedisplay
"tile nothrottle";
1225 | Idle
| Loading
_ | Outlining
_ ->
1226 dolog
"Inconsistent tiling state";
1227 logcurrently
!S.currently
;
1232 let (n, w, h, _) as pdim
=
1233 scan args
"%u %d %d %d" (fun n x w h -> n, w, h, x)
1236 match conf
.fitmodel
with
1238 | FitPage
| FitProportional
->
1239 match conf
.columns
with
1240 | Csplit
_ -> (n, w, h, 0)
1241 | Csingle
_ | Cmulti
_ -> pdim
1243 S.pdims
:= pdim :: !S.pdims
;
1244 !S.uioh#infochanged Pdim
1247 let (l, n, t
, h, pos
) =
1248 scan args
"%u %u %d %u %n" (fun l n t
h pos
-> l, n, t
, h, pos
)
1250 let s = String.sub args pos
(String.length args
- pos
) in
1251 addoutline (s, l, Oanchor
(n, float t
/. float h, 0.0))
1254 let (l, len, pos
) = scan args
"%u %u %n" (fun l len pos
-> l, len, pos
) in
1255 let s = String.sub args pos
len in
1256 let pos2 = pos
+ len + 1 in
1257 let uri = String.sub args
pos2 (String.length args
- pos2) in
1258 addoutline (s, l, Ouri
uri)
1261 let (l, pos
) = scan args
"%u %n" (fun l pos
-> l, pos
) in
1262 let s = String.sub args pos
(String.length args
- pos
) in
1263 addoutline (s, l, Onone
)
1266 let (n, l, t
) = scan args
"%u %d %d" (fun n l t
-> n, l, t
) in
1267 S.reprf
:= (fun () -> gotopagexy n (float l) (float t
))
1271 match splitatchar args '
\t'
with
1273 settitle @@ Filename.basename
!S.path
;
1280 if let len = String.length
c in
1281 len > 6 && ((String.sub
c (len-4) 4) = "date")
1283 if String.length v
>= 7 && v
.[0] = 'D'
&& v
.[1] = '
:'
1285 let b = Buffer.create
10 in
1286 Printf.bprintf
b "%s\t" c;
1289 Buffer.add_substring
b v p
l;
1290 Buffer.add_char
b c;
1291 with exn
-> Buffer.add_string
b @@ exntos exn
1299 Printf.bprintf
b "[%s]" v
;
1305 if nonemptystr
s then S.docinfo
:= (1, s) :: !S.docinfo
1308 S.docinfo
:= List.rev
!S.docinfo
;
1309 !S.uioh#infochanged Docinfo
1313 then adderrmsg "pass" "Wrong password";
1314 let password = getpassword () in
1315 if emptystr
password
1316 then error
"document is password protected"
1317 else opendoc !S.path
!S.mimetype
password
1319 | _ -> error
"unknown cmd `%S'" cmds
1323 let action = function
1324 | HCprev
-> cbget cb ~
-1
1325 | HCnext
-> cbget cb
1
1326 | HCfirst
-> cbget cb ~
-(cb
.rc)
1327 | HClast
-> cbget cb
(cb
.len - 1 - cb
.rc)
1328 and cancel
() = cb
.rc <- rc
1331 let search pattern forward
=
1332 match conf
.columns
with
1334 impmsg "searching while in split columns mode is not implemented"
1335 | Csingle
_ | Cmulti
_ ->
1336 if nonemptystr pattern
1339 match !S.layout with
1341 | l :: _ -> l.pageno, (l.pagey + if forward
then 0 else 0*l.pagevh)
1344 wcmd U.search "%d %d %d %d,%s\000"
1345 (btod conf
.icase
) pn py (btod forward
) pattern
1347 let intentry text key =
1349 if emptystr
text && key = Keys.Ascii '
-'
1350 then addchar
text '
-'
1352 match [@warning
"-fragile-match"] key with
1353 | Keys.Ascii
('
0'
..'
9'
as c) -> addchar
text c
1355 S.text := "invalid key";
1363 let rec loop off
= function
1366 match getopaque l.pageno with
1367 | exception Not_found
-> loop off rest
1369 let n = Ffi.getlinkn
opaque conf
.hcs
s off
in
1372 else Ffi.getlink
opaque (n-1) |> f
1376 let linknentry text = function [@warning
"-fragile-match"]
1378 let text = addchar
text c in
1379 linknact (fun under -> S.text := undertext under) text;
1382 settextfmt "invalid key %s" @@ Keys.to_string
key;
1385 let textentry text key = match [@warning
"-fragile-match"] key with
1386 | Keys.Ascii
c -> TEcont
(addchar
text c)
1387 | Keys.Code
c -> TEcont
(text ^
Ffi.toutf8
c)
1390 let reqlayout angle fitmodel
=
1391 if U.nogeomcmds !S.geomcmds
1392 then S.anchor
:= getanchor
();
1393 conf
.angle
<- angle
mod 360;
1397 | LinkNav
_ -> S.mode
:= View
1398 | Birdseye
_ | Textentry
_ | View
-> ()
1400 conf
.fitmodel
<- fitmodel
;
1401 invalidate "reqlayout"
1402 (fun () -> wcmd U.reqlayout "%d %d %d"
1403 conf
.angle
(FMTE.to_int conf
.fitmodel
) (stateh !S.winh
))
1405 let settrim trimmargins trimfuzz
=
1406 if U.nogeomcmds !S.geomcmds
1407 then S.anchor
:= getanchor
();
1408 conf
.trimmargins
<- trimmargins
;
1409 conf
.trimfuzz
<- trimfuzz
;
1410 let x0, y0, x1, y1 = trimfuzz
in
1411 invalidate "settrim"
1412 (fun () -> wcmd U.settrim "%d %d %d %d %d"
1413 (btod conf
.trimmargins
) x0 y0 x1 y1);
1417 let zoom = max
0.0001 zoom in
1418 if zoom <> conf
.zoom
1420 S.prevzoom
:= (conf
.zoom, !S.x);
1422 reshape !S.winw
!S.winh
;
1423 settextfmt "zoom is now %-5.2f" (zoom *. 100.0);
1426 let pivotzoom ?
(vw=min
!S.w !S.winw
)
1427 ?
(vh
=min
(!S.maxy - !S.y) !S.winh
)
1428 ?
(x=vw/2) ?
(y=vh
/2) zoom =
1429 let w = float !S.w /. zoom in
1430 let hw = w /. 2.0 in
1431 let ratio = float vh
/. float vw in
1432 let hh = hw *. ratio in
1433 let x0 = float x -. hw +. !S.xf
and y0 = float y -. hh +. !S.yf
in
1434 let xf, xr
= modf
x0 and yf
, yr
= modf
y0 in
1437 gotoxy (!S.x - truncate xr
) (!S.y + truncate yr
);
1440 let pivotzoom ?
vw ?vh ?
x ?
y zoom =
1441 if U.nogeomcmds !S.geomcmds
1444 then pivotzoom ?
vw ?vh ?
x ?
y zoom
1447 let setcolumns mode columns coverA coverB
=
1448 S.prevcolumns
:= Some
(conf
.columns
, conf
.zoom);
1452 then impmsg "split mode doesn't work in bird's eye"
1454 conf
.columns
<- Csplit
(-columns
, E.a);
1462 conf
.columns
<- Csingle
E.a;
1467 conf
.columns
<- Cmulti
((columns
, coverA
, coverB
), E.a);
1471 reshape !S.winw
!S.winh
1473 let resetmstate () =
1475 Wsi.setcursor
Wsi.CURSOR_INHERIT
1477 let enterbirdseye () =
1478 let zoom = float conf
.thumbw
/. float !S.winw
in
1479 let birdseyepageno =
1480 let cy = !S.winh
/ 2 in
1484 let rec fold best
= function
1487 let d = cy - (l.pagedispy + l.pagevh/2)
1488 and dbest
= cy - (best
.pagedispy + best
.pagevh/2) in
1489 if abs
d < abs dbest
1498 { conf
with zoom = conf
.zoom },
1499 !S.x, birdseyepageno, -1, getanchor
()
1503 conf
.presentation
<- false;
1504 conf
.interpagespace
<- 10;
1505 conf
.hlinks
<- false;
1506 conf
.fitmodel
<- FitPage
;
1509 match conf
.beyecolumns
with
1512 Cmulti
((c, 0, 0), E.a)
1513 | None
-> Csingle
E.a
1516 then settextfmt "birds eye on (zoom %3.1f%%)" (100.0*.zoom);
1517 reshape !S.winw
!S.winh
1519 let leavebirdseye (c, leftx
, pageno, _, anchor
) goback
=
1521 conf
.zoom <- c.zoom;
1522 conf
.presentation
<- c.presentation
;
1523 conf
.interpagespace
<- c.interpagespace
;
1524 conf
.hlinks
<- c.hlinks
;
1525 conf
.fitmodel
<- c.fitmodel
;
1526 conf
.beyecolumns
<- (
1527 match conf
.columns
with
1528 | Cmulti
((c, _, _), _) -> Some
c
1530 | Csplit
_ -> error
"leaving bird's eye split mode"
1533 match c.columns
with
1534 | Cmulti
(c, _) -> Cmulti
(c, E.a)
1535 | Csingle
_ -> Csingle
E.a
1536 | Csplit
(c, _) -> Csplit
(c, E.a)
1539 then settextfmt "bird's eye off (zoom %3.1f%%)" (100.0*.conf
.zoom);
1540 reshape !S.winw
!S.winh
;
1541 S.anchor
:= if goback
then anchor
else (pageno, 0.0, 1.0);
1544 let togglebirdseye () =
1546 | Birdseye vals
-> leavebirdseye vals
true
1547 | View
-> enterbirdseye ()
1548 | Textentry
_ | LinkNav
_ -> ()
1550 let upbirdseye incr
(conf
, leftx
, pageno, hooverpageno
, anchor
) =
1551 let pageno = max
0 (pageno - incr
) in
1552 let rec loop = function
1553 | [] -> gotopage1 pageno 0
1554 | l :: _ when l.pageno = pageno ->
1555 if l.pagedispy >= 0 && l.pagey = 0
1556 then Glutils.postRedisplay
"upbirdseye"
1557 else gotopage1 pageno 0
1558 | _ :: rest
-> loop rest
1562 S.mode
:= Birdseye
(conf
, leftx
, pageno, hooverpageno
, anchor
)
1564 let downbirdseye incr
(conf
, leftx
, pageno, hooverpageno
, anchor
) =
1565 let pageno = min
(!S.pagecount
- 1) (pageno + incr
) in
1566 S.mode
:= Birdseye
(conf
, leftx
, pageno, hooverpageno
, anchor
);
1567 let rec loop = function
1569 let y, h = getpageyh
pageno in
1570 let dy = (y - !S.y) - (!S.winh
- h - conf
.interpagespace
) in
1571 gotoxy !S.x (U.add_to_y_and_clamp dy)
1572 | l :: _ when l.pageno = pageno ->
1573 if l.pagevh != l.pageh
1575 let inc = l.pageh
- l.pagevh + conf
.interpagespace
in
1576 gotoxy !S.x (U.add_to_y_and_clamp inc)
1577 else Glutils.postRedisplay
"downbirdseye"
1578 | _ :: rest
-> loop rest
1583 let optentry mode
_ key =
1584 match [@warning
"-fragile-match"] key with
1588 let n, a, b = multicolumns_of_string
s in
1589 setcolumns mode
n a b;
1590 with exn
-> settextfmt "bad columns `%s': %s" s @@ exntos exn
1592 TEswitch
("columns: ", E.s, None
, textentry, ondone, true)
1597 let zoom = float (int_of_string
s) /. 100.0 in
1599 with exn
-> settextfmt "bad integer `%s': %s" s @@ exntos exn
1601 TEswitch
("zoom: ", E.s, None
, intentry, ondone, true)
1604 conf
.icase
<- not conf
.icase
;
1605 TEdone
("case insensitive search " ^
(onoffs conf
.icase
))
1608 conf
.verbose
<- not conf
.verbose
;
1609 TEdone
("verbose " ^
(onoffs conf
.verbose
))
1612 conf
.debug
<- not conf
.debug
;
1613 TEdone
("debug " ^
(onoffs conf
.debug
))
1616 conf
.underinfo
<- not conf
.underinfo
;
1617 TEdone
("underinfo " ^ onoffs conf
.underinfo
)
1620 settrim (not conf
.trimmargins
) conf
.trimfuzz
;
1621 TEdone
("trim margins " ^ onoffs conf
.trimmargins
)
1624 conf
.invert
<- not conf
.invert
;
1625 TEdone
("invert colors " ^ onoffs conf
.invert
)
1629 cbput
!S.hists
.sel
s;
1632 TEswitch
("selection command: ", E.s, Some
(onhist !S.hists
.sel
),
1633 textentry, ondone, true)
1637 then conf
.pax
<- Some
0.0
1638 else conf
.pax
<- None
;
1639 TEdone
("PAX " ^ onoffs
(conf
.pax
!= None
))
1642 settextfmt "bad option %d `%c'" (Char.code
c) c;
1645 | _ -> TEcont
!S.text
1647 class outlinelistview ~zebra ~source
=
1648 let settext autonarrow
s =
1652 let ss = source#statestr
in
1653 if emptystr
ss then "[" ^
s ^
"]" else "{" ^
ss ^
"} [" ^
s ^
"]"
1660 ~source
:(source
:> lvsource
)
1662 ~modehash
:(findkeyhash conf
"outline")
1665 val m_autonarrow
= false
1667 method! key key mask
=
1671 else fstate
.maxrows - 2
1673 let calcfirst first active
=
1676 let rows = active
- first
in
1677 if rows > maxrows then active
- maxrows else first
1681 let active = m_active
+ incr
in
1682 let active = bound
active 0 (source#getitemcount
- 1) in
1683 let first = calcfirst m_first
active in
1684 Glutils.postRedisplay
"outline navigate";
1685 coe
{< m_active
= active; m_first
= first >}
1687 let navscroll first =
1689 let dist = m_active
- first in
1695 else first + maxrows
1698 Glutils.postRedisplay
"outline navscroll";
1699 coe
{< m_first
= first; m_active
= active >}
1701 let ctrl = Wsi.withctrl mask
in
1703 match Wsi.ks2kt
key with
1704 | Ascii '
a'
when ctrl ->
1712 let pattern = source#renarrow
in
1713 if nonemptystr m_qsearch
1714 then (source#narrow m_qsearch
; m_qsearch
)
1718 settext (not m_autonarrow
) text;
1719 Glutils.postRedisplay
"toggle auto narrowing";
1720 coe
{< m_first
= 0; m_active
= 0; m_autonarrow
= not m_autonarrow
>}
1721 | Ascii '
/'
when emptystr m_qsearch
&& not m_autonarrow
->
1723 Glutils.postRedisplay
"toggle auto narrowing";
1724 coe
{< m_first
= 0; m_active
= 0; m_autonarrow
= true >}
1725 | Ascii '
n'
when ctrl ->
1726 source#narrow m_qsearch
;
1728 then source#add_narrow_pattern m_qsearch
;
1729 Glutils.postRedisplay
"outline ctrl-n";
1730 coe
{< m_first
= 0; m_active
= 0 >}
1731 | Ascii 'S'
when ctrl ->
1732 let active = source#calcactive
(getanchor
()) in
1733 let first = firstof m_first
active in
1734 Glutils.postRedisplay
"outline ctrl-s";
1735 coe
{< m_first
= first; m_active
= active >}
1736 | Ascii 'u'
when ctrl ->
1737 Glutils.postRedisplay
"outline ctrl-u";
1738 if m_autonarrow
&& nonemptystr m_qsearch
1740 ignore
(source#renarrow
);
1741 settext m_autonarrow
E.s;
1742 coe
{< m_first
= 0; m_active
= 0; m_qsearch
= E.s >}
1745 source#del_narrow_pattern
;
1746 let pattern = source#renarrow
in
1748 if emptystr
pattern then E.s else "Narrowed to " ^
pattern
1750 settext m_autonarrow
text;
1751 coe
{< m_first
= 0; m_active
= 0; m_qsearch
= E.s >}
1753 | Ascii '
l'
when ctrl ->
1754 let first = max
0 (m_active
- (fstate
.maxrows / 2)) in
1755 Glutils.postRedisplay
"outline ctrl-l";
1756 coe
{< m_first
= first >}
1758 | Ascii '
\t'
when m_autonarrow
->
1759 if nonemptystr m_qsearch
1761 Glutils.postRedisplay
"outline list view tab";
1762 source#add_narrow_pattern m_qsearch
;
1764 coe
{< m_qsearch
= E.s >}
1767 | Escape
when m_autonarrow
->
1768 if nonemptystr m_qsearch
1769 then source#add_narrow_pattern m_qsearch
;
1771 | Enter
when m_autonarrow
->
1772 if nonemptystr m_qsearch
1773 then source#add_narrow_pattern m_qsearch
;
1775 | (Ascii
_ | Code
_) when m_autonarrow
->
1776 let pattern = m_qsearch ^
Ffi.toutf8
key in
1777 Glutils.postRedisplay
"outlinelistview autonarrow add";
1778 source#narrow
pattern;
1779 settext true pattern;
1780 coe
{< m_first
= 0; m_active
= 0; m_qsearch
= pattern >}
1781 | Backspace
when m_autonarrow
->
1782 if emptystr m_qsearch
1785 let pattern = withoutlastutf8 m_qsearch
in
1786 Glutils.postRedisplay
"outlinelistview autonarrow backspace";
1787 ignore
(source#renarrow
);
1788 source#narrow
pattern;
1789 settext true pattern;
1790 coe
{< m_first
= 0; m_active
= 0; m_qsearch
= pattern >}
1791 | Up
when ctrl -> navscroll (max
0 (m_first
-1))
1792 | Down
when ctrl -> navscroll (min
(source#getitemcount
-1) (m_first
+1))
1793 | Up
-> navigate ~
-1
1794 | Down
-> navigate 1
1795 | Prior
-> navigate ~
-(fstate
.maxrows)
1796 | Next
-> navigate fstate
.maxrows
1800 Glutils.postRedisplay
"outline ctrl right";
1801 {< m_pan
= m_pan
+ 1 >}
1804 if Wsi.withshift mask
1805 then self#nextcurlevel
1
1806 else self#updownlevel
1
1811 Glutils.postRedisplay
"outline ctrl left";
1812 {< m_pan
= m_pan
- 1 >}
1815 if Wsi.withshift mask
1816 then self#nextcurlevel ~
-1
1817 else self#updownlevel ~
-1
1820 Glutils.postRedisplay
"outline home";
1821 coe
{< m_first
= 0; m_active
= 0 >}
1823 let active = source#getitemcount
- 1 in
1824 let first = max
0 (active - fstate
.maxrows) in
1825 Glutils.postRedisplay
"outline end";
1826 coe
{< m_active
= active; m_first
= first >}
1827 | Delete
|Escape
|Insert
|Enter
|Ascii
_|Code
_|Ctrl
_|Backspace
|Fn
_ ->
1831 let genhistoutlines () =
1833 |> List.sort
(fun (_, c1
, _, _, _, _) (_, c2
, _, _, _, _) ->
1834 compare c2
.lastvisit c1
.lastvisit
)
1835 |> List.map
(fun ((path
, c, _, _, _, origin
) as hist
) ->
1836 let path = if nonemptystr origin
then origin
else path in
1837 let base = Ffi.mbtoutf8
@@ Filename.basename
path in
1838 (base ^
"\000" ^
c.title
, 1, Ohistory hist
)
1841 let gotohist (path, c, bookmarks
, x, anchor
, origin
) =
1842 Config.save
leavebirdseye;
1844 let x0, y0, x1, y1 = conf
.trimfuzz
in
1845 wcmd U.trimset "%d %d %d %d %d" (btod conf
.trimmargins
) x0 y0 x1 y1;
1846 Wsi.reshape c.cwinw
c.cwinh
;
1847 opendoc path !S.mimetype origin
;
1851 S.bookmarks
:= bookmarks
;
1855 let describe_layout layout =
1859 | l :: [] -> Printf.sprintf
"Page %d" (l.pageno+1)
1862 if a.pageno = b.pageno then Printf.sprintf
"%d" (a.pageno+1)
1863 else Printf.sprintf
"%d%s%d" (a.pageno+1)
1864 (if a.pageno+1 = b.pageno then ", " else Utf8syms.ellipsis
)
1867 let rec fold s la lb
= function
1868 | [] -> Printf.sprintf
"%s %s" s (rangestr la lb
)
1869 | l :: rest
when l.pageno = succ lb
.pageno -> fold s la
l rest
1870 | l :: rest
-> fold (s ^
" " ^
rangestr la lb ^
",") l l rest
1872 fold "Pages" l l rest
1875 let maxy = U.maxy () in
1878 else 100. *. (float !S.y /. float maxy)
1880 Printf.sprintf
"%s of %d [%.2f%%]" d !S.pagecount
percent
1882 let setpresentationmode v
=
1883 let n = page_of_y
!S.y in
1884 S.anchor
:= (n, 0.0, 1.0);
1885 conf
.presentation
<- v
;
1886 if conf
.fitmodel
= FitPage
1887 then reqlayout conf
.angle conf
.fitmodel
;
1891 let modehash = lazy (findkeyhash conf
"info") in (fun source
->
1893 new listview ~zebra
:false ~helpmode
:false ~source
1894 ~trusted
:true ~
modehash:(Lazy.force_val
modehash) |> coe
)
1897 let btos b = if b then Utf8syms.radical
else E.s in
1898 let showextended = ref false in
1899 let showcolors = ref false in
1900 let showcommands = ref false in
1901 let showrefl = ref false in
1902 let leave mode
_ = S.mode
:= mode
in
1904 val mutable m_l
= []
1905 val mutable m_a
= E.a
1906 val mutable m_prev_uioh
= nouioh
1907 val mutable m_prev_mode
= View
1909 inherit lvsourcebase
1911 method reset prev_mode prev_uioh
=
1912 m_a
<- Array.of_list
(List.rev m_l
);
1914 m_prev_mode
<- prev_mode
;
1915 m_prev_uioh
<- prev_uioh
;
1917 method int name get
set =
1922 try set (int_of_string
s)
1923 with exn
-> settextfmt "bad integer `%s': %s" s @@ exntos exn
1926 let te = (name ^
": ", E.s, None
, intentry, ondone, true) in
1927 S.mode
:= Textentry
(te, leave m_prev_mode
);
1931 method int_with_suffix name get
set =
1933 (name
, `intws get
, 1,
1936 try set (int_of_string_with_suffix
s)
1937 with exn
-> settextfmt "bad integer `%s': %s" s @@ exntos exn
1940 let te = (name ^
": ", E.s, None
, intentry_with_suffix,
1942 S.mode
:= Textentry
(te, leave m_prev_mode
);
1946 method bool ?
(offset
=1) ?
(btos=btos) name get
set =
1947 m_l
<- (name
, `
bool (btos, get
), offset
,
1948 Some
(fun u
-> set (not
(get
())); u
)) :: m_l
1950 method color name get
set =
1952 (name
, `
color get
, 1,
1954 let invalid = (nan
, nan
, nan
) in
1957 try color_of_string
s
1958 with exn
-> settextfmt "bad color `%s': %s" s @@ exntos exn
;
1964 let te = (name ^
": ", E.s, None
, textentry, ondone, true) in
1965 S.text := color_to_string
(get
());
1966 S.mode
:= Textentry
(te, leave m_prev_mode
);
1970 method string name get
set =
1972 (name
, `
string get
, 1,
1974 let ondone s = set s in
1975 let te = (String.trim name ^
": ", E.s, None
,
1976 textentry, ondone, true) in
1977 S.mode
:= Textentry
(te, leave m_prev_mode
);
1981 method colorspace name get
set =
1983 (name
, `
string get
, 1,
1986 inherit lvsourcebase
1989 m_active
<- CSTE.to_int conf
.colorspace
;
1992 method getitemcount
=
1993 Array.length
CSTE.names
1996 method exit ~uioh ~cancel ~
active ~
first ~pan
=
1997 ignore
(uioh
, first, pan
);
1998 if not cancel
then set active;
2000 method hasaction
_ = true
2006 method paxmark name get
set =
2008 (name
, `
string get
, 1,
2011 inherit lvsourcebase
2014 m_active
<- MTE.to_int conf
.paxmark
;
2017 method getitemcount
= Array.length
MTE.names
2018 method getitem
n = (MTE.names
.(n), 0)
2019 method exit ~uioh ~cancel ~
active ~
first ~pan
=
2020 ignore
(uioh
, first, pan
);
2021 if not cancel
then set active;
2023 method hasaction
_ = true
2029 method fitmodel name get
set =
2031 (name
, `
string get
, 1,
2034 inherit lvsourcebase
2037 m_active
<- FMTE.to_int conf
.fitmodel
;
2040 method getitemcount
= Array.length
FMTE.names
2041 method getitem
n = (FMTE.names
.(n), 0)
2042 method exit ~uioh ~cancel ~
active ~
first ~pan
=
2043 ignore
(uioh
, first, pan
);
2044 if not cancel
then set active;
2046 method hasaction
_ = true
2052 method caption
s offset
=
2053 m_l
<- (s, `empty
, offset
, None
) :: m_l
2055 method caption2
s f offset
=
2056 m_l
<- (s, `
string f, offset
, None
) :: m_l
2058 method getitemcount
= Array.length m_a
2061 let tostr = function
2062 | `
int f -> string_of_int
(f ())
2063 | `intws
f -> string_with_suffix_of_int
(f ())
2065 | `
color f -> color_to_string
(f ())
2066 | `
bool (btos, f) -> btos (f ())
2069 let name, t
, offset
, _ = m_a
.(n) in
2070 ((let s = tostr t
in
2072 then Printf.sprintf
"%s\t%s" name s
2076 method exit ~uioh ~cancel ~
active ~
first ~pan
=
2081 match m_a
.(active) with
2082 | _, _, _, Some
f -> f uioh
2083 | _, _, _, None
-> uioh
2094 method hasaction
n =
2096 | _, _, _, Some
_ -> true
2097 | _, _, _, None
-> false
2099 initializer m_active
<- 1
2102 let rec fillsrc prevmode prevuioh
=
2103 let sep () = src#caption
E.s 0 in
2104 let bad v exn
= settextfmt "bad color `%s': %s" v
@@ exntos exn
in
2105 let colorp name get
set =
2107 (fun () -> color_to_string
(get
()))
2109 try set @@ color_of_string v
2110 with exn
-> bad v exn
2113 let rgba name get
set =
2115 (fun () -> get
() |> rgba_to_string
)
2117 try set @@ rgba_of_string v
2118 with exn
-> bad v exn
2121 let oldmode = !S.mode
in
2122 let birdseye = isbirdseye
!S.mode
in
2124 src#caption
(if birdseye then "Setup (Bird's eye)" else "Setup") 0;
2126 src#
bool "presentation mode"
2127 (fun () -> conf
.presentation
)
2128 (fun v
-> setpresentationmode v
);
2130 src#
bool "ignore case in searches"
2131 (fun () -> conf
.icase
)
2132 (fun v
-> conf
.icase
<- v
);
2135 (fun () -> conf
.preload)
2136 (fun v
-> conf
.preload <- v
);
2138 src#
bool "highlight links"
2139 (fun () -> conf
.hlinks
)
2140 (fun v
-> conf
.hlinks
<- v
);
2142 src#
bool "under info"
2143 (fun () -> conf
.underinfo
)
2144 (fun v
-> conf
.underinfo
<- v
);
2146 src#fitmodel
"fit model"
2147 (fun () -> FMTE.to_string conf
.fitmodel
)
2148 (fun v
-> reqlayout conf
.angle
(FMTE.of_int v
));
2150 src#
bool "trim margins"
2151 (fun () -> conf
.trimmargins
)
2152 (fun v
-> settrim v conf
.trimfuzz
; fillsrc prevmode prevuioh
);
2155 src#
int "inter-page space"
2156 (fun () -> conf
.interpagespace
)
2158 conf
.interpagespace
<- n;
2159 docolumns conf
.columns
;
2161 match !S.layout with
2163 | l :: _ -> l.pageno, l.pagey
2165 S.maxy :=- calcheight
();
2166 gotoxy !S.x (py + getpagey
pageno)
2170 (fun () -> conf
.pagebias
)
2171 (fun v
-> conf
.pagebias
<- v
);
2173 src#
int "scroll step"
2174 (fun () -> conf
.scrollstep
)
2175 (fun n -> conf
.scrollstep
<- n);
2177 src#
int "horizontal scroll step"
2178 (fun () -> conf
.hscrollstep
)
2179 (fun v
-> conf
.hscrollstep
<- v
);
2181 src#
int "auto scroll step"
2183 match !S.autoscroll
with
2185 | _ -> conf
.autoscrollstep
)
2187 let n = boundastep
!S.winh
n in
2188 if !S.autoscroll
<> None
2189 then S.autoscroll
:= Some
n;
2190 conf
.autoscrollstep
<- n);
2193 (fun () -> truncate
(conf
.zoom *. 100.))
2194 (fun v
-> pivotzoom ((float v
) /. 100.));
2197 (fun () -> conf
.angle
)
2198 (fun v
-> reqlayout v conf
.fitmodel
);
2200 src#
int "scroll bar width"
2201 (fun () -> conf
.scrollbw
)
2204 reshape !S.winw
!S.winh
;
2207 src#
int "scroll handle height"
2208 (fun () -> conf
.scrollh
)
2209 (fun v
-> conf
.scrollh
<- v
;);
2211 src#
int "thumbnail width"
2212 (fun () -> conf
.thumbw
)
2214 conf
.thumbw
<- min
4096 v
;
2217 leavebirdseye beye
false;
2219 | Textentry
_ | View
| LinkNav
_ -> ()
2222 let mode = !S.mode in
2223 src#
string "columns"
2225 match conf
.columns
with
2227 | Cmulti
(multi
, _) -> multicolumns_to_string multi
2228 | Csplit
(count
, _) -> "-" ^ string_of_int count
2231 let n, a, b = multicolumns_of_string v
in
2232 setcolumns mode n a b);
2235 src#caption
"Pixmap cache" 0;
2236 src#int_with_suffix
"size (advisory)"
2237 (fun () -> conf
.memlimit
)
2238 (fun v
-> conf
.memlimit
<- v
);
2242 Printf.sprintf
"%s bytes, %d tiles"
2243 (string_with_suffix_of_int
!S.memused
)
2244 (Hashtbl.length
S.tilemap
)) 1;
2247 src#caption
"Layout" 0;
2248 src#caption2
"Dimension"
2249 (fun () -> Printf.sprintf
"%dx%d (virtual %dx%d)"
2254 then src#caption2
"Position" (fun () ->
2255 Printf.sprintf
"%dx%d" !S.x !S.y
2257 else src#caption2
"Position" (fun () -> describe_layout !S.layout) 1;
2260 let btos b = Utf8syms.(if b then lguillemet
else rguillemet
) in
2261 src#
bool ~offset
:0 ~
btos "Extended parameters"
2262 (fun () -> !showextended)
2263 (fun v
-> showextended := v
; fillsrc prevmode prevuioh
);
2266 src#
bool "update cursor"
2267 (fun () -> conf
.updatecurs
)
2268 (fun v
-> conf
.updatecurs
<- v
);
2269 src#
bool "scroll-bar on the left"
2270 (fun () -> conf
.leftscroll
)
2271 (fun v
-> conf
.leftscroll
<- v
);
2273 (fun () -> conf
.verbose
)
2274 (fun v
-> conf
.verbose
<- v
);
2275 src#
bool "invert colors"
2276 (fun () -> conf
.invert
)
2277 (fun v
-> conf
.invert
<- v
);
2279 (fun () -> conf
.maxhfit
)
2280 (fun v
-> conf
.maxhfit
<- v
);
2282 (fun () -> conf
.pax
!= None
)
2285 then conf
.pax
<- Some
(now
())
2286 else conf
.pax
<- None
);
2287 src#
string "tile size"
2288 (fun () -> Printf.sprintf
"%dx%d" conf
.tilew conf
.tileh
)
2291 let w, h = Scanf.sscanf v
"%dx%d" (fun w h -> w, h) in
2292 conf
.tilew
<- max
64 w;
2293 conf
.tileh
<- max
64 h;
2295 with exn
-> settextfmt "bad tile size `%s': %s" v
@@ exntos exn
);
2296 src#
int "texture count"
2297 (fun () -> conf
.texcount
)
2299 if Ffi.realloctexts v
2300 then conf
.texcount
<- v
2301 else impmsg "failed to set texture count please retry later");
2302 src#
int "slice height"
2303 (fun () -> conf
.sliceheight
)
2305 conf
.sliceheight
<- v
;
2306 wcmd U.sliceh "%d" conf
.sliceheight
);
2307 src#
int "anti-aliasing level"
2308 (fun () -> conf
.aalevel
)
2310 conf
.aalevel
<- bound v
0 8;
2311 S.anchor
:= getanchor
();
2312 opendoc !S.path !S.mimetype
!S.password);
2313 src#
string "page scroll scaling factor"
2314 (fun () -> string_of_float conf
.pgscale)
2316 try conf
.pgscale <- float_of_string v
2319 Printf.sprintf
"bad page scroll scaling factor `%s': %s" v
2321 src#
int "ui font size"
2322 (fun () -> fstate
.fontsize
)
2323 (fun v
-> setfontsize (bound v
5 100));
2324 src#
int "hint font size"
2325 (fun () -> conf
.hfsize
)
2326 (fun v
-> conf
.hfsize
<- bound v
5 100);
2327 src#
string "hint chars"
2328 (fun () -> conf
.hcs
)
2335 Printf.sprintf
"invalid hint chars %S: %s" v
(exntos exn
));
2336 src#
string "trim fuzz"
2337 (fun () -> irect_to_string conf
.trimfuzz
)
2340 conf
.trimfuzz
<- irect_of_string v
;
2342 then settrim true conf
.trimfuzz
;
2343 with exn
-> settextfmt "bad irect `%s': %s" v
@@ exntos exn
);
2344 src#
bool ~
btos "external commands"
2345 (fun () -> !showcommands)
2346 (fun v
-> showcommands := v
; fillsrc prevmode prevuioh
);
2349 src#
string " uri launcher"
2350 (fun () -> conf
.urilauncher
)
2351 (fun v
-> conf
.urilauncher
<- v
);
2352 src#
string " path launcher"
2353 (fun () -> conf
.pathlauncher
)
2354 (fun v
-> conf
.pathlauncher
<- v
);
2355 src#
string " selection"
2356 (fun () -> conf
.selcmd
)
2357 (fun v
-> conf
.selcmd
<- v
);
2358 src#
string " synctex"
2359 (fun () -> conf
.stcmd
)
2360 (fun v
-> conf
.stcmd
<- v
);
2362 (fun () -> conf
.paxcmd
)
2363 (fun v
-> conf
.paxcmd
<- v
);
2364 src#
string " ask password"
2365 (fun () -> conf
.passcmd)
2366 (fun v
-> conf
.passcmd <- v
);
2367 src#
string " save path"
2368 (fun () -> conf
.savecmd
)
2369 (fun v
-> conf
.savecmd
<- v
);
2371 src#colorspace
"color space"
2372 (fun () -> CSTE.to_string conf
.colorspace
)
2374 conf
.colorspace
<- CSTE.of_int v
;
2377 src#paxmark
"pax mark method"
2378 (fun () -> MTE.to_string conf
.paxmark
)
2379 (fun v
-> conf
.paxmark
<- MTE.of_int v
);
2380 src#
bool "mouse wheel scrolls pages"
2381 (fun () -> conf
.wheelbypage
)
2382 (fun v
-> conf
.wheelbypage
<- v
);
2383 src#
bool "open remote links in a new instance"
2384 (fun () -> conf
.riani
)
2385 (fun v
-> conf
.riani
<- v
);
2386 src#
bool "edit annotations inline"
2387 (fun () -> conf
.annotinline
)
2388 (fun v
-> conf
.annotinline
<- v
);
2389 src#
bool "coarse positioning in presentation mode"
2390 (fun () -> conf
.coarseprespos
)
2391 (fun v
-> conf
.coarseprespos
<- v
);
2392 src#
bool "use document CSS"
2393 (fun () -> conf
.usedoccss
)
2395 conf
.usedoccss
<- v
;
2396 S.anchor
:= getanchor
();
2397 opendoc !S.path !S.mimetype
!S.password);
2398 src#
bool ~
btos "colors"
2399 (fun () -> !showcolors)
2400 (fun v
-> showcolors := v
; fillsrc prevmode prevuioh
);
2403 colorp " background"
2404 (fun () -> conf
.bgcolor
)
2405 (fun v
-> conf
.bgcolor
<- v
);
2407 (fun () -> conf
.papercolor
)
2409 conf
.papercolor
<- v
;
2410 Ffi.setpapercolor conf
.papercolor
;
2414 (fun () -> conf
.sbarcolor
)
2415 (fun v
-> conf
.sbarcolor
<- v
);
2416 rgba " scrollbar handle"
2417 (fun () -> conf
.sbarhndlcolor
)
2418 (fun v
-> conf
.sbarhndlcolor
<- v
);
2420 (fun () -> conf
.texturecolor
)
2422 GlTex.env
(`
color v
);
2423 conf
.texturecolor
<- v
;
2426 (fun () -> string_of_float conf
.colorscale
)
2427 (fun v
-> conf
.colorscale
<- bound
(float_of_string v
) 0.0 1.0);
2429 src#
bool ~
btos "reflowable layout"
2430 (fun () -> !showrefl)
2431 (fun v
-> showrefl := v
; fillsrc prevmode prevuioh
);
2435 (fun () -> conf
.rlw
)
2436 (fun v
-> conf
.rlw
<- v
; reload ());
2438 (fun () -> conf
.rlh
)
2439 (fun v
-> conf
.rlh
<- v
; reload ());
2441 (fun () -> conf
.rlem
)
2442 (fun v
-> conf
.rlem
<- v
; reload ());
2447 src#caption
"Document" 0;
2448 List.iter
(fun (_, s) -> src#caption
s 1) !S.docinfo
;
2449 src#caption2
"Pages" (fun () -> string_of_int
!S.pagecount
) 1;
2450 src#caption2
"Dimensions"
2451 (fun () -> string_of_int
(List.length
!S.pdims
)) 1;
2452 if nonemptystr conf
.css
2453 then src#caption2
"CSS" (fun () -> conf
.css
) 1;
2457 src#caption
"Trimmed margins" 0;
2458 src#caption2
"Dimensions"
2459 (fun () -> string_of_int
(List.length
!S.pdims
)) 1;
2463 src#caption
"OpenGL" 0;
2464 src#caption
("Vendor\t" ^
GlMisc.get_string `vendor
) 1;
2465 src#caption
("Renderer\t" ^
GlMisc.get_string `renderer
) 1;
2468 src#caption
"Location" 0;
2469 if nonemptystr
!S.origin
2470 then src#caption
("Origin\t" ^
Ffi.mbtoutf8
!S.origin
) 1;
2471 src#caption
("Path\t" ^
Ffi.mbtoutf8
!S.path) 1;
2472 if nonemptystr conf
.dcf
2473 then src#caption
("DCF\t" ^
Ffi.mbtoutf8 conf
.dcf
) 1;
2475 src#reset prevmode prevuioh
;
2480 let prevmode = !S.mode
2481 and prevuioh
= !S.uioh in
2482 fillsrc prevmode prevuioh
;
2483 let source = (src :> lvsource
) in
2484 let modehash = findkeyhash conf
"info" in
2486 inherit listview ~zebra
:false ~helpmode
:false
2487 ~
source ~trusted
:true ~
modehash as super
2488 val mutable m_prevmemused
= 0
2489 method! infochanged
= function
2491 if m_prevmemused
!= !S.memused
2493 m_prevmemused
<- !S.memused
;
2494 Glutils.postRedisplay
"memusedchanged";
2496 | Pdim
-> Glutils.postRedisplay
"pdimchanged"
2497 | Docinfo
-> fillsrc prevmode prevuioh
2498 method! key key mask
=
2499 if not
(Wsi.withctrl mask
)
2501 match [@warning
"-fragile-match"] Wsi.ks2kt
key with
2502 | Keys.Left
-> coe
(self#updownlevel ~
-1)
2503 | Keys.Right
-> coe
(self#updownlevel
1)
2504 | _ -> super#
key key mask
2505 else super#
key key mask
2507 Glutils.postRedisplay
"info";
2512 inherit lvsourcebase
2513 method getitemcount
= Array.length
!S.help
2515 let s, l, _ = !S.help
.(n) in
2518 method exit ~
uioh ~cancel ~
active ~
first ~pan
=
2522 match !S.help
.(active) with
2523 | _, _, Some
f -> Some
(f uioh)
2524 | _, _, None
-> Some
uioh
2533 method hasaction
n =
2534 match !S.help
.(n) with
2535 | _, _, Some
_ -> true
2536 | _, _, None
-> false
2538 initializer m_active
<- -1
2541 let modehash = findkeyhash conf
"help" in
2543 new listview ~zebra
:false ~helpmode
:true
2544 ~
source ~trusted
:true ~
modehash |> setuioh
;
2545 Glutils.postRedisplay
"help"
2548 let msgsource = object
2549 inherit lvsourcebase
2550 val mutable m_items
= E.a
2552 method getitemcount
= 1 + Array.length m_items
2557 else m_items
.(n-1), 0
2559 method exit ~
uioh ~cancel ~
active ~
first ~pan
=
2564 then Buffer.clear
S.errmsgs
;
2571 method hasaction
n =
2575 S.newerrmsgs
:= false;
2576 let l = Str.split
Re.crlf
(Buffer.contents
S.errmsgs
) in
2577 m_items
<- Array.of_list
l
2579 initializer m_active
<- 0
2586 let source = (msgsource :> lvsource
) in
2587 let modehash = findkeyhash conf
"listview" in
2589 inherit listview ~zebra
:false ~helpmode
:false
2590 ~
source ~trusted
:false ~
modehash as super
2593 then msgsource#reset
;
2596 Glutils.postRedisplay
"msgs"
2599 let editor = getenvdef
"EDITOR" E.s in
2603 let tmppath = Filename.temp_file
"llpp" "note" in
2606 let oc = open_out
tmppath in
2610 let execstr = editor ^
" " ^
tmppath in
2611 let eret r
= Printf.ksprintf
(fun s -> adderrmsg "gtut:eret" s; r
) in
2613 match spawn
execstr [] with
2614 | exception exn
-> eret E.s "spawn(%S) failed: %s" execstr @@ exntos exn
2616 match Unix.waitpid
[] pid
with
2617 | exception exn
-> eret E.s "waitpid(%d) failed: %s" pid
@@ exntos exn
2620 | Unix.WEXITED
0 -> filecontents
tmppath
2622 eret E.s "editor process(%s) exited abnormally: %d" execstr n
2623 | Unix.WSIGNALED
n ->
2624 eret E.s "editor process(%s) was killed by signal %d" execstr n
2625 | Unix.WSTOPPED
n ->
2626 eret E.s "editor(%s) process was stopped by signal %d" execstr n
2628 match Unix.unlink
tmppath with
2629 | exception exn
-> eret s "failed to ulink %S: %s" tmppath @@ exntos exn
2632 let enterannotmode opaque slinkindex
=
2633 let msgsource = object
2634 inherit lvsourcebase
2635 val mutable m_text
= E.s
2636 val mutable m_items
= E.a
2638 method getitemcount
= Array.length m_items
2641 let label, _func
= m_items
.(n) in
2644 method exit ~
uioh ~cancel ~
active ~
first ~pan
=
2645 ignore
(uioh, first, pan
);
2648 let _label, func
= m_items
.(active) in
2653 method hasaction
n = nonemptystr
@@ fst m_items
.(n)
2656 let rec split accu b i
=
2658 if p = String.length
s
2659 then (String.sub s b (p-b), fun () -> ()) :: accu
2661 if (i
> 70 && s.[p] = ' '
) || s.[p] = '
\r'
|| s.[p] = '
\n'
2663 let ss = if i
= 0 then E.s else String.sub s b i
in
2664 split ((ss, fun () -> ())::accu) (p+1) 0
2665 else split accu b (i
+1)
2668 wcmd1 U.freepage opaque;
2670 Hashtbl.fold (fun key opaque'
accu ->
2671 if opaque'
= opaque'
2672 then key :: accu else accu) S.pagemap
[]
2674 List.iter
(Hashtbl.remove
S.pagemap
) keys;
2679 Ffi.delannot
opaque slinkindex
;
2682 let edit inline
() =
2687 Ffi.modannot
opaque slinkindex
s;
2693 let mode = !S.mode in
2694 let te = ("annotation: ", m_text
, None
, textentry, update, true) in
2695 S.mode := Textentry
(te, fun _ -> S.mode := mode);
2698 else getusertext m_text
|> update
2702 ( "[Copy]", fun () -> selstring conf
.selcmd m_text
)
2703 :: ("[Delete]", dele)
2704 :: ("[Edit]", edit conf
.annotinline
)
2705 :: (E.s, fun () -> ())
2706 :: split [] 0 0 |> List.rev
|> Array.of_list
2708 initializer m_active
<- 0
2712 let s = Ffi.gettextannot
opaque slinkindex
in
2715 let source = (msgsource :> lvsource
) in
2716 let modehash = findkeyhash conf
"listview" in
2717 object inherit listview ~zebra
:false
2718 ~helpmode
:false ~
source ~trusted
:false ~
modehash
2720 Glutils.postRedisplay
"enterannotmode"
2722 let gotoremote spec
=
2723 let filename, dest
= splitatchar spec '#'
in
2724 let getpath filename =
2726 if nonemptystr
filename
2728 if Filename.is_relative
filename
2730 let dir = Filename.dirname
!S.path in
2732 if Filename.is_implicit
dir
2733 then Filename.concat
(Sys.getcwd
()) dir
2736 Filename.concat
dir filename
2740 if Sys.file_exists
path
2744 let path = getpath filename in
2746 then adderrfmt "gotoremote/getpath" "failed getpath for %S\n" filename
2751 let cmd = Lazy.force_val lcmd
in
2752 match spawn
cmd with
2753 | exception exn
-> dolog
"failed to execute `%s': %s" cmd @@ exntos exn
2756 let anchor = getanchor
() in
2757 let ranchor = !S.path, !S.mimetype
, !S.password, anchor, !S.origin
in
2759 S.ranchors
:= ranchor :: !S.ranchors
;
2760 opendoc path E.s E.s;
2762 if substratis spec
0 "page="
2764 match Scanf.sscanf spec
"page=%d" (fun n -> n) with
2766 adderrfmt "error parsing remote destination" "%s %s" spec
@@ exntos exn
2768 S.anchor := (pageno, 0.0, 0.0);
2769 dospawn @@ lazy (Printf.sprintf
"%s -page %d %S"
2770 !S.selfexec
pageno path);
2772 S.nameddest
:= dest
;
2773 dospawn @@ lazy (!S.selfexec ^
" " ^
path ^
" -dest " ^ dest
)
2776 let gotounder = function
2777 | Ulinkuri
s when Ffi.isexternallink
s ->
2778 if substratis
s 0 "file://"
2779 then gotoremote @@ String.sub s 7 (String.length
s - 7)
2780 else Help.gotouri conf
.urilauncher
s
2782 let pageno, x, y = Ffi.uritolocation
s in
2784 gotopagexy pageno x y
2785 | Utext
_ | Unone
-> ()
2786 | Utextannot
(opaque, slinkindex
) -> enterannotmode opaque slinkindex
2787 | Ufileannot
(opaque, slinkindex
) ->
2788 if emptystr conf
.savecmd
2789 then adderrmsg "savepath-command is empty"
2790 "don't know where to save attachment"
2792 let filename = Ffi.getfileannot
opaque slinkindex
in
2793 let savecmd = Str.global_replace
Re.percent filename conf
.savecmd in
2797 "failed to obtain path to the saved attachment: %s") savecmd
2799 Ffi.savefileannot
opaque slinkindex
path
2801 let gotooutline (_, _, kind
) =
2804 | Oanchor
((pageno, y, _) as anchor) ->
2807 getanchory (if conf
.presentation
then (pageno, y, 1.0) else anchor)
2808 | Ouri
uri -> gotounder (Ulinkuri
uri)
2809 | Olaunch
cmd -> error
"gotounder (Ulaunch %S)" cmd
2810 | Oremote
(remote
, pageno) ->
2811 error
"gotounder (Uremote (%S,%d) )" remote
pageno
2812 | Ohistory hist
-> gotohist hist
2813 | Oremotedest
(path, dest
) ->
2814 error
"gotounder (Uremotedest (%S, %S))" path dest
2816 class outlinesoucebase fetchoutlines
= object (self
)
2817 inherit lvsourcebase
2818 val mutable m_items
= E.a
2819 val mutable m_minfo
= E.a
2820 val mutable m_orig_items
= E.a
2821 val mutable m_orig_minfo
= E.a
2822 val mutable m_narrow_patterns
= []
2823 val mutable m_gen
= -1
2825 method getitemcount
= Array.length m_items
2828 let s, n, _ = m_items
.(n) in
2831 method exit ~
(uioh:uioh) ~cancel ~
active ~
(first:int) ~pan
: uioh option =
2832 ignore
(uioh, first);
2834 if m_narrow_patterns
= []
2835 then m_orig_items
, m_orig_minfo
2836 else m_items
, m_minfo
2843 gotooutline m_items
.(active);
2851 method hasaction
(_:int) = true
2854 if Array.length m_items
!= Array.length m_orig_items
2857 match m_narrow_patterns
with
2859 | many
-> String.concat
Utf8syms.ellipsis
(List.rev many
)
2861 "Narrowed to " ^
s ^
" (ctrl-u to restore)"
2865 match m_narrow_patterns
with
2868 | head
:: _ -> Utf8syms.ellipsis ^ head
2870 method narrow
pattern =
2871 match Str.regexp_case_fold
pattern with
2874 let rec loop accu minfo
n =
2877 m_items
<- Array.of_list
accu;
2878 m_minfo
<- Array.of_list minfo
;
2881 let (s, _, _) as o
= m_items
.(n) in
2883 match Str.search_forward re
s 0 with
2884 | exception Not_found
-> accu, minfo
2885 | first -> o
:: accu, (first, Str.match_end
()) :: minfo
2887 loop accu minfo
(n-1)
2889 loop [] [] (Array.length m_items
- 1)
2891 method! getminfo
= m_minfo
2894 m_orig_items
<- fetchoutlines
();
2895 m_minfo
<- m_orig_minfo
;
2896 m_items
<- m_orig_items
2898 method add_narrow_pattern
pattern =
2899 m_narrow_patterns
<- pattern :: m_narrow_patterns
2901 method del_narrow_pattern
=
2902 match m_narrow_patterns
with
2903 | _ :: rest
-> m_narrow_patterns
<- rest
2908 match m_narrow_patterns
with
2909 | pattern :: [] -> self#narrow
pattern; pattern
2911 List.fold_left
(fun accu pattern ->
2912 self#narrow
pattern;
2913 pattern ^
Utf8syms.ellipsis ^
accu) E.s list
2915 method calcactive
(_:anchor) = 0
2917 method reset
anchor items =
2920 m_orig_items
<- items;
2922 m_narrow_patterns
<- [];
2924 m_orig_minfo
<- E.a;
2928 if items != m_orig_items
2930 m_orig_items
<- items;
2931 if m_narrow_patterns
== []
2932 then m_items
<- items;
2935 let active = self#calcactive
anchor in
2937 m_first
<- firstof m_first
active
2940 let outlinesource fetchoutlines
= object
2941 inherit outlinesoucebase fetchoutlines
2942 method! calcactive
anchor =
2943 let rely = getanchory anchor in
2944 let rec loop n best bestd
=
2945 if n = Array.length m_items
2948 let _, _, kind
= m_items
.(n) in
2951 let orely = getanchory anchor in
2952 let d = abs
(orely - rely) in
2955 else loop (n+1) best bestd
2956 | Onone
| Oremote
_ | Olaunch
_
2957 | Oremotedest
_ | Ouri
_ | Ohistory
_ ->
2958 loop (n+1) best bestd
2963 let enteroutlinemode, enterbookmarkmode
, enterhistmode
=
2964 let fetchoutlines sourcetype
() =
2965 match sourcetype
with
2966 | `bookmarks
-> Array.of_list
!S.bookmarks
2967 | `outlines
-> !S.outlines
2968 | `history
-> genhistoutlines () |> Array.of_list
2970 let so = outlinesource (fetchoutlines `outlines
) in
2971 let sb = outlinesource (fetchoutlines `bookmarks
) in
2972 let sh = outlinesource (fetchoutlines `history
) in
2973 let mkselector sourcetype
source =
2975 let outlines = fetchoutlines sourcetype
() in
2976 if Array.length
outlines = 0
2977 then showtext ' ' emptymsg
2980 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
2981 let anchor = getanchor
() in
2982 source#reset
anchor outlines;
2983 S.text := source#greetmsg
;
2984 new outlinelistview ~zebra
:(sourcetype
=`history
) ~
source |> setuioh
;
2985 Glutils.postRedisplay
"enter selector";
2989 let mkenter src errmsg
s = fun () -> mkselector src s errmsg
in
2990 ( mkenter `
outlines "document has no outline" so
2991 , mkenter `bookmarks
"document has no bookmarks (yet)" sb
2992 , mkenter `history
"history is empty" sh )
2994 let addbookmark title
a =
2995 let b = List.filter
(fun (title'
, _, _) -> title
<> title'
) !S.bookmarks
in
2996 S.bookmarks
:= (title
, 0, Oanchor
a) :: b
2998 let quickbookmark ?title
() =
2999 match !S.layout with
3006 let tm = localtime
(now
()) in
3008 "Quick (page %d) (bookmarked on %02d/%02d/%d at %02d:%02d)"
3010 tm.tm_mday
(tm.tm_mon
+1) (tm.tm_year
+1900) tm.tm_hour
tm.tm_min
3012 | Some
title -> title
3014 addbookmark title (getanchor1
l)
3016 let setautoscrollspeed step goingdown
=
3017 let incr = max
1 ((abs step
) / 2) in
3018 let incr = if goingdown
then incr else -incr in
3019 let astep = boundastep
!S.winh
(step
+ incr) in
3020 S.autoscroll
:= Some
astep
3023 match conf
.columns
with
3025 | Csingle
_ | Cmulti
_ -> !S.x != 0 || conf
.zoom > 1.0
3027 let existsinrow pageno (columns
, coverA
, coverB
) p =
3028 let last = ((pageno - coverA
) mod columns
) + columns
in
3029 let rec any = function
3032 if l.pageno = coverA
- 1 || l.pageno = !S.pagecount
- coverB
3036 then (if l.pageno = last then false else any rest
)
3043 match !S.layout with
3045 let pageno = page_of_y
!S.y in
3046 gotoxy !S.x (getpagey
(pageno+1))
3048 match conf
.columns
with
3050 if conf
.presentation
&& rest
== [] && l.pageh
> l.pagey + l.pagevh
3052 let y = U.add_to_y_and_clamp (U.pgscale !S.winh
) in
3055 let pageno = min
(l.pageno+1) (!S.pagecount
-1) in
3056 gotoxy !S.x (getpagey
pageno)
3057 | Cmulti
((c, _, _) as cl
, _) ->
3058 if conf
.presentation
3059 && (existsinrow l.pageno cl
3060 (fun l -> l.pageh
> l.pagey + l.pagevh))
3062 let y = U.add_to_y_and_clamp (U.pgscale !S.winh
) in
3065 let pageno = min
(l.pageno+c) (!S.pagecount
-1) in
3066 gotoxy !S.x (getpagey
pageno)
3068 if l.pageno < !S.pagecount
- 1 || l.pagecol
< n - 1
3070 let pagey, pageh
= getpageyh
l.pageno in
3071 let pagey = pagey + pageh
* l.pagecol
in
3072 let ips = if l.pagecol
= 0 then 0 else conf
.interpagespace
in
3073 gotoxy !S.x (pagey + pageh
+ ips)
3076 match !S.layout with
3078 let pageno = page_of_y
!S.y in
3079 gotoxy !S.x (getpagey
(pageno-1))
3081 match conf
.columns
with
3083 if conf
.presentation
&& l.pagey != 0
3084 then gotoxy !S.x (U.add_to_y_and_clamp (U.pgscale ~
-(!S.winh
)))
3086 let pageno = max
0 (l.pageno-1) in
3087 gotoxy !S.x (getpagey
pageno)
3088 | Cmulti
((c, _, coverB
) as cl
, _) ->
3089 if conf
.presentation
&&
3090 (existsinrow l.pageno cl
(fun l -> l.pagey != 0))
3091 then gotoxy !S.x (U.add_to_y_and_clamp (U.pgscale ~
-(!S.winh
)))
3094 if l.pageno = !S.pagecount
- coverB
3098 let pageno = max
0 (l.pageno-decr) in
3099 gotoxy !S.x (getpagey
pageno)
3107 let pageno = max
0 (l.pageno-1) in
3108 let pagey, pageh
= getpageyh
pageno in
3111 let pagey, pageh
= getpageyh
l.pageno in
3112 pagey + pageh
* (l.pagecol
-1) - conf
.interpagespace
3117 if emptystr conf
.savecmd
3118 then adderrmsg "savepath-command is empty"
3119 "don't know where to save modified document"
3121 let savecmd = Str.global_replace
Re.percent !S.path conf
.savecmd in
3124 (adderrfmt savecmd "failed to obtain path to the saved copy: %s")
3129 let tmp = path ^
".tmp" in
3131 Unix.rename
tmp path
3133 let viewkeyboard key mask
=
3135 let mode = !S.mode in
3136 S.mode := Textentry
(te, fun _ -> S.mode := mode);
3139 Glutils.postRedisplay
"view:enttext"
3141 match !S.nav
.past
with
3144 S.nav
:= { past
= prest
; future
= getanchor
() :: !S.nav
.future
; };
3145 gotoxy !S.x (getanchory prev
)
3147 let ctrl = Wsi.withctrl mask
in
3149 match Wsi.ks2kt
key with
3150 | Ascii 'Q'
-> exit
0
3153 match List.rev
!S.rects
with
3155 | (pageno, _, (_, y0, _, y1, _, y2
, _, y3
)) :: _ ->
3156 f pageno (y0, y1, y2
, y3
)
3157 and fsel
f (y0, y1, y2
, y3
) = f y0 y1 |> f y2
|> f y3
|> truncate
in
3158 let ondone msg
= S.text := msg
3160 match [@warning
"-fragile-match"] k
with
3163 let miny = fsel min ys
in
3164 let hh = (fsel max ys
- miny)/2 in
3165 gotopage1 pageno (miny + hh - !S.winh
/2)
3170 let f pageno ys
= gotopage1 pageno @@ fsel min ys
in
3174 let f pageno ys
= gotopage1 pageno (fsel max ys
- !S.winh
) in
3179 enttext (": ", E.s, None
, zmod
!S.mode, ondone, true)
3181 if Ffi.hasunsavedchanges
()
3184 if conf
.angle
mod 360 = 0 && not
(isbirdseye
!S.mode)
3188 | None
-> LinkNav
(Ltgendir
0)
3189 | Some
pn -> LinkNav
(Ltexact
pn)
3193 else impmsg "keyboard link navigation does not work under rotation"
3194 | Escape
| Ascii 'q'
->
3195 begin match !S.mstate
with
3198 Glutils.postRedisplay
"kill rect";
3201 | Mscrolly
| Mscrollx
3204 begin match !S.mode with
3207 | Ltexact pl
-> S.lnava
:= Some pl
3208 | Ltgendir
_ | Ltnotready
_ -> S.lnava
:= None
3211 Glutils.postRedisplay
"esc leave linknav"
3212 | Birdseye
_ | Textentry
_ | View
->
3213 match !S.ranchors
with
3215 | (path, mimetype
, password, anchor, origin
) :: rest
->
3220 opendoc path mimetype
password
3223 | Ascii 'o'
-> enteroutlinemode ()
3227 Hashtbl.iter
(fun _ opaque -> Ffi.clearmark
opaque) S.pagemap
;
3228 Glutils.postRedisplay
"dehighlight";
3229 | Ascii
(('
/'
| '?'
) as c) ->
3230 let ondone isforw
s =
3231 cbput
!S.hists
.pat
s;
3232 S.searchpattern
:= s;
3235 enttext (String.make
1 c, E.s, Some
(onhist !S.hists
.pat
),
3236 textentry, ondone (c = '
/'
), true)
3237 | Ascii '
+'
| Ascii '
='
when ctrl ->
3238 let incr = if conf
.zoom +. 0.01 > 0.1 then 0.1 else 0.01 in
3239 pivotzoom (conf
.zoom +. incr)
3243 try int_of_string
s with exn
->
3244 S.text := Printf.sprintf
"bad integer `%s': %s" s @@ exntos exn
;
3250 S.text := "page bias is now " ^ string_of_int
n;
3253 enttext ("page bias: ", E.s, None
, intentry, ondone, true)
3254 | Ascii '
-'
when ctrl ->
3255 let decr = if conf
.zoom -. 0.1 < 0.1 then 0.01 else 0.1 in
3256 pivotzoom (max
0.01 (conf
.zoom -. decr))
3258 let ondone msg
= S.text := msg
in
3259 enttext ("option: ", E.s, None
,
3260 optentry !S.mode, ondone, true)
3261 | Ascii '
0'
when ctrl ->
3265 | Ascii
('
1'
|'
2'
as c) when ctrl && conf
.fitmodel
!= FitPage
->
3267 match conf
.columns
with
3268 | Csingle
_ | Cmulti
_ -> 1
3269 | Csplit
(n, _) -> n
3272 conf
.interpagespace
lsl (if conf
.presentation
then 1 else 0)
3274 let zoom = Ffi.zoomforh
!S.winw
h 0 cols in
3275 if zoom > 0.0 && (c = '
2'
|| zoom < 1.0)
3277 | Ascii '
3'
when ctrl ->
3279 match conf
.fitmodel
with
3280 | FitWidth
-> FitProportional
3281 | FitProportional
-> FitPage
3282 | FitPage
-> FitWidth
3284 S.text := "fit model: " ^
FMTE.to_string
fm;
3285 reqlayout conf
.angle
fm
3286 | Ascii '
4'
when ctrl ->
3287 let zoom = Ffi.getmaxw
() /. float !S.winw
in
3288 if zoom > 0.0 then setzoom zoom
3289 | Fn
9 -> togglebirdseye ()
3290 | Ascii '
9'
when ctrl -> togglebirdseye ()
3291 | Ascii
('
0'
..'
9'
as c) when not
ctrl ->
3294 try int_of_string
s with exn
->
3295 adderrfmt "int_of_string" "`%s': %s" s @@ exntos exn
;
3301 cbput
!S.hists
.pag
(string_of_int
n);
3302 gotopage1 (n + conf
.pagebias
- 1) 0;
3305 let pageentry text = function [@warning
"-fragile-match"]
3306 | Keys.Ascii '
g'
-> TEdone
text
3307 | key -> intentry text key
3309 enttext (":", String.make
1 c, Some
(onhist !S.hists
.pag
),
3310 pageentry, ondone, true)
3312 conf
.scrollb
<- if conf
.scrollb
= 0 then (scrollbvv
lor scrollbhv
) else 0;
3313 Glutils.postRedisplay
"toggle scrollbar";
3315 S.bzoom
:= not
!S.bzoom
;
3317 showtext ' '
("block zoom " ^ onoffs
!S.bzoom
)
3319 conf
.hlinks
<- not conf
.hlinks
;
3320 S.text := "highlightlinks " ^ onoffs conf
.hlinks
;
3321 Glutils.postRedisplay
"toggle highlightlinks"
3323 if conf
.angle
mod 360 = 0
3326 let mode = !S.mode in
3327 let te = ("goto: ", E.s, None
, linknentry, linknact gotounder, false) in
3328 S.mode := Textentry
(te, (fun _ -> S.glinks
:= false; S.mode := mode));
3330 Glutils.postRedisplay
"view:linkent(F)"
3332 else impmsg "hint mode does not work under rotation"
3335 let mode = !S.mode in
3336 let te = ("copy: ", E.s, None
, linknentry,
3337 linknact (fun under -> selstring conf
.selcmd
(undertext under)),
3339 S.mode := Textentry
(te, (fun _ -> S.glinks
:= false; S.mode := mode));
3341 Glutils.postRedisplay
"view:linkent"
3343 begin match !S.autoscroll
with
3345 conf
.autoscrollstep
<- step
;
3346 S.autoscroll
:= None
3347 | None
-> S.autoscroll
:= Some conf
.autoscrollstep
3349 | Ascii '
p'
when ctrl -> launchpath ()
3351 setpresentationmode (not conf
.presentation
);
3352 showtext ' '
("presentation mode " ^ onoffs conf
.presentation
)
3354 if List.mem
Wsi.Fullscreen
!S.winstate
3355 then Wsi.reshape conf
.cwinw conf
.cwinh
3356 else Wsi.fullscreen
()
3357 | Ascii
('
p'
|'N'
) -> search !S.searchpattern
false
3358 | Ascii '
n'
| Fn
3 -> search !S.searchpattern
true
3360 begin match !S.layout with
3362 | l :: _ -> gotoxy !S.x (getpagey
l.pageno)
3364 | Ascii ' '
-> nextpage ()
3365 | Delete
-> prevpage ()
3366 | Ascii '
='
-> showtext ' '
(describe_layout !S.layout);
3368 begin match !S.layout with
3371 Wsi.reshape l.pagew
l.pageh
;
3372 Glutils.postRedisplay
"w"
3374 | Ascii '
\''
-> enterbookmarkmode
()
3375 | Ascii 'i'
-> enterinfomode ()
3376 | Ascii 'e'
when Buffer.length
S.errmsgs
> 0 -> entermsgsmode ()
3379 match !S.layout with
3380 | l :: _ when nonemptystr
s -> addbookmark s @@ getanchor1
l
3383 enttext ("bookmark: ", E.s, None
, textentry, ondone, true)
3386 showtext ' '
"Quick bookmark added";
3387 | Ascii '
x'
-> !S.roamf
()
3388 | Ascii
('
<'
|'
>'
as c) ->
3389 reqlayout (conf
.angle
+ (if c = '
>'
then 30 else -30)) conf
.fitmodel
3390 | Ascii
('
['
|'
]'
as c) ->
3392 bound
(conf
.colorscale
+. (if c = '
]'
then 0.1 else -0.1)) 0.0 1.0;
3393 Glutils.postRedisplay
"brightness";
3394 | Ascii '
c'
when !S.mode = View
->
3399 let m = (!S.winw
- !S.w) / 2 in
3404 match !S.prevcolumns
with
3405 | None
-> (1, 0, 0), 1.0
3406 | Some
(columns
, z
) ->
3409 | Csplit
(c, _) -> -c, 0, 0
3410 | Cmulti
((c, a, b), _) -> c, a, b
3411 | Csingle
_ -> 1, 0, 0
3415 setcolumns View
c a b;
3417 | Down
| Up
when ctrl && Wsi.withshift mask
->
3418 let zoom, x = !S.prevzoom
in
3422 begin match !S.autoscroll
with
3424 begin match !S.mode with
3425 | Birdseye beye
-> upbirdseye 1 beye
3426 | Textentry
_ | View
| LinkNav
_ ->
3428 then gotoxy !S.x (U.add_to_y_and_clamp ~
-(!S.winh
/2))
3430 if not
(Wsi.withshift mask
) && conf
.presentation
3432 else gotoxy !S.x (U.add_to_y_and_clamp (-conf
.scrollstep
))
3435 | Some
n -> setautoscrollspeed n false
3438 begin match !S.autoscroll
with
3440 begin match !S.mode with
3441 | Birdseye beye
-> downbirdseye 1 beye
3442 | Textentry
_ | View
| LinkNav
_ ->
3444 then gotoxy !S.x (U.add_to_y_and_clamp (!S.winh
/2))
3446 if not
(Wsi.withshift mask
) && conf
.presentation
3448 else gotoxy !S.x (U.add_to_y_and_clamp (conf
.scrollstep
))
3451 | Some
n -> setautoscrollspeed n true
3453 | Ascii 'H'
-> enterhistmode
()
3454 | Fn
1 when Wsi.withalt mask
-> enterhistmode
()
3455 | Fn
1 -> enterhelpmode ()
3456 | Left
| Right
when not
(Wsi.withalt mask
) ->
3462 else conf
.hscrollstep
3465 let pv = Wsi.ks2kt
key in
3466 if pv = Keys.Left
then dx else -dx
3468 gotoxy (U.panbound (!S.x + dx)) !S.y
3471 Glutils.postRedisplay
"left/right"
3477 match !S.layout with
3479 | l :: _ -> !S.y - l.pagey
3480 else U.add_to_y_and_clamp (U.pgscale ~
- !S.winh
)
3487 match List.rev
!S.layout with
3489 | l :: _ -> getpagey
l.pageno
3490 else U.add_to_y_and_clamp (U.pgscale !S.winh
)
3493 | Ascii '
g'
| Home
->
3496 | Ascii 'G'
| End
->
3498 gotoxy 0 (U.add_to_y_and_clamp !S.maxy)
3499 | Right
when Wsi.withalt mask
->
3500 (match !S.nav
.future
with
3503 S.nav
:= { past
= getanchor
() :: !S.nav
.past
; future
= frest
; };
3504 gotoxy !S.x (getanchory next
)
3506 | Left
when Wsi.withalt mask
-> histback
()
3507 | Backspace
-> histback
()
3508 | Ascii 'r'
-> reload ()
3509 | Ascii 'v'
when conf
.debug
->
3512 match getopaque l.pageno with
3513 | exception Not_found
-> ()
3515 let x0, y0, x1, y1 = Ffi.pagebbox
opaque in
3516 let rect = (float x0, float y0,
3519 float x0, float y1) in
3521 let color = (0.0, 0.0, 1.0 /. (l.pageno mod 3 |> float), 0.5) in
3522 S.rects
:= (l.pageno, color, rect) :: !S.rects
;
3524 Glutils.postRedisplay
"v";
3526 let mode = !S.mode in
3527 let cmd = ref E.s in
3528 let onleave = function
3529 | Cancel
-> S.mode := mode
3532 match getopaque l.pageno with
3533 | exception Not_found
-> ()
3534 | opaque -> pipesel opaque !cmd) !S.layout;
3538 cbput
!S.hists
.sel
s;
3542 "| ", !cmd, Some
(onhist !S.hists
.sel
), textentry, ondone, true
3544 Glutils.postRedisplay
"|";
3545 S.mode := Textentry
(te, onleave);
3546 | (Ascii
_|Fn
_|Enter
|Left
|Right
|Code
_|Ctrl
_) ->
3547 vlog
"huh? %s" (Wsi.keyname
key)
3549 let linknavkeyboard key mask
linknav =
3550 let pv = Wsi.ks2kt
key in
3551 let getpage pageno =
3552 let rec loop = function
3554 | l :: _ when l.pageno = pageno -> Some
l
3555 | _ :: rest
-> loop rest
3558 let doexact (pageno, n) =
3559 match getopaque pageno, getpage pageno with
3563 let under = Ffi.getlink
opaque n in
3564 Glutils.postRedisplay
"link gotounder";
3571 | Home
-> Some
(Ffi.findlink
opaque LDfirst
), -1
3572 | End
-> Some
(Ffi.findlink
opaque LDlast
), 1
3573 | Left
-> Some
(Ffi.findlink
opaque (LDleft
n)), -1
3574 | Right
-> Some
(Ffi.findlink
opaque (LDright
n)), 1
3575 | Up
-> Some
(Ffi.findlink
opaque (LDup
n)), -1
3576 | Down
-> Some
(Ffi.findlink
opaque (LDdown
n)), 1
3577 | Delete
|Escape
|Insert
|Enter
|Next
|Prior
|Ascii
_
3578 | Code
_|Fn
_|Ctrl
_|Backspace
-> None
, 0
3581 begin match Ffi.findpwl
l.pageno dir with
3585 S.mode := LinkNav
(Ltgendir
dir);
3586 let y, h = getpageyh
pageno in
3589 then y + h - !S.winh
3594 begin match getopaque pageno, getpage pageno with
3597 let ld = if dir > 0 then LDfirst
else LDlast
in
3598 Ffi.findlink
opaque ld
3600 begin match link with
3602 showlinktype (Ffi.getlink
opaque m);
3603 S.mode := LinkNav
(Ltexact
(pageno, m));
3604 Glutils.postRedisplay
"linknav jpage";
3605 | Lnotfound
-> notfound dir
3607 | _ | exception Not_found
-> notfound dir
3611 begin match opt with
3612 | Some Lnotfound
-> pwl l dir;
3613 | Some
(Lfound
m) ->
3617 let _, y0, _, y1 = Ffi.getlinkrect
opaque m in
3619 then gotopage1 l.pageno y0
3621 let d = fstate
.fontsize
+ 1 in
3622 if y1 - l.pagey > l.pagevh - d
3623 then gotopage1 l.pageno (y1 - !S.winh
+ d)
3624 else Glutils.postRedisplay
"linknav";
3626 showlinktype (Ffi.getlink
opaque m);
3627 S.mode := LinkNav
(Ltexact
(l.pageno, m));
3630 | None
-> viewkeyboard key mask
3632 | _ | exception Not_found
-> viewkeyboard key mask
3636 begin match linknav with
3637 | Ltexact pa
-> S.lnava
:= Some pa
3638 | Ltgendir
_ | Ltnotready
_ -> ()
3641 Glutils.postRedisplay
"leave linknav"
3645 | Ltgendir
_ | Ltnotready
_ -> viewkeyboard key mask
3646 | Ltexact exact
-> doexact exact
3648 let keyboard key mask
=
3649 if (key = Char.code '
g'
&& Wsi.withctrl mask
) && not
(istextentry
!S.mode)
3650 then wcmd U.interrupt ""
3651 else !S.uioh#
key key mask
|> setuioh
3653 let birdseyekeyboard key mask
3654 ((oconf
, leftx
, pageno, hooverpageno
, anchor) as beye
) =
3656 match conf
.columns
with
3658 | Cmulti
((c, _, _), _) -> c
3659 | Csplit
_ -> error
"bird's eye split mode"
3661 let pgh layout = List.fold_left
3662 (fun m l -> max
l.pageh
m) !S.winh
layout in
3664 match Wsi.ks2kt
key with
3665 | Ascii '
l'
when Wsi.withctrl mask
->
3666 let y, h = getpageyh
pageno in
3667 let top = (!S.winh
- h) / 2 in
3668 gotoxy !S.x (max
0 (y - top))
3669 | Enter
-> leavebirdseye beye
false
3670 | Escape
-> leavebirdseye beye
true
3671 | Up
-> upbirdseye incr beye
3672 | Down
-> downbirdseye incr beye
3673 | Left
-> upbirdseye 1 beye
3674 | Right
-> downbirdseye 1 beye
3677 begin match !S.layout with
3681 S.mode := Birdseye
(oconf
, leftx
, l.pageno, hooverpageno
, anchor);
3682 gotopage1 l.pageno 0;
3685 let layout = layout !S.x (!S.y - !S.winh
)
3689 | [] -> gotoxy !S.x (U.add_to_y_and_clamp ~
- !S.winh
)
3691 S.mode := Birdseye
(oconf
, leftx
, l.pageno, hooverpageno
, anchor);
3692 gotopage1 l.pageno 0
3695 | [] -> gotoxy !S.x (U.add_to_y_and_clamp ~
- !S.winh
)
3699 begin match List.rev
!S.layout with
3701 let layout = layout !S.x
3702 (!S.y + (pgh !S.layout))
3704 begin match layout with
3706 let incr = l.pageh
- l.pagevh in
3711 oconf
, leftx
, !S.pagecount
- 1, hooverpageno
, anchor
3713 Glutils.postRedisplay
"birdseye pagedown";
3716 gotoxy !S.x (U.add_to_y_and_clamp (incr + conf
.interpagespace
*2));
3719 S.mode := Birdseye
(oconf
, leftx
, l.pageno, hooverpageno
, anchor);
3720 gotopage1 l.pageno 0;
3723 | [] -> gotoxy !S.x (U.add_to_y_and_clamp !S.winh
)
3727 S.mode := Birdseye
(oconf
, leftx
, 0, hooverpageno
, anchor);
3731 let pageno = !S.pagecount
- 1 in
3732 S.mode := Birdseye
(oconf
, leftx
, pageno, hooverpageno
, anchor);
3733 if not
(U.pagevisible !S.layout pageno)
3736 match List.rev
!S.pdims
with
3738 | (_, _, h, _) :: _ -> h
3742 (max
0 (getpagey
pageno - (!S.winh
- h - conf
.interpagespace
)))
3743 else Glutils.postRedisplay
"birdseye end";
3745 | Delete
|Insert
|Ascii
_|Code
_|Ctrl
_|Fn
_|Backspace
-> viewkeyboard key mask
3750 | Textentry
_ -> U.scalecolor 0.4
3751 | LinkNav
_ | View
-> U.scalecolor 1.0
3752 | Birdseye
(_, _, pageno, hooverpageno
, _) ->
3753 if l.pageno = hooverpageno
3754 then U.scalecolor 0.9
3756 if l.pageno = pageno
3758 let c = U.scalecolor 1.0 in
3760 GlDraw.line_width
3.0;
3761 let dispx = l.pagedispx in
3763 (float (dispx-1)) (float (l.pagedispy-1))
3764 (float (dispx+l.pagevw+1))
3765 (float (l.pagedispy+l.pagevh+1));
3766 GlDraw.line_width
1.0;
3769 else U.scalecolor 0.8
3774 let postdrawpage l linkindexbase
=
3775 match getopaque l.pageno with
3776 | exception Not_found
-> 0
3778 if tileready l l.pagex
l.pagey
3780 let x = l.pagedispx - l.pagex
3781 and y = l.pagedispy - l.pagey in
3783 match conf
.columns
with
3784 | Csingle
_ | Cmulti
_ ->
3785 (if conf
.hlinks
then 1 else 0)
3787 && not
(isbirdseye
!S.mode) then 2 else 0)
3792 | Textentry
((_, s, _, _, _, _), _) when !S.glinks
-> s
3799 Ffi.postprocess
opaque hlmask x y
3800 (linkindexbase
, s, conf
.hfsize
, conf
.hcs
) in
3802 then (Glutils.redisplay
:= not
@@ hasdata
!S.ss; 0)
3806 let scrollindicator () =
3807 let sbw, ph
, sh = !S.uioh#scrollph
in
3808 let sbh, pw, sw
= !S.uioh#scrollpw
in
3813 else ((!S.winw
- sbw), !S.winw
, 0)
3817 GlFunc.blend_func ~
src:`src_alpha ~dst
:`one_minus_src_alpha
;
3818 let (r
, g, b, alpha
) = conf
.sbarcolor
in
3819 GlDraw.color (r
, g, b) ~alpha
;
3820 Glutils.filledrect
(float x0) 0. (float x1) (float !S.winh
);
3822 (float hx0
) (float (!S.winh
- sbh))
3823 (float (hx0
+ !S.winw
)) (float !S.winh
);
3824 let (r
, g, b, alpha
) = conf
.sbarhndlcolor
in
3825 GlDraw.color (r
, g, b) ~alpha
;
3827 Glutils.filledrect
(float x0) ph
(float x1) (ph
+. sh);
3828 let pw = pw +. float hx0
in
3829 Glutils.filledrect
pw (float (!S.winh
- sbh)) (pw +. sw
) (float !S.winh
);
3833 match !S.mstate
with
3834 | Mnone
| Mscrolly
| Mscrollx
| Mpan
_ | Mzoom
_ | Mzoomrect
_ -> ()
3835 | Msel
((x0, y0), (x1, y1)) ->
3836 let identify opaque l px py = Some
(opaque, l.pageno, px, py) in
3838 onppundermouse identify x0 y0 (Opaque.of_string
E.s, -1, 0, 0) in
3839 let _o1,n1
,px1
,py1
=
3840 onppundermouse identify x1 y1 (Opaque.of_string
E.s, -1, 0, 0) in
3841 if n0
!= -1 && n0
= n1
then Ffi.seltext
o0 (px0
, py0
, px1
, py1
)
3843 let showrects = function
3847 GlDraw.color (0.0, 0.0, 1.0) ~alpha
:0.5;
3848 GlFunc.blend_func ~
src:`src_alpha ~dst
:`one_minus_src_alpha
;
3850 (fun (pageno, c, (x0, y0, x1, y1, x2
, y2
, x3
, y3
)) ->
3852 if l.pageno = pageno
3854 let dx = float (l.pagedispx - l.pagex
) in
3855 let dy = float (l.pagedispy - l.pagey) in
3856 let r, g, b, alpha
= c in
3857 GlDraw.color (r, g, b) ~alpha
;
3868 let sc (r, g, b) = let s = conf
.colorscale
in (r *. s, g *. s, b *. s) in
3869 GlDraw.color (sc conf
.bgcolor
);
3870 GlClear.color (sc conf
.bgcolor
);
3871 GlClear.clear
[`
color];
3872 List.iter
drawpage !S.layout;
3875 | LinkNav
(Ltgendir
_) | LinkNav
(Ltnotready
_)
3879 | LinkNav
(Ltexact
(pageno, linkno
)) ->
3880 match getopaque pageno with
3881 | exception Not_found
-> !S.rects
3883 let x0, y0, x1, y1 = Ffi.getlinkrect
opaque linkno
in
3886 then (1.0, 1.0, 1.0, 0.5)
3887 else (0.0, 0.0, 0.5, 0.5)
3890 (float x0, float y0,
3897 let rec postloop linkindexbase
= function
3899 let linkindexbase = linkindexbase + postdrawpage l linkindexbase in
3900 postloop linkindexbase rest
3904 postloop 0 !S.layout;
3906 begin match !S.mstate
with
3907 | Mzoomrect
((x0, y0), (x1, y1)) ->
3909 GlDraw.color (0.3, 0.3, 0.3) ~alpha
:0.5;
3910 GlFunc.blend_func ~
src:`src_alpha ~dst
:`one_minus_src_alpha
;
3911 Glutils.filledrect
(float x0) (float y0) (float x1) (float y1);
3915 | Mscrolly
| Mscrollx
3922 if conf
.pgscale > 0.0
3925 let x0 = 0.0 and y0 = y -. 3.0 in
3926 let x1 = float !S.winw
and y1 = y +. 3.0 in
3927 Glutils.filledrect
x0 y0 x1 y1;
3930 GlDraw.color (0.1, 0.1, 0.1) ~alpha
:0.5;
3931 GlFunc.blend_func ~
src:`src_alpha ~dst
:`one_minus_src_alpha
;
3932 (match !S.layout with
3933 | _ :: [] -> drawsep (conf
.pgscale *. float !S.winh
)
3934 | l -> List.iter
(fun p -> drawsep (float (p.pagedispy+p.pagevh))) l
3941 match !S.reload with
3943 if x != !S.x || y != !S.y || abs_float
@@ now
() -. t
> 0.5
3944 || (!S.layout != [] && alltilesrendered !S.layout)
3949 | None
-> display ()
3951 let zoomrect x y x1 y1 =
3954 and y0 = min
y y1 in
3955 let zoom = (float !S.w) /. float (x1 - x0) in
3959 then (!S.winw
- !S.w) / 2
3962 match conf
.fitmodel
with
3963 | FitWidth
| FitProportional
-> simple ()
3965 match conf
.columns
with
3967 onppundermouse (fun _ l _ _ -> Some
l.pagedispx) x0 y0 x0
3968 | Cmulti
_ | Csingle
_ -> simple ()
3970 gotoxy ((!S.x + margin) - x0) (!S.y + y0);
3971 S.anchor := getanchor
();
3975 let annot inline
x y =
3976 match unproject x y with
3977 | Some
(opaque, n, ux
, uy
) ->
3979 Ffi.addannot
opaque ux uy
text;
3980 wcmd1 U.freepage opaque;
3981 Hashtbl.remove
S.pagemap
(n, !S.gen
);
3987 let mode = !S.mode in
3988 let te = ("annotation: ", E.s, None
, textentry, add, true) in
3989 S.mode := Textentry
(te, fun _ -> S.mode := mode);
3992 Glutils.postRedisplay
"annot"
3993 else add @@ getusertext E.s
3997 let g opaque l px py =
3998 match Ffi.rectofblock
opaque px py with
4000 let x0 = a.(0) -. 20. in
4001 let x1 = a.(1) +. 20. in
4002 let y0 = a.(2) -. 20. in
4003 let zoom = (float !S.w) /. (x1 -. x0) in
4004 let pagey = getpagey
l.pageno in
4005 let margin = (!S.w - l.pagew
)/2 in
4006 let nx = -truncate
x0 - margin in
4007 gotoxy nx (pagey + truncate
y0);
4008 S.anchor := getanchor
();
4013 match conf
.columns
with
4015 impmsg "block zooming while in split columns mode is not implemented"
4016 | Cmulti
_ | Csingle
_ -> onppundermouse g x y ()
4019 let winw = !S.winw - 1 in
4020 let s = float x /. float winw in
4021 let destx = truncate
(float (!S.w + winw) *. s) in
4022 gotoxy (winw - destx) !S.y;
4023 S.mstate
:= Mscrollx
4026 let s = float y /. float !S.winh
in
4027 let desty = truncate
(s *. float (U.maxy ())) in
4029 S.mstate
:= Mscrolly
4031 let viewmulticlick clicks
x y mask
=
4032 let g opaque l px py =
4040 if Ffi.markunder
opaque px py mark
4044 match getopaque l.pageno with
4045 | exception Not_found
-> ()
4046 | opaque -> pipesel opaque cmd
4048 S.roamf
:= (fun () -> dopipe conf
.paxcmd
);
4049 if not
(Wsi.withctrl mask
) then dopipe conf
.selcmd
;
4054 Glutils.postRedisplay
"viewmulticlick";
4055 onppundermouse g x y (fun () -> impmsg "nothing to select") ()
4057 let canselect () = conf
.angle
mod 360 = 0
4059 let viewmouse button down
x y mask
=
4061 | n when (n == 4 || n == 5) && not
(Wsi.withshift mask
) && not down
->
4062 if Wsi.withctrl mask
4066 then if conf
.zoom +. 0.01 > 0.1 then 0.1 else 0.01
4067 else if conf
.zoom -. 0.1 < 0.1 then -0.01 else -0.1
4070 match !S.mstate
with
4071 | Mzoom
(oldn
, _, pos
) when n = oldn
-> pos
4072 | Mzoomrect
_ | Mnone
| Mpan
_
4073 | Msel
_ | Mscrollx
| Mscrolly
| Mzoom
_ -> (x, y)
4075 let zoom = conf
.zoom -. incr in
4076 S.mstate
:= Mzoom
(n, 0, (x, y));
4077 if false && abs
(fx - x) > 5 || abs
(fy
- y) > 5
4078 then pivotzoom ~
x ~
y zoom
4082 match !S.autoscroll
with
4083 | Some step
-> setautoscrollspeed step
(n=4)
4085 if conf
.wheelbypage
|| conf
.presentation
4092 let incr = if n = 4 then -conf
.scrollstep
else conf
.scrollstep
in
4093 let incr = incr * 2 in
4094 let y = U.add_to_y_and_clamp incr in
4098 | n when (n = 4 || n = 5 || n = 6 || n = 7) && not down
&& canpan () ->
4100 (!S.x + (if n = 5 || n = 7 then -2 else 2) * conf
.hscrollstep
)
4104 | 1 when Wsi.withshift mask
->
4108 match unproject x y with
4110 | Some
(_, pageno, ux
, uy
) ->
4111 let cmd = Printf.sprintf
"%s %s %d %d %d" conf
.stcmd
!S.path
4114 match spawn
cmd [] with
4116 adderrfmt "spawn" "execution of synctex command(%S) failed: %S"
4117 conf
.stcmd
@@ exntos exn
4121 | 1 when Wsi.withctrl mask
->
4124 Wsi.setcursor
Wsi.CURSOR_FLEUR
;
4125 S.mstate
:= Mpan
(x, y)
4127 else S.mstate
:= Mnone
4132 if Wsi.withshift mask
4134 annot conf
.annotinline
x y;
4135 Glutils.postRedisplay
"addannot"
4139 Wsi.setcursor
Wsi.CURSOR_CYCLE
;
4140 S.mstate
:= Mzoomrect
(p, p)
4143 match !S.mstate
with
4144 | Mzoomrect
((x0, y0), _) ->
4145 if abs
(x-x0) > 10 && abs
(y - y0) > 10
4146 then zoomrect x0 y0 x y
4149 Glutils.postRedisplay
"kill accidental zoom rect";
4153 | Mscrolly
| Mscrollx
4155 | Mnone
-> resetmstate ()
4158 | 1 when vscrollhit
x ->
4161 let _, position
, sh = !S.uioh#scrollph
in
4162 if y > truncate position
&& y < truncate
(position
+. sh)
4163 then S.mstate
:= Mscrolly
4165 else S.mstate
:= Mnone
4167 | 1 when y > !S.winh
- hscrollh () ->
4170 let _, position
, sw
= !S.uioh#scrollpw
in
4171 if x > truncate position
&& x < truncate
(position
+. sw
)
4172 then S.mstate
:= Mscrollx
4174 else S.mstate
:= Mnone
4176 | 1 when !S.bzoom
-> if not down
then zoomblock x y
4179 let dest = if down
then getunder x y else Unone
in
4180 begin match dest with
4181 | Ulinkuri
_ -> gotounder dest
4182 | Unone
when down
->
4183 Wsi.setcursor
Wsi.CURSOR_FLEUR
;
4184 S.mstate
:= Mpan
(x, y);
4185 | Utextannot
(opaque, slinkindex
) -> enterannotmode opaque slinkindex
4186 | Unone
| Utext
_ | Ufileannot
_ ->
4191 S.mstate
:= Msel
((x, y), (x, y));
4192 Glutils.postRedisplay
"mouse select";
4196 match !S.mstate
with
4198 | Mzoom
_ | Mscrollx
| Mscrolly
-> S.mstate
:= Mnone
4199 | Mzoomrect
((x0, y0), _) -> zoomrect x0 y0 x y
4201 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
4203 | Msel
((x0, y0), (x1, y1)) ->
4204 let rec loop = function
4208 let a0 = l.pagedispy in
4209 let a1 = a0 + l.pagevh in
4210 let b0 = l.pagedispx in
4211 let b1 = b0 + l.pagevw in
4212 ((y0 >= a0 && y0 <= a1) || (y1 >= a0 && y1 <= a1))
4213 && ((x0 >= b0 && x0 <= b1) || (x1 >= b0 && x1 <= b1))
4217 match getopaque l.pageno with
4218 | exception Not_found
-> ()
4221 pipef ~closew
:false "Msel"
4223 Ffi.copysel
w opaque;
4224 Glutils.postRedisplay
"Msel") cmd
4226 dosel conf
.selcmd
();
4227 S.roamf
:= dosel conf
.paxcmd
;
4236 let birdseyemouse button down
x y mask
4237 (conf
, leftx
, _, hooverpageno
, anchor) =
4240 let rec loop = function
4243 if y > l.pagedispy && y < l.pagedispy + l.pagevh
4244 && x > l.pagedispx && x < l.pagedispx + l.pagevw
4246 leavebirdseye (conf
, leftx
, l.pageno, hooverpageno
, anchor) false
4251 | _ -> viewmouse button down
x y mask
4255 method infochanged
_ = ()
4257 method key key mask
=
4258 begin match !S.mode with
4259 | Textentry
textentry -> textentrykeyboard
key mask
textentry
4260 | Birdseye
birdseye -> birdseyekeyboard key mask
birdseye
4261 | View
-> viewkeyboard key mask
4262 | LinkNav
linknav -> linknavkeyboard key mask
linknav
4266 method button button bstate
x y mask
=
4267 begin match !S.mode with
4268 | LinkNav
_ | View
-> viewmouse button bstate
x y mask
4269 | Birdseye beye
-> birdseyemouse button bstate
x y mask beye
4274 method multiclick clicks
x y mask
=
4275 begin match !S.mode with
4276 | LinkNav
_ | View
-> viewmulticlick clicks
x y mask
4277 | Birdseye
_ | Textentry
_ -> ()
4282 begin match !S.mode with
4284 | View
| Birdseye
_ | LinkNav
_ ->
4285 match !S.mstate
with
4286 | Mzoom
_ | Mnone
-> ()
4290 S.mstate
:= Mpan
(x, y);
4291 let x = if canpan () then U.panbound (!S.x + dx) else !S.x in
4292 let y = U.add_to_y_and_clamp dy in
4296 S.mstate
:= Msel
(a, (x, y));
4297 Glutils.postRedisplay
"motion select";
4300 let y = min
!S.winh
(max
0 y) in
4304 let x = min
!S.winw (max
0 x) in
4307 | Mzoomrect
(p0
, _) ->
4308 S.mstate
:= Mzoomrect
(p0
, (x, y));
4309 Glutils.postRedisplay
"motion zoomrect";
4313 method pmotion
x y =
4314 begin match !S.mode with
4315 | Birdseye
(conf
, leftx
, pageno, hooverpageno
, anchor) ->
4316 let rec loop = function
4318 if hooverpageno
!= -1
4320 S.mode := Birdseye
(conf
, leftx
, pageno, -1, anchor);
4321 Glutils.postRedisplay
"pmotion birdseye no hoover";
4324 if y > l.pagedispy && y < l.pagedispy + l.pagevh
4325 && x > l.pagedispx && x < l.pagedispx + l.pagevw
4327 S.mode := Birdseye
(conf
, leftx
, pageno, l.pageno, anchor);
4328 Glutils.postRedisplay
"pmotion birdseye hoover";
4336 | LinkNav
_ | View
->
4337 match !S.mstate
with
4338 | Mpan
_ | Msel
_ | Mzoom
_ | Mscrolly
| Mscrollx
| Mzoomrect
_ -> ()
4347 let delta = now -. past
in
4350 else conf
.pax
<- Some
now
4355 let maxy = U.maxy () in
4358 then 0.0, float !S.winh
4359 else scrollph
!S.y maxy
4364 let fwinw = float (!S.winw - vscrollw
()) in
4366 let sw = fwinw /. float !S.w in
4367 let sw = fwinw *. sw in
4368 max
sw (float conf
.scrollh
)
4371 let maxx = !S.w + !S.winw in
4372 let x = !S.winw - !S.x in
4373 let percent = float x /. float maxx in
4374 (fwinw -. sw) *. percent
4376 hscrollh (), position, sw
4381 | LinkNav
_ -> "links"
4382 | Textentry
_ -> "textentry"
4383 | Birdseye
_ -> "birdseye"
4386 findkeyhash conf
modename
4388 method eformsgs
= true
4389 method alwaysscrolly
= false
4390 method scroll
dx dy =
4391 let x = if canpan () then U.panbound (!S.x + dx) else !S.x in
4392 gotoxy x (U.add_to_y_and_clamp (2 * dy));
4395 pivotzoom ~
x ~
y (conf
.zoom *. exp z
);
4399 let cl = splitatchar cmds ' '
in
4401 try Scanf.sscanf
s fmt
f
4402 with exn
-> adderrfmt "remote exec" "error processing '%S': %s\n"
4405 let rectx s pageno (r, g, b, a) x0 y0 x1 y1 =
4406 vlog
"%s page %d color (%f %f %f %f) x0,y0,x1,y1 = %f %f %f %f"
4407 s pageno r g b a x0 y0 x1 y1;
4411 let _,w1
,h1
,_ = getpagedim
pageno in
4412 let sw = float w1
/. float w
4413 and sh = float h1
/. float h in
4417 and y1s
= y1 *. sh in
4418 let rect = (x0s,y0s
,x1s
,y0s
,x1s
,y1s
,x0s,y1s
) in
4419 let color = (r, g, b, a) in
4420 if conf
.verbose
then debugrect rect;
4421 S.rects := (pageno, color, rect) :: !S.rects;
4422 Glutils.postRedisplay
s;
4426 | "reload", "" -> reload ()
4428 scan args
"%u %f %f"
4430 let cmd, _ = !S.geomcmds
in
4432 then gotopagexy pageno x y
4435 gotopagexy pageno x y;
4438 S.reprf
:= f !S.reprf
4440 | "goto1", args
-> scan args
"%u %f" gotopage
4441 | "gotor", args
-> scan args
"%S" gotoremote
4443 scan args
"%u %u %f %f %f %f"
4444 (fun pageno c x0 y0 x1 y1 ->
4445 let color = (0.0, 0.0, 1.0 /. float c, 0.5) in
4446 rectx "rect" pageno color x0 y0 x1 y1;
4449 scan args
"%u %f %f"
4452 match getopaque pageno with
4453 | exception Not_found
-> Opaque.of_string
E.s
4456 pgoto optopaque pageno x y;
4457 let rec fixx = function
4460 if l.pageno = pageno
4461 then gotoxy (!S.x - l.pagedispx) !S.y
4466 match conf
.columns
with
4467 | Csingle
_ | Csplit
_ -> 1
4468 | Cmulti
((n, _, _), _) -> n
4470 layout 0 !S.y (!S.winw * mult) !S.winh
4474 | "activatewin", "" -> Wsi.activatewin
()
4475 | "quit", "" -> raise Quit
4478 let l = Config.keys_of_string
keys in
4479 List.iter
(fun (k
, m) -> keyboard k
m) l
4480 with exn
-> adderrfmt "error processing keys" "`%S': %s\n"
4484 adderrfmt "remote command"
4485 "error processing remote command: %S\n" cmds
4488 let scratch = Bytes.create
80 in
4489 let buf = Buffer.create
80 in
4491 match tempfailureretry
(Unix.read fd
scratch 0) 80 with
4492 | exception Unix.Unix_error
(Unix.EAGAIN
, _, _) -> None
4495 if Buffer.length
buf > 0
4497 let s = Buffer.contents
buf in
4505 match Bytes.index_from
scratch ppos '
\n'
with
4506 | exception Not_found
-> -1
4507 | pos
-> if pos
>= n then -1 else pos
4511 Buffer.add_subbytes
buf scratch ppos
(nlpos-ppos
);
4512 let s = Buffer.contents
buf in
4518 Buffer.add_subbytes
buf scratch ppos
(n-ppos
);
4523 let remoteopen path =
4524 try Some
(Unix.openfile
path [Unix.O_NONBLOCK
; Unix.O_RDONLY
] 0o0)
4526 adderrfmt "remoteopen" "error opening %S: %s" path @@ exntos exn
;
4530 vlogf
:= (fun s -> if conf
.verbose
then print_endline
s else ignore
s);
4531 S.redirstderr
:= not
@@ Unix.isatty
Unix.stderr
;
4532 let gc = ref false in
4533 let rcmdpath = ref E.s in
4534 let dcfpath = ref E.s in
4535 let pageno = ref None
in
4536 let openlast = ref false in
4537 let doreap = ref false in
4538 let csspath = ref None
in
4539 let justversion = ref false in
4540 S.selfexec
:= Sys.executable_name
;
4542 [("-p", Arg.Set_string
S.password, "<password> Set password");
4546 S.selfexec
:= !S.selfexec ^
" -f " ^
Filename.quote
s;
4547 ), "<path> Set path to the user interface font");
4550 S.selfexec
:= !S.selfexec ^
" -c " ^
Filename.quote
s;
4551 S.confpath
:= s), "<path> Set path to the configuration file");
4552 ("-last", Arg.Set
openlast, " Open last document");
4553 ("-page", Arg.Int
(fun pageno1
-> pageno := Some
(pageno1
-1)),
4554 "<page-number> Jump to page");
4555 ("-dest", Arg.Set_string
S.nameddest
,
4556 "<dest-name> Set named destination");
4557 ("-remote", Arg.Set_string
rcmdpath,
4558 "<path> Set path to the remote fifo");
4559 ("-gc", Arg.Set
gc, " Collect garbage");
4560 ("-v", Arg.Set
justversion, " Print version and exit");
4561 ("-css", Arg.String
(fun s -> csspath := Some
s),
4562 "<path> Set path to the style sheet to use with EPUB/HTML");
4563 ("-origin", Arg.Set_string
S.origin
, "<origin> <undocumented>");
4564 ("-no-title", Arg.Set
S.ignoredoctitlte
, " Ignore document title");
4565 ("-dcf", Arg.Set_string
dcfpath, "<path> <undocumented>");
4566 ("-flip-stderr-redirection",
4567 Arg.Unit
(fun () -> S.redirstderr
:= not
!S.redirstderr
),
4569 ("-mime", Arg.Set_string
S.mimetype
, "<mime-type> <undocumented>")
4572 Arg.parse
(Arg.align
spec) (fun s -> S.path := s)
4573 ("Usage: " ^
Sys.argv
.(0) ^
" [options] some.pdf\nOptions:");
4575 if !S.confpath
== E.s
4578 let dir = Filename.concat home
".config" in
4579 if try Sys.is_directory
dir with _ -> false then dir else home
4581 S.confpath
:= Filename.concat
dir "llpp.conf"
4586 printf
"%s\nconfiguration file: %s\n" (Help.version
()) !S.confpath
;
4590 let histmode = emptystr
!S.path && not
!openlast in
4595 if histmode then exit
0;
4598 if not
(Config.load !openlast)
4599 then dolog
"failed to load configuration";
4601 if nonemptystr
!dcfpath
4602 then conf
.dcf
<- !dcfpath;
4604 begin match !pageno with
4605 | Some
pageno -> S.anchor := (pageno, 0.0, 0.0)
4612 val mutable m_clicks
= 0
4613 val mutable m_click_x
= 0
4614 val mutable m_click_y
= 0
4615 val mutable m_lastclicktime
= infinity
4617 method private cleanup =
4619 Hashtbl.iter
(fun _ opaque -> Ffi.clearmark
opaque) S.pagemap
4620 method expose
= Glutils.postRedisplay
"expose"
4624 | Wsi.Unobscured
-> "unobscured"
4625 | Wsi.PartiallyObscured
-> "partiallyobscured"
4626 | Wsi.FullyObscured
-> "fullyobscured"
4628 vlog
"visibility change %s" name
4629 method display = display ()
4630 method map mapped
= vlog
"mapped %b" mapped
4631 method reshape w h =
4634 method mouse
b d x y m =
4635 (*http://blogs.msdn.com/b/oldnewthing/archive/2004/10/18/243925.aspx*)
4638 if d && canselect ()
4644 if abs
x - m_click_x
> 10
4645 || abs
y - m_click_y
> 10
4646 || abs_float
(t -. m_lastclicktime
) > 0.3
4648 m_clicks
<- m_clicks
+ 1;
4649 m_lastclicktime
<- t;
4653 Glutils.postRedisplay
"cleanup";
4654 !S.uioh#button
b d x y m
4656 else !S.uioh#multiclick m_clicks
x y m
4661 m_lastclicktime
<- infinity
;
4662 !S.uioh#button
b d x y m
4665 else !S.uioh#button
b d x y m
4668 !S.uioh#motion
x y |> setuioh
4669 method pmotion
x y =
4671 !S.uioh#pmotion
x y |> setuioh
4673 vlog
"k=%#x m=%#x" k
m;
4674 let mascm = m land (
4675 Wsi.altmask
+ Wsi.shiftmask
+ Wsi.ctrlmask
+ Wsi.metamask
4678 let x = !S.x and y = !S.y in
4680 if x != !S.x || y != !S.y then self#
cleanup
4682 match !S.keystate
with
4684 let km = k
, mascm in
4687 let modehash = !S.uioh#
modehash in
4688 try Hashtbl.find
modehash km
4690 try Hashtbl.find
(findkeyhash conf
"global") km
4691 with Not_found
-> KMinsrt
(k
, m)
4693 | KMinsrt
(k
, m) -> keyboard k
m
4694 | KMinsrl
l -> List.iter
(fun (k
, m) -> keyboard k
m) l
4695 | KMmulti
(l, r) -> S.keystate
:= KSinto
(l, r)
4697 | KSinto
((k'
, m'
) :: [], insrt
) when k'
=k
&& m'
land mascm = m'
->
4698 List.iter
(fun (k
, m) -> keyboard k
m) insrt
;
4699 S.keystate
:= KSnone
4700 | KSinto
((k'
, m'
) :: keys, insrt
) when k'
=k
&& m'
land mascm = m'
->
4701 S.keystate
:= KSinto
(keys, insrt
)
4702 | KSinto
_ -> S.keystate
:= KSnone
4705 !S.uioh#pmotion
x y |> setuioh
4706 method leave = S.mpos
:= (-1, -1)
4707 method winstate wsl
= S.winstate
:= wsl
4708 method quit
: '
a. '
a = raise Quit
4709 method scroll
dx dy =
4710 !S.uioh#scroll
dx dy |> setuioh
4711 method zoom z
x y = !S.uioh#
zoom z
x y
4712 method opendoc path =
4715 Glutils.postRedisplay
"opendoc";
4716 opendoc path !S.mimetype
!S.password
4719 let wsfd, winw, winh
= Wsi.init
mu conf
.cwinw conf
.cwinh
in
4723 match Unix.socketpair
Unix.PF_UNIX
Unix.SOCK_STREAM
0 with
4725 dolog
"socketpair failed: %s" @@ exntos exn
;
4728 Unix.set_close_on_exec
r;
4729 Unix.set_close_on_exec
w;
4733 begin match !csspath with
4735 | Some
"" -> conf
.css
<- E.s
4737 let css = filecontents
path in
4738 let l = String.length
css in
4740 if l > 1 && substratis
css (l-2) "\r\n"
4741 then String.sub css 0 (l-2)
4742 else (if l > 0 && css.[l-1] = '
\n'
then String.sub css 0 (l-1) else css)
4744 S.stderr
:= Ffi.init
cs (
4745 conf
.angle
, conf
.fitmodel
, (conf
.trimmargins
, conf
.trimfuzz
),
4746 conf
.texcount
, conf
.sliceheight
, conf
.mustoresize
,
4747 conf
.colorspace
, !S.fontpath
, !S.redirstderr
4749 List.iter
GlArray.enable
[`texture_coord
; `vertex
];
4750 GlTex.env
(`
color conf
.texturecolor
);
4752 reshape ~firsttime
:true winw winh
;
4755 then (Wsi.settitle "previously visited - llpp"; enterhistmode
())
4756 else opendoc !S.path !S.mimetype
!S.password;
4759 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
4760 Sys.set_signal
Sys.sighup
(Sys.Signal_handle
(fun _ -> reload ()));
4763 match Unix.waitpid
[Unix.WNOHANG
] ~
-1 with
4764 | exception (Unix.Unix_error
(Unix.ECHILD
, _, _)) -> ()
4765 | exception exn
-> dolog
"Unix.waitpid: %s" @@ exntos exn
4767 | _pid
, _status
-> reap ()
4769 Sys.set_signal
Sys.sigchld
(Sys.Signal_handle
(fun _ -> doreap := true));
4772 ref (if nonemptystr
!rcmdpath then remoteopen !rcmdpath else None
)
4775 then dologf
:= (adderrfmt "stderr" "%s\n");
4778 let l = [!S.ss; !S.wsfd] in if !S.redirstderr
then !S.stderr
:: l else l
4780 let rec loop deadline
=
4789 | Some fd
-> fd
:: fdl
4791 if !Glutils.redisplay
4793 Glutils.redisplay
:= false;
4800 if deadline
= infinity
4802 else max
0.0 (deadline
-. now)
4807 try Unix.select
r [] [] timeout
4808 with Unix.Unix_error
(Unix.EINTR
, _, _) -> [], [], []
4813 match !S.autoscroll
with
4814 | Some step
when step
!= 0 ->
4815 let y = !S.y + step
in
4816 let fy = if conf
.maxhfit
then !S.winh
else 0 in
4821 if y >= !S.maxy - fy
4832 let rec checkfds = function
4834 | fd
:: rest
when fd
= !S.ss ->
4835 let cmd = Ffi.rcmd
!S.ss in
4839 | fd
:: rest
when fd
= !S.wsfd ->
4843 | fd
:: rest
when fd
= !S.stderr
->
4844 let b = Bytes.create
80 in
4845 begin match Unix.read fd
b 0 80 with
4846 | exception Unix.Unix_error
(Unix.EINTR
, _, _) -> ()
4847 | exception exn
-> adderrmsg "Unix.read exn" @@ exntos exn
4849 | n -> adderrmsg "stderr" @@ Bytes.sub_string
b 0 n
4853 | fd
:: rest
when Some fd
= !optrfd ->
4854 begin match remote fd
with
4855 | None
-> optrfd := remoteopen !rcmdpath;
4856 | opt -> optrfd := opt
4861 adderrmsg "mainloop" "select returned unknown descriptor";
4866 match !S.autoscroll
with
4867 | Some step
when step
!= 0 ->
4868 if deadline
= infinity
4876 match loop infinity
with
4878 (match Buffer.length
S.errmsgs
with
4881 match Unix.write
Unix.stdout
(Buffer.to_bytes
S.errmsgs
) 0 n with
4882 | exception _ | _ -> ());
4883 Config.save leavebirdseye;
4884 if Ffi.hasunsavedchanges
()
4886 | _ -> error
"umpossible - infinity reached"