Switch to asciidoctor
[llpp.git] / main.ml
bloba7773b252a86cc7505e607a19455e7d262f5fa26
1 open Utils;;
2 open Config;;
3 open Glutils;;
4 open Listview;;
6 let selfexec = ref E.s;;
7 let ignoredoctitlte = ref false;;
8 let layouth = ref ~-1;;
9 let checkerstexid = ref None;;
11 let debugrect (x0, y0, x1, y1, x2, y2, x3, y3) =
12 dolog {|rect {
13 x0,y0=(% f, % f)
14 x1,y1=(% f, % f)
15 x2,y2=(% f, % f)
16 x3,y3=(% f, % f)
17 }|} x0 y0 x1 y1 x2 y2 x3 y3;
20 let pgscale h = truncate (float h *. conf.pgscale);;
22 let hscrollh () =
23 if ((conf.scrollb land scrollbhv != 0) && (state.w > state.winw))
24 || state.uioh#alwaysscrolly
25 then conf.scrollbw
26 else 0
29 let setfontsize n =
30 fstate.fontsize <- n;
31 fstate.wwidth <- measurestr fstate.fontsize "w";
32 fstate.maxrows <- (state.winh - fstate.fontsize - 1) / (fstate.fontsize + 1);
35 let launchpath () =
36 if emptystr conf.pathlauncher
37 then dolog "%s" state.path
38 else (
39 let command =
40 Str.global_replace Utils.Re.percent state.path conf.pathlauncher in
41 match spawn command [] with
42 | _pid -> ()
43 | exception exn -> dolog "failed to execute `%s': %s" command @@ exntos exn
47 let getopaque pageno =
48 try Some (Hashtbl.find state.pagemap (pageno, state.gen))
49 with Not_found -> None
52 let pagetranslatepoint l x y =
53 let dy = y - l.pagedispy in
54 let y = dy + l.pagey in
55 let dx = x - l.pagedispx in
56 let x = dx + l.pagex in
57 (x, y);
60 let onppundermouse g x y d =
61 let rec f = function
62 | l :: rest ->
63 begin match getopaque l.pageno with
64 | Some opaque ->
65 let x0 = l.pagedispx in
66 let x1 = x0 + l.pagevw in
67 let y0 = l.pagedispy in
68 let y1 = y0 + l.pagevh in
69 if y >= y0 && y <= y1 && x >= x0 && x <= x1
70 then
71 let px, py = pagetranslatepoint l x y in
72 match g opaque l px py with
73 | Some res -> res
74 | None -> f rest
75 else f rest
76 | _ -> f rest
77 end
78 | [] -> d
80 f state.layout
83 let getunder x y =
84 let g opaque l px py =
85 if state.bzoom
86 then (
87 match Ffi.rectofblock opaque px py with
88 | Some [|x0;x1;y0;y1|] ->
89 let rect = (x0, y0, x1, y0, x1, y1, x0, y1) in
90 let color = (0.0, 0.0, 1.0 /. (l.pageno mod 3 |> float), 0.5) in
91 state.rects <- [l.pageno, color, rect];
92 postRedisplay "getunder";
93 | _ -> ()
95 let under = Ffi.whatsunder opaque px py in
96 if under = Unone then None else Some under
98 onppundermouse g x y Unone
101 let unproject x y =
102 let g opaque l x y =
103 match Ffi.unproject opaque x y with
104 | Some (x, y) -> Some (Some (opaque, l.pageno, x, y))
105 | None -> None
107 onppundermouse g x y None;
110 let showtext c s =
111 state.text <- Printf.sprintf "%c%s" c s;
112 postRedisplay "showtext";
115 let impmsg fmt = Format.ksprintf (fun s -> showtext '!' s) fmt;;
117 let pipesel opaque cmd =
118 if Ffi.hassel opaque
119 then pipef ~closew:false "pipesel"
120 (fun w ->
121 Ffi.copysel w opaque;
122 postRedisplay "pipesel"
123 ) cmd
126 let paxunder x y =
127 let g opaque l px py =
128 if Ffi.markunder opaque px py conf.paxmark
129 then
130 Some (fun () ->
131 match getopaque l.pageno with
132 | None -> ()
133 | Some opaque -> pipesel opaque conf.paxcmd
135 else None
137 postRedisplay "paxunder";
138 if conf.paxmark = Mark_page
139 then
140 List.iter (fun l ->
141 match getopaque l.pageno with
142 | None -> ()
143 | Some opaque -> Ffi.clearmark opaque) state.layout;
144 state.roam <- onppundermouse g x y (fun () -> impmsg "whoopsie daisy");
147 let undertext = function
148 | Unone -> "none"
149 | Ulinkuri s -> s
150 | Utext s -> "font: " ^ s
151 | Uannotation (opaque, slinkindex) ->
152 "annotation: " ^ Ffi.getannotcontents opaque slinkindex
155 let updateunder x y =
156 match getunder x y with
157 | Unone -> Wsi.setcursor Wsi.CURSOR_INHERIT
158 | Ulinkuri uri ->
159 if conf.underinfo then showtext 'u' ("ri: " ^ uri);
160 Wsi.setcursor Wsi.CURSOR_INFO
161 | Utext s ->
162 if conf.underinfo then showtext 'f' ("ont: " ^ s);
163 Wsi.setcursor Wsi.CURSOR_TEXT
164 | Uannotation _ ->
165 if conf.underinfo then showtext 'a' "nnotation";
166 Wsi.setcursor Wsi.CURSOR_INFO
169 let showlinktype under =
170 if conf.underinfo && under != Unone
171 then showtext ' ' @@ undertext under
174 let intentry_with_suffix text key =
175 let text =
176 match [@warning "-4"] key with
177 | Keys.Ascii ('0'..'9' as c) -> addchar text c
178 | Keys.Ascii ('k' | 'm' | 'g' | 'K' | 'M' | 'G' as c) ->
179 addchar text @@ asciilower c
180 | _ ->
181 state.text <- "invalid key";
182 text
184 TEcont text
187 let wcmd fmt =
188 let b = Buffer.create 16 in
189 Printf.kbprintf
190 (fun b ->
191 let b = Buffer.to_bytes b in
192 Ffi.wcmd state.ss b @@ Bytes.length b
193 ) b fmt
196 let nogeomcmds = function
197 | s, [] -> emptystr s
198 | _ -> false
201 let layoutN ((columns, coverA, coverB), b) x y sw sh =
202 let rec fold accu n =
203 if n = Array.length b
204 then accu
205 else
206 let pdimno, dx, vy, (_, w, h, xoff) = b.(n) in
207 if (vy - y) > sh &&
208 (n = coverA - 1
209 || n = state.pagecount - coverB
210 || (n - coverA) mod columns = columns - 1)
211 then accu
212 else
213 let accu =
214 if vy + h > y
215 then
216 let pagey = max 0 (y - vy) in
217 let pagedispy = if pagey > 0 then 0 else vy - y in
218 let pagedispx, pagex =
219 let pdx =
220 if n = coverA - 1 || n = state.pagecount - coverB
221 then x + (sw - w) / 2
222 else dx + xoff + x
224 if pdx < 0
225 then 0, -pdx
226 else pdx, 0
228 let pagevw =
229 let vw = sw - pagedispx in
230 let pw = w - pagex in
231 min vw pw
233 let pagevh = min (h - pagey) (sh - pagedispy) in
234 if pagevw > 0 && pagevh > 0
235 then
236 { pageno = n
237 ; pagedimno = pdimno
238 ; pagew = w
239 ; pageh = h
240 ; pagex = pagex
241 ; pagey = pagey
242 ; pagevw = pagevw
243 ; pagevh = pagevh
244 ; pagedispx = pagedispx
245 ; pagedispy = pagedispy
246 ; pagecol = 0
247 } :: accu
248 else accu
249 else accu
251 fold accu (n+1)
253 if Array.length b = 0
254 then []
255 else List.rev (fold [] (page_of_y y))
258 let layoutS (columns, b) x y sw sh =
259 let rec fold accu n =
260 if n = Array.length b
261 then accu
262 else
263 let pdimno, px, vy, (_, pagew, pageh, xoff) = b.(n) in
264 if (vy - y) > sh
265 then accu
266 else
267 let accu =
268 if vy + pageh > y
269 then
270 let x = xoff + x in
271 let pagey = max 0 (y - vy) in
272 let pagedispy = if pagey > 0 then 0 else vy - y in
273 let pagedispx, pagex =
274 if px = 0
275 then (
276 if x < 0
277 then 0, -x
278 else x, 0
280 else (
281 let px = px - x in
282 if px < 0
283 then -px, 0
284 else 0, px
287 let pagecolw = pagew/columns in
288 let pagedispx =
289 if pagecolw < sw
290 then pagedispx + ((sw - pagecolw) / 2)
291 else pagedispx
293 let pagevw =
294 let vw = sw - pagedispx in
295 let pw = pagew - pagex in
296 min vw pw
298 let pagevw = min pagevw pagecolw in
299 let pagevh = min (pageh - pagey) (sh - pagedispy) in
300 if pagevw > 0 && pagevh > 0
301 then
302 { pageno = n/columns
303 ; pagedimno = pdimno
304 ; pagew = pagew
305 ; pageh = pageh
306 ; pagex = pagex
307 ; pagey = pagey
308 ; pagevw = pagevw
309 ; pagevh = pagevh
310 ; pagedispx = pagedispx
311 ; pagedispy = pagedispy
312 ; pagecol = n mod columns
313 } :: accu
314 else accu
315 else accu
317 fold accu (n+1)
319 List.rev (fold [] 0)
322 let layout x y sw sh =
323 if nogeomcmds state.geomcmds
324 then
325 match conf.columns with
326 | Csingle b -> layoutN ((1, 0, 0), b) x y sw sh
327 | Cmulti c -> layoutN c x y sw sh
328 | Csplit s -> layoutS s x y sw sh
329 else []
332 let maxy () = state.maxy - if conf.maxhfit then state.winh else 0;;
333 let clamp incr = bound (state.y + incr) 0 @@ maxy ();;
335 let itertiles l f =
336 let tilex = l.pagex mod conf.tilew in
337 let tiley = l.pagey mod conf.tileh in
339 let col = l.pagex / conf.tilew in
340 let row = l.pagey / conf.tileh in
342 let rec rowloop row y0 dispy h =
343 if h != 0
344 then
345 let dh = conf.tileh - y0 in
346 let dh = min h dh in
347 let rec colloop col x0 dispx w =
348 if w != 0
349 then
350 let dw = conf.tilew - x0 in
351 let dw = min w dw in
352 f col row dispx dispy x0 y0 dw dh;
353 colloop (col+1) 0 (dispx+dw) (w-dw)
355 colloop col tilex l.pagedispx l.pagevw;
356 rowloop (row+1) 0 (dispy+dh) (h-dh)
358 if l.pagevw > 0 && l.pagevh > 0
359 then rowloop row tiley l.pagedispy l.pagevh;
362 let gettileopaque l col row =
363 let key = l.pageno, state.gen, conf.colorspace,
364 conf.angle, l.pagew, l.pageh, col, row in
365 try Some (Hashtbl.find state.tilemap key)
366 with Not_found -> None
369 let puttileopaque l col row gen colorspace angle opaque size elapsed =
370 let key = l.pageno, gen, colorspace, angle, l.pagew, l.pageh, col, row in
371 Hashtbl.add state.tilemap key (opaque, size, elapsed)
374 let drawtiles l color =
375 GlDraw.color color;
376 Ffi.begintiles ();
377 let f col row x y tilex tiley w h =
378 match gettileopaque l col row with
379 | Some (opaque, _, t) ->
380 let params = x, y, w, h, tilex, tiley in
381 if conf.invert
382 then GlTex.env (`mode `blend);
383 Ffi.drawtile params opaque;
384 if conf.invert
385 then GlTex.env (`mode `modulate);
386 if conf.debug
387 then (
388 Ffi.endtiles ();
389 let s = Printf.sprintf "%d[%d,%d] %f sec" l.pageno col row t in
390 let w = measurestr fstate.fontsize s in
391 GlDraw.color (0.0, 0.0, 0.0);
392 filledrect
393 (float (x-2))
394 (float (y-2))
395 (float (x+2) +. w)
396 (float (y + fstate.fontsize + 2));
397 GlDraw.color color;
398 drawstring fstate.fontsize x (y + fstate.fontsize - 1) s;
399 Ffi.begintiles ();
402 | None ->
403 Ffi.endtiles ();
404 let w = let lw = state.winw - x in min lw w
405 and h = let lh = state.winh - y in min lh h
407 if conf.invert
408 then GlTex.env (`mode `blend);
409 begin match !checkerstexid with
410 | Some id ->
411 Gl.enable `texture_2d;
412 GlTex.bind_texture ~target:`texture_2d id;
413 let x0 = float x
414 and y0 = float y
415 and x1 = float (x+w)
416 and y1 = float (y+h) in
418 let tw = float w /. 16.0
419 and th = float h /. 16.0 in
420 let tx0 = float tilex /. 16.0
421 and ty0 = float tiley /. 16.0 in
422 let tx1 = tx0 +. tw
423 and ty1 = ty0 +. th in
424 Raw.sets_float Glutils.vraw ~pos:0
425 [| x0; y0; x0; y1; x1; y0; x1; y1 |];
426 Raw.sets_float Glutils.traw ~pos:0
427 [| tx0; ty0; tx0; ty1; tx1; ty0; tx1; ty1 |];
428 GlArray.vertex `two Glutils.vraw;
429 GlArray.tex_coord `two Glutils.traw;
430 GlArray.draw_arrays `triangle_strip ~first:0 ~count:4;
431 Gl.disable `texture_2d;
433 | None ->
434 GlDraw.color (1.0, 1.0, 1.0);
435 filledrect (float x) (float y) (float (x+w)) (float (y+h));
436 end;
437 if conf.invert
438 then GlTex.env (`mode `modulate);
439 if w > 128 && h > fstate.fontsize + 10
440 then (
441 let c = if conf.invert then 1.0 else 0.0 in
442 GlDraw.color (c, c, c);
443 let c, r =
444 if conf.verbose
445 then (col*conf.tilew, row*conf.tileh)
446 else col, row
448 drawstring2 fstate.fontsize x y "Loading %d [%d,%d]" l.pageno c r;
450 GlDraw.color color;
451 Ffi.begintiles ();
453 itertiles l f;
454 Ffi.endtiles ();
457 let pagevisible layout n = List.exists (fun l -> l.pageno = n) layout;;
459 let tilevisible1 l x y =
460 let ax0 = l.pagex
461 and ax1 = l.pagex + l.pagevw
462 and ay0 = l.pagey
463 and ay1 = l.pagey + l.pagevh in
465 let bx0 = x
466 and by0 = y in
467 let bx1 = min (bx0 + conf.tilew) l.pagew
468 and by1 = min (by0 + conf.tileh) l.pageh in
470 let rx0 = max ax0 bx0
471 and ry0 = max ay0 by0
472 and rx1 = min ax1 bx1
473 and ry1 = min ay1 by1 in
475 let nonemptyintersection = rx1 > rx0 && ry1 > ry0 in
476 nonemptyintersection
479 let tilevisible layout n x y =
480 let rec findpageinlayout m = function
481 | l :: rest when l.pageno = n ->
482 tilevisible1 l x y || (
483 match conf.columns with
484 | Csplit (c, _) when c > m -> findpageinlayout (m+1) rest
485 | Csplit _ | Csingle _ | Cmulti _ -> false
487 | _ :: rest -> findpageinlayout 0 rest
488 | [] -> false
490 findpageinlayout 0 layout;
493 let tileready l x y =
494 tilevisible1 l x y &&
495 gettileopaque l (x/conf.tilew) (y/conf.tileh) != None
498 let tilepage n p layout =
499 let rec loop = function
500 | l :: rest ->
501 if l.pageno = n
502 then
503 let f col row _ _ _ _ _ _ =
504 if state.currently = Idle
505 then
506 match gettileopaque l col row with
507 | Some _ -> ()
508 | None ->
509 let x = col*conf.tilew
510 and y = row*conf.tileh in
511 let w =
512 let w = l.pagew - x in
513 min w conf.tilew
515 let h =
516 let h = l.pageh - y in
517 min h conf.tileh
519 let pbo =
520 if conf.usepbo
521 then Ffi.getpbo w h conf.colorspace
522 else ~< "0"
524 wcmd "tile %s %d %d %d %d %s" (~> p) x y w h (~> pbo);
525 state.currently <-
526 Tiling (
527 l, p, conf.colorspace, conf.angle,
528 state.gen, col, row, conf.tilew, conf.tileh
531 itertiles l f;
532 else
533 loop rest
535 | [] -> ()
537 if nogeomcmds state.geomcmds
538 then loop layout;
541 let preloadlayout x y sw sh =
542 let y = if y < sh then 0 else y - sh in
543 let x = min 0 (x + sw) in
544 let h = sh*3 in
545 let w = sw*3 in
546 layout x y w h;
549 let load pages =
550 let rec loop pages =
551 if state.currently = Idle
552 then
553 match pages with
554 | l :: rest ->
555 begin match getopaque l.pageno with
556 | None ->
557 wcmd "page %d %d" l.pageno l.pagedimno;
558 state.currently <- Loading (l, state.gen);
559 | Some opaque ->
560 tilepage l.pageno opaque pages;
561 loop rest
562 end;
563 | _ -> ()
565 if nogeomcmds state.geomcmds
566 then loop pages
569 let preload pages =
570 load pages;
571 if conf.preload && state.currently = Idle
572 then load (preloadlayout state.x state.y state.winw state.winh);
575 let layoutready layout =
576 let rec fold all ls =
577 all && match ls with
578 | l :: rest ->
579 let seen = ref false in
580 let allvisible = ref true in
581 let foo col row _ _ _ _ _ _ =
582 seen := true;
583 allvisible := !allvisible &&
584 begin match gettileopaque l col row with
585 | Some _ -> true
586 | None -> false
589 itertiles l foo;
590 fold (!seen && !allvisible) rest
591 | [] -> true
593 let alltilesvisible = fold true layout in
594 alltilesvisible;
597 let gotoxy x y =
598 let y = bound y 0 state.maxy in
599 let y, layout =
600 let layout = layout x y state.winw state.winh in
601 postRedisplay "gotoxy ready";
602 y, layout
604 state.x <- x;
605 state.y <- y;
606 state.layout <- layout;
607 begin match state.mode with
608 | LinkNav ln ->
609 begin match ln with
610 | Ltexact (pageno, linkno) ->
611 let rec loop = function
612 | [] ->
613 state.lnava <- Some (pageno, linkno);
614 state.mode <- LinkNav (Ltgendir 0)
615 | l :: _ when l.pageno = pageno ->
616 begin match getopaque pageno with
617 | None -> state.mode <- LinkNav (Ltnotready (pageno, 0))
618 | Some opaque ->
619 let x0, y0, x1, y1 = Ffi.getlinkrect opaque linkno in
620 if not (x0 >= l.pagex && x1 <= l.pagex + l.pagevw
621 && y0 >= l.pagey && y1 <= l.pagey + l.pagevh)
622 then state.mode <- LinkNav (Ltgendir 0)
624 | _ :: rest -> loop rest
626 loop layout
627 | Ltnotready _ | Ltgendir _ -> ()
629 | Birdseye _ | Textentry _ | View -> ()
630 end;
631 begin match state.mode with
632 | Birdseye (conf, leftx, pageno, hooverpageno, anchor) ->
633 if not (pagevisible layout pageno)
634 then (
635 match state.layout with
636 | [] -> ()
637 | l :: _ ->
638 state.mode <- Birdseye (conf, leftx, l.pageno, hooverpageno, anchor)
640 | LinkNav lt ->
641 begin match lt with
642 | Ltnotready (_, dir)
643 | Ltgendir dir ->
644 let linknav =
645 let rec loop = function
646 | [] -> lt
647 | l :: rest ->
648 match getopaque l.pageno with
649 | None -> Ltnotready (l.pageno, dir)
650 | Some opaque ->
651 let link =
652 let ld =
653 if dir = 0
654 then LDfirstvisible (l.pagex, l.pagey, dir)
655 else if dir > 0 then LDfirst else LDlast
657 Ffi.findlink opaque ld
659 match link with
660 | Lnotfound -> loop rest
661 | Lfound n ->
662 showlinktype (Ffi.getlink opaque n);
663 Ltexact (l.pageno, n)
665 loop state.layout
667 state.mode <- LinkNav linknav
668 | Ltexact _ -> ()
670 | Textentry _ | View -> ()
671 end;
672 preload layout;
673 if conf.updatecurs
674 then (
675 let mx, my = state.mpos in
676 updateunder mx my;
680 let conttiling pageno opaque =
681 tilepage pageno opaque
682 (if conf.preload
683 then preloadlayout state.x state.y state.winw state.winh
684 else state.layout)
687 let gotoxy x y =
688 if not conf.verbose then state.text <- E.s;
689 gotoxy x y;
692 let getanchory (n, top, dtop) =
693 let y, h = getpageyh n in
694 if conf.presentation
695 then
696 let ips = calcips h in
697 y + truncate (top*.float h -. dtop*.float ips) + ips;
698 else y + truncate (top*.float h -. dtop*.float conf.interpagespace)
701 let addnav () = getanchor () |> cbput state.hists.nav;;
702 let addnavnorc () = getanchor () |> cbput_dont_update_rc state.hists.nav;;
704 let getnav dir =
705 let anchor = cbgetc state.hists.nav dir in
706 getanchory anchor;
709 let gotopage n top =
710 let y, h = getpageyh n in
711 let y = y + (truncate (top *. float h)) in
712 gotoxy state.x y
715 let gotopage1 n top =
716 let y = getpagey n in
717 let y = y + top in
718 gotoxy state.x y
721 let invalidate s f =
722 Glutils.redisplay := false;
723 state.layout <- [];
724 state.pdims <- [];
725 state.rects <- [];
726 state.rects1 <- [];
727 match state.geomcmds with
728 | ps, [] when emptystr ps ->
729 f ();
730 state.geomcmds <- s, [];
731 | ps, [] -> state.geomcmds <- ps, [s, f];
732 | ps, (s', _) :: rest when s' = s -> state.geomcmds <- ps, ((s, f) :: rest);
733 | ps, cmds -> state.geomcmds <- ps, ((s, f) :: cmds);
736 let flushpages () =
737 Hashtbl.iter (fun _ opaque -> wcmd "freepage %s" (~> opaque)) state.pagemap;
738 Hashtbl.clear state.pagemap;
741 let flushtiles () =
742 if not (Queue.is_empty state.tilelru)
743 then (
744 Queue.iter (fun (k, p, s) ->
745 wcmd "freetile %s" (~> p);
746 state.memused <- state.memused - s;
747 Hashtbl.remove state.tilemap k;
748 ) state.tilelru;
749 state.uioh#infochanged Memused;
750 Queue.clear state.tilelru;
752 load state.layout;
755 let stateh h =
756 let h = truncate (float h*.conf.zoom) in
757 let d = conf.interpagespace lsl (if conf.presentation then 1 else 0) in
758 h - d
761 let fillhelp () =
762 state.help <-
763 let sl = keystostrlist conf in
764 let rec loop accu =
765 function | [] -> accu
766 | s :: rest -> loop ((s, 0, Noaction) :: accu) rest
767 in Help.makehelp conf.urilauncher
768 @ (("", 0, Noaction) :: loop [] sl) |> Array.of_list
771 let opendoc path password =
772 state.path <- path;
773 state.password <- password;
774 state.gen <- state.gen + 1;
775 state.docinfo <- [];
776 state.outlines <- [||];
778 flushpages ();
779 Ffi.setaalevel conf.aalevel;
780 Ffi.setpapercolor conf.papercolor;
781 let titlepath =
782 if emptystr state.origin
783 then path
784 else state.origin
786 Wsi.settitle ("llpp " ^ mbtoutf8 (Filename.basename titlepath));
787 wcmd "open %d %d %s\000%s\000%s\000"
788 (btod conf.usedoccss) !layouth
789 path password conf.css;
790 invalidate "reqlayout"
791 (fun () ->
792 wcmd "reqlayout %d %d %d %s\000"
793 conf.angle (FMTE.to_int conf.fitmodel)
794 (stateh state.winh) state.nameddest
796 fillhelp ();
799 let reload () =
800 state.anchor <- getanchor ();
801 state.reload <- Some (state.x, state.y, now ());
802 opendoc state.path state.password;
805 let scalecolor c = let c = c *. conf.colorscale in (c, c, c);;
806 let scalecolor2 (r, g, b) =
807 (r *. conf.colorscale, g *. conf.colorscale, b *. conf.colorscale);
810 let docolumns columns =
811 match columns with
812 | Csingle _ ->
813 let a = Array.make state.pagecount (-1, -1, -1, (-1, -1, -1, -1)) in
814 let rec loop pageno pdimno pdim y ph pdims =
815 if pageno != state.pagecount
816 then
817 let pdimno, ((_, w, h, xoff) as pdim), pdims =
818 match pdims with
819 | ((pageno', _, _, _) as pdim) :: rest when pageno' = pageno ->
820 pdimno+1, pdim, rest
821 | _ ->
822 pdimno, pdim, pdims
824 let x = max 0 (((state.winw - w) / 2) - xoff) in
825 let y =
826 y + (if conf.presentation
827 then (if pageno = 0 then calcips h else calcips ph + calcips h)
828 else (if pageno = 0 then 0 else conf.interpagespace))
830 a.(pageno) <- (pdimno, x, y, pdim);
831 loop (pageno+1) pdimno pdim (y + h) h pdims
833 loop 0 ~-1 (-1,-1,-1,-1) 0 0 state.pdims;
834 conf.columns <- Csingle a;
836 | Cmulti ((columns, coverA, coverB), _) ->
837 let a = Array.make state.pagecount (-1, -1, -1, (-1, -1, -1, -1)) in
838 let rec loop pageno pdimno pdim x y rowh pdims =
839 let rec fixrow m =
840 if m = pageno then () else
841 let (pdimno, x, y, ((_, _, h, _) as pdim)) = a.(m) in
842 if h < rowh
843 then (
844 let y = y + (rowh - h) / 2 in
845 a.(m) <- (pdimno, x, y, pdim);
847 fixrow (m+1)
849 if pageno = state.pagecount
850 then fixrow (((pageno - 1) / columns) * columns)
851 else
852 let pdimno, ((_, w, h, xoff) as pdim), pdims =
853 match pdims with
854 | ((pageno', _, _, _) as pdim) :: rest when pageno' = pageno ->
855 pdimno+1, pdim, rest
856 | _ -> pdimno, pdim, pdims
858 let x, y, rowh' =
859 if pageno = coverA - 1 || pageno = state.pagecount - coverB
860 then (
861 let x = (state.winw - w) / 2 in
862 let ips =
863 if conf.presentation then calcips h else conf.interpagespace in
864 x, y + ips + rowh, h
866 else (
867 if (pageno - coverA) mod columns = 0
868 then (
869 let x = max 0 (state.winw - state.w) / 2 in
870 let y =
871 if conf.presentation
872 then
873 let ips = calcips h in
874 y + (if pageno = 0 then 0 else calcips rowh + ips)
875 else
876 y + (if pageno = 0 then 0 else conf.interpagespace)
878 x, y + rowh, h
880 else x, y, max rowh h
883 let y =
884 if pageno > 1 && (pageno - coverA) mod columns = 0
885 then (
886 let y =
887 if pageno = columns && conf.presentation
888 then (
889 let ips = calcips rowh in
890 for i = 0 to pred columns
892 let (pdimno, x, y, pdim) = a.(i) in
893 a.(i) <- (pdimno, x, y+ips, pdim)
894 done;
895 y+ips;
897 else y
899 fixrow (pageno - columns);
902 else y
904 a.(pageno) <- (pdimno, x, y, pdim);
905 let x = x + w + xoff*2 + conf.interpagespace in
906 loop (pageno+1) pdimno pdim x y rowh' pdims
908 loop 0 ~-1 (-1,-1,-1,-1) 0 0 0 state.pdims;
909 conf.columns <- Cmulti ((columns, coverA, coverB), a);
911 | Csplit (c, _) ->
912 let a = Array.make (state.pagecount*c) (-1, -1, -1, (-1, -1, -1, -1)) in
913 let rec loop pageno pdimno pdim y pdims =
914 if pageno != state.pagecount
915 then
916 let pdimno, ((_, w, h, _) as pdim), pdims =
917 match pdims with
918 | ((pageno', _, _, _) as pdim) :: rest when pageno' = pageno ->
919 pdimno+1, pdim, rest
920 | _ -> pdimno, pdim, pdims
922 let cw = w / c in
923 let rec loop1 n x y =
924 if n = c then y else (
925 a.(pageno*c + n) <- (pdimno, x, y, pdim);
926 loop1 (n+1) (x+cw) (y + h + conf.interpagespace)
929 let y = loop1 0 0 y in
930 loop (pageno+1) pdimno pdim y pdims
932 loop 0 ~-1 (-1,-1,-1,-1) 0 state.pdims;
933 conf.columns <- Csplit (c, a);
936 let represent () =
937 docolumns conf.columns;
938 state.maxy <- calcheight ();
939 if state.reprf == noreprf
940 then (
941 match state.mode with
942 | Birdseye (_, _, pageno, _, _) ->
943 let y, h = getpageyh pageno in
944 let top = (state.winh - h) / 2 in
945 gotoxy state.x (max 0 (y - top))
946 | Textentry _ | View | LinkNav _ ->
947 let y = getanchory state.anchor in
948 let y = min y (state.maxy - state.winh) in
949 gotoxy state.x y;
951 else (
952 state.reprf ();
953 state.reprf <- noreprf;
957 let reshape ?(firsttime=false) w h =
958 GlDraw.viewport ~x:0 ~y:0 ~w ~h;
959 if not firsttime && nogeomcmds state.geomcmds
960 then state.anchor <- getanchor ();
962 state.winw <- w;
963 let w = truncate (float w *. conf.zoom) in
964 let w = max w 2 in
965 state.winh <- h;
966 setfontsize fstate.fontsize;
967 GlMat.mode `modelview;
968 GlMat.load_identity ();
970 GlMat.mode `projection;
971 GlMat.load_identity ();
972 GlMat.rotate ~x:1.0 ~angle:180.0 ();
973 GlMat.translate ~x:~-.1.0 ~y:~-.1.0 ();
974 GlMat.scale3 (2.0 /. float state.winw, 2.0 /. float state.winh, 1.0);
976 let relx =
977 if conf.zoom <= 1.0
978 then 0.0
979 else float state.x /. float state.w
981 invalidate "geometry"
982 (fun () ->
983 state.w <- w;
984 if not firsttime
985 then state.x <- truncate (relx *. float w);
986 let w =
987 match conf.columns with
988 | Csingle _ -> w
989 | Cmulti ((c, _, _), _) -> (w - (c-1)*conf.interpagespace) / c
990 | Csplit (c, _) -> w * c
992 wcmd "geometry %d %d %d" w (stateh h) (FMTE.to_int conf.fitmodel)
996 let gctiles () =
997 let len = Queue.length state.tilelru in
998 let layout = lazy (if conf.preload
999 then preloadlayout state.x state.y state.winw state.winh
1000 else state.layout) in
1001 let rec loop qpos =
1002 if state.memused > conf.memlimit
1003 then (
1004 if qpos < len
1005 then
1006 let (k, p, s) as lruitem = Queue.pop state.tilelru in
1007 let n, gen, colorspace, angle, pagew, pageh, col, row = k in
1008 let (_, pw, ph, _) = getpagedim n in
1009 if gen = state.gen
1010 && colorspace = conf.colorspace
1011 && angle = conf.angle
1012 && pagew = pw
1013 && pageh = ph
1014 && (
1015 let x = col*conf.tilew and y = row*conf.tileh in
1016 tilevisible (Lazy.force_val layout) n x y
1018 then Queue.push lruitem state.tilelru
1019 else (
1020 Ffi.freepbo p;
1021 wcmd "freetile %s" (~> p);
1022 state.memused <- state.memused - s;
1023 state.uioh#infochanged Memused;
1024 Hashtbl.remove state.tilemap k;
1026 loop (qpos+1)
1029 loop 0
1032 let onpagerect pageno f =
1033 let b =
1034 match conf.columns with
1035 | Cmulti (_, b) -> b
1036 | Csingle b -> b
1037 | Csplit (_, b) -> b
1039 if pageno >= 0 && pageno < Array.length b
1040 then
1041 let (_, _, _, (_, w, h, _)) = b.(pageno) in
1042 f w h
1045 let gotopagexy1 pageno x y =
1046 let _,w1,h1,leftx = getpagedim pageno in
1047 let top = y /. (float h1) in
1048 let left = x /. (float w1) in
1049 let py, w, h = getpageywh pageno in
1050 let wh = state.winh in
1051 let x = left *. (float w) in
1052 let x = leftx + state.x + truncate x in
1053 let sx =
1054 if x < 0 || x >= state.winw
1055 then state.x - x
1056 else state.x
1058 let pdy = truncate (top *. float h) in
1059 let y' = py + pdy in
1060 let dy = y' - state.y in
1061 let sy =
1062 if x != state.x || not (dy > 0 && dy < wh)
1063 then (
1064 if conf.presentation
1065 then
1066 if abs (py - y') > wh
1067 then y'
1068 else py
1069 else y';
1071 else state.y
1073 if state.x != sx || state.y != sy
1074 then gotoxy sx sy
1075 else gotoxy state.x state.y;
1078 let gotopagexy pageno x y =
1079 match state.mode with
1080 | Birdseye _ -> gotopage pageno 0.0
1081 | Textentry _ | View | LinkNav _ -> gotopagexy1 pageno x y
1084 let getpassword () =
1085 let passcmd = getenvdef "LLPP_ASKPASS" conf.passcmd in
1086 if emptystr passcmd
1087 then E.s
1088 else getcmdoutput (fun s ->
1089 impmsg "error getting password: %s" s;
1090 dolog "%s" s) passcmd;
1093 let pgoto opaque pageno x y =
1094 let pdimno = getpdimno pageno in
1095 let x, y = Ffi.project opaque pageno pdimno x y in
1096 gotopagexy pageno x y;
1099 let act cmds =
1100 (* dolog "%S" cmds; *)
1101 let spl = splitatchar cmds ' ' in
1102 let scan s fmt f =
1103 try Scanf.sscanf s fmt f
1104 with exn ->
1105 dolog "error processing '%S': %s" cmds @@ exntos exn;
1106 exit 1
1108 let addoutline outline =
1109 match state.currently with
1110 | Outlining outlines -> state.currently <- Outlining (outline :: outlines)
1111 | Idle -> state.currently <- Outlining [outline]
1112 | Loading _ | Tiling _ ->
1113 dolog "invalid outlining state";
1114 logcurrently state.currently
1116 match spl with
1117 | "clear", "" ->
1118 state.pdims <- [];
1119 state.uioh#infochanged Pdim;
1121 | "clearrects", "" ->
1122 state.rects <- state.rects1;
1123 postRedisplay "clearrects";
1125 | "continue", args ->
1126 let n = scan args "%u" (fun n -> n) in
1127 state.pagecount <- n;
1128 begin match state.currently with
1129 | Outlining l ->
1130 state.currently <- Idle;
1131 state.outlines <- Array.of_list (List.rev l)
1132 | Idle | Loading _ | Tiling _ -> ()
1133 end;
1135 let cur, cmds = state.geomcmds in
1136 if emptystr cur then error "empty geomcmd";
1138 begin match List.rev cmds with
1139 | [] ->
1140 state.geomcmds <- E.s, [];
1141 represent ();
1142 | (s, f) :: rest ->
1143 f ();
1144 state.geomcmds <- s, List.rev rest;
1145 end;
1146 postRedisplay "continue";
1148 | "msg", args ->
1149 showtext ' ' args
1151 | "vmsg", args ->
1152 if conf.verbose then showtext ' ' args
1154 | "emsg", args ->
1155 Buffer.add_string state.errmsgs args;
1156 Buffer.add_char state.errmsgs '\n';
1157 if not state.newerrmsgs
1158 then (
1159 state.newerrmsgs <- true;
1160 postRedisplay "error message";
1163 | "progress", args ->
1164 let progress, text =
1165 scan args "%f %n"
1166 (fun f pos -> f, String.sub args pos (String.length args - pos))
1168 state.text <- text;
1169 state.progress <- progress;
1170 postRedisplay "progress"
1172 | "firstmatch", args ->
1173 let pageno, c, x0, y0, x1, y1, x2, y2, x3, y3 =
1174 scan args "%u %d %f %f %f %f %f %f %f %f"
1175 (fun p c x0 y0 x1 y1 x2 y2 x3 y3 ->
1176 (p, c, x0, y0, x1, y1, x2, y2, x3, y3))
1178 let y = (getpagey pageno) + truncate y0 in
1179 let x =
1180 if (state.x < - truncate x0) || (state.x > state.winw - truncate x1)
1181 then state.winw/2 - truncate (x0 /. 2. +. x1 /. 2.)
1182 else state.x
1184 addnav ();
1185 gotoxy x y;
1186 let color = (0.0, 0.0, 1.0 /. float c, 0.5) in
1187 state.rects1 <- [pageno, color, (x0, y0, x1, y1, x2, y2, x3, y3)]
1189 | "match", args ->
1190 let pageno, c, x0, y0, x1, y1, x2, y2, x3, y3 =
1191 scan args "%u %d %f %f %f %f %f %f %f %f"
1192 (fun p c x0 y0 x1 y1 x2 y2 x3 y3 ->
1193 (p, c, x0, y0, x1, y1, x2, y2, x3, y3))
1195 let color = (0.0, 0.0, 1.0 /. float c, 0.5) in
1196 state.rects1 <-
1197 (pageno, color, (x0, y0, x1, y1, x2, y2, x3, y3)) :: state.rects1
1199 | "page", args ->
1200 let pageopaques, t = scan args "%s %f" (fun p t -> p, t) in
1201 let pageopaque = ~< pageopaques in
1202 begin match state.currently with
1203 | Loading (l, gen) ->
1204 vlog "page %d took %f sec" l.pageno t;
1205 Hashtbl.replace state.pagemap (l.pageno, gen) pageopaque;
1206 let preloadedpages =
1207 if conf.preload
1208 then preloadlayout state.x state.y state.winw state.winh
1209 else state.layout
1211 let evict () =
1212 let set = List.fold_left (fun s l -> IntSet.add l.pageno s)
1213 IntSet.empty preloadedpages
1215 let evictedpages =
1216 Hashtbl.fold (fun ((pageno, _) as key) opaque accu ->
1217 if not (IntSet.mem pageno set)
1218 then (
1219 wcmd "freepage %s" (~> opaque);
1220 key :: accu
1222 else accu
1223 ) state.pagemap []
1225 List.iter (Hashtbl.remove state.pagemap) evictedpages;
1227 evict ();
1228 state.currently <- Idle;
1229 if gen = state.gen
1230 then (
1231 tilepage l.pageno pageopaque state.layout;
1232 load state.layout;
1233 load preloadedpages;
1234 let visible = pagevisible state.layout l.pageno in
1235 if visible
1236 then (
1237 match state.mode with
1238 | LinkNav (Ltnotready (pageno, dir)) ->
1239 if pageno = l.pageno
1240 then (
1241 let link =
1242 let ld =
1243 if dir = 0
1244 then LDfirstvisible (l.pagex, l.pagey, dir)
1245 else if dir > 0 then LDfirst else LDlast
1247 Ffi.findlink pageopaque ld
1249 match link with
1250 | Lnotfound -> ()
1251 | Lfound n ->
1252 showlinktype (Ffi.getlink pageopaque n);
1253 state.mode <- LinkNav (Ltexact (l.pageno, n))
1255 | LinkNav (Ltgendir _)
1256 | LinkNav (Ltexact _)
1257 | View
1258 | Birdseye _
1259 | Textentry _ -> ()
1262 if visible && layoutready state.layout
1263 then postRedisplay "page";
1266 | Idle | Tiling _ | Outlining _ ->
1267 dolog "Inconsistent loading state";
1268 logcurrently state.currently;
1269 exit 1
1272 | "tile" , args ->
1273 let (x, y, opaques, size, t) =
1274 scan args "%u %u %s %u %f" (fun x y p size t -> (x, y, p, size, t))
1276 let opaque = ~< opaques in
1277 begin match state.currently with
1278 | Tiling (l, pageopaque, cs, angle, gen, col, row, tilew, tileh) ->
1279 vlog "tile %d [%d,%d] took %f sec" l.pageno col row t;
1281 Ffi.unmappbo opaque;
1282 if tilew != conf.tilew || tileh != conf.tileh
1283 then (
1284 wcmd "freetile %s" (~> opaque);
1285 state.currently <- Idle;
1286 load state.layout;
1288 else (
1289 puttileopaque l col row gen cs angle opaque size t;
1290 state.memused <- state.memused + size;
1291 state.uioh#infochanged Memused;
1292 gctiles ();
1293 Queue.push ((l.pageno, gen, cs, angle, l.pagew, l.pageh, col, row),
1294 opaque, size) state.tilelru;
1296 state.currently <- Idle;
1297 if gen = state.gen
1298 && conf.colorspace = cs
1299 && conf.angle = angle
1300 && tilevisible state.layout l.pageno x y
1301 then conttiling l.pageno pageopaque;
1303 preload state.layout;
1304 if gen = state.gen
1305 && conf.colorspace = cs
1306 && conf.angle = angle
1307 && tilevisible state.layout l.pageno x y
1308 && layoutready state.layout
1309 then postRedisplay "tile nothrottle";
1312 | Idle | Loading _ | Outlining _ ->
1313 dolog "Inconsistent tiling state";
1314 logcurrently state.currently;
1315 exit 1
1318 | "pdim", args ->
1319 let (n, w, h, _) as pdim =
1320 scan args "%u %u %u %u" (fun n w h x -> n, w, h, x)
1322 let pdim =
1323 match conf.fitmodel with
1324 | FitWidth -> pdim
1325 | FitPage | FitProportional ->
1326 match conf.columns with
1327 | Csplit _ -> (n, w, h, 0)
1328 | Csingle _ | Cmulti _ -> pdim
1330 state.pdims <- pdim :: state.pdims;
1331 state.uioh#infochanged Pdim
1333 | "o", args ->
1334 let (l, n, t, h, pos) =
1335 scan args "%u %u %d %u %n" (fun l n t h pos -> l, n, t, h, pos)
1337 let s = String.sub args pos (String.length args - pos) in
1338 addoutline (s, l, Oanchor (n, float t /. float h, 0.0))
1340 | "ou", args ->
1341 let (l, len, pos) = scan args "%u %u %n" (fun l len pos -> l, len, pos) in
1342 let s = String.sub args pos len in
1343 let pos2 = pos + len + 1 in
1344 let uri = String.sub args pos2 (String.length args - pos2) in
1345 addoutline (s, l, Ouri uri)
1347 | "on", args ->
1348 let (l, pos) = scan args "%u %n" (fun l pos -> l, pos) in
1349 let s = String.sub args pos (String.length args - pos) in
1350 addoutline (s, l, Onone)
1352 | "a", args ->
1353 let (n, l, t) = scan args "%u %d %d" (fun n l t -> n, l, t) in
1354 state.reprf <- (fun () -> gotopagexy n (float l) (float t))
1356 | "info", args ->
1357 let c, v = splitatchar args '\t' in
1358 let s =
1359 if nonemptystr v
1360 then
1361 if c = "Title"
1362 then (
1363 conf.title <- v;
1364 if not !ignoredoctitlte then Wsi.settitle v;
1365 args
1367 else
1368 if let len = String.length c in
1369 len > 6 && ((String.sub c (len-4) 4) = "date")
1370 then (
1371 if String.length v >= 7 && v.[0] = 'D' && v.[1] = ':'
1372 then
1373 let b = Buffer.create 10 in
1374 Printf.bprintf b "%s\t" c;
1375 let sub p l c =
1377 Buffer.add_substring b v p l;
1378 Buffer.add_char b c;
1379 with exn -> Buffer.add_string b @@ exntos exn
1381 sub 2 4 '/';
1382 sub 6 2 '/';
1383 sub 8 2 ' ';
1384 sub 10 2 ':';
1385 sub 12 2 ':';
1386 sub 14 2 ' ';
1387 Printf.bprintf b "[%s]" v;
1388 Buffer.contents b
1389 else args
1391 else args
1392 else args
1394 state.docinfo <- (1, s) :: state.docinfo
1396 | "infoend", "" ->
1397 state.docinfo <- List.rev state.docinfo;
1398 state.uioh#infochanged Docinfo
1400 | "pass", args ->
1401 if args = "fail"
1402 then Wsi.settitle "Wrong password";
1403 let password = getpassword () in
1404 if emptystr password
1405 then error "document is password protected"
1406 else opendoc state.path password
1408 | _ -> error "unknown cmd `%S'" cmds
1411 let onhist cb =
1412 let rc = cb.rc in
1413 let action = function
1414 | HCprev -> cbget cb ~-1
1415 | HCnext -> cbget cb 1
1416 | HCfirst -> cbget cb ~-(cb.rc)
1417 | HClast -> cbget cb (cb.len - 1 - cb.rc)
1418 and cancel () = cb.rc <- rc
1419 in (action, cancel)
1422 let search pattern forward =
1423 match conf.columns with
1424 | Csplit _ -> impmsg "searching does not work properly in split columns mode"
1425 | Csingle _ | Cmulti _ ->
1426 if nonemptystr pattern
1427 then
1428 let pn, py =
1429 match state.layout with
1430 | [] -> 0, 0
1431 | l :: _ -> l.pageno, (l.pagey + if forward then 0 else 0*l.pagevh)
1433 wcmd "search %d %d %d %d,%s\000"
1434 (btod conf.icase) pn py (btod forward) pattern;
1437 let intentry text key =
1438 let text =
1439 if emptystr text && key = Keys.Ascii '-'
1440 then addchar text '-'
1441 else
1442 match [@warning "-4"] key with
1443 | Keys.Ascii ('0'..'9' as c) -> addchar text c
1444 | _ ->
1445 state.text <- "invalid key";
1446 text
1448 TEcont text
1451 let linknact f s =
1452 if nonemptystr s
1453 then
1454 let n =
1455 let l = String.length s in
1456 let rec loop pos n =
1457 if pos = l
1458 then n
1459 else
1460 let m = Char.code s.[pos] - (if pos = 0 && l > 1 then 96 else 97) in
1461 loop (pos+1) (n*26 + m)
1462 in loop 0 0
1464 let rec loop n = function
1465 | [] -> ()
1466 | l :: rest ->
1467 match getopaque l.pageno with
1468 | None -> loop n rest
1469 | Some opaque ->
1470 let m = Ffi.getlinkcount opaque in
1471 if n < m
1472 then
1473 let under = Ffi.getlink opaque n in
1474 f under
1475 else loop (n-m) rest
1477 loop n state.layout;
1480 let linknentry text key = match [@warning "-4"] key with
1481 | Keys.Ascii ('a' .. 'z' as c) ->
1482 let text = addchar text c in
1483 linknact (fun under -> state.text <- undertext under) text;
1484 TEcont text
1485 | _ ->
1486 state.text <- Printf.sprintf "invalid key %s" @@ Keys.to_string key;
1487 TEcont text
1490 let textentry text key = match [@warning "-4"] key with
1491 | Keys.Ascii c -> TEcont (addchar text c)
1492 | Keys.Code c -> TEcont (text ^ toutf8 c)
1493 | _ -> TEcont text
1496 let reqlayout angle fitmodel =
1497 if nogeomcmds state.geomcmds
1498 then state.anchor <- getanchor ();
1499 conf.angle <- angle mod 360;
1500 if conf.angle != 0
1501 then (
1502 match state.mode with
1503 | LinkNav _ -> state.mode <- View
1504 | Birdseye _ | Textentry _ | View -> ()
1506 conf.fitmodel <- fitmodel;
1507 invalidate "reqlayout"
1508 (fun () -> wcmd "reqlayout %d %d %d"
1509 conf.angle (FMTE.to_int conf.fitmodel) (stateh state.winh));
1512 let settrim trimmargins trimfuzz =
1513 if nogeomcmds state.geomcmds
1514 then state.anchor <- getanchor ();
1515 conf.trimmargins <- trimmargins;
1516 conf.trimfuzz <- trimfuzz;
1517 let x0, y0, x1, y1 = trimfuzz in
1518 invalidate "settrim"
1519 (fun () -> wcmd "settrim %d %d %d %d %d"
1520 (btod conf.trimmargins) x0 y0 x1 y1);
1521 flushpages ();
1524 let setzoom zoom =
1525 let zoom = max 0.0001 zoom in
1526 if zoom <> conf.zoom
1527 then (
1528 state.prevzoom <- (conf.zoom, state.x);
1529 conf.zoom <- zoom;
1530 reshape state.winw state.winh;
1531 state.text <- Printf.sprintf "zoom is now %-5.2f" (zoom *. 100.0);
1535 let pivotzoom ?(vw=min state.w state.winw)
1536 ?(vh=min (state.maxy-state.y) state.winh)
1537 ?(x=vw/2) ?(y=vh/2) zoom =
1538 let w = float state.w /. zoom in
1539 let hw = w /. 2.0 in
1540 let ratio = float vh /. float vw in
1541 let hh = hw *. ratio in
1542 let x0 = float x -. hw
1543 and y0 = float y -. hh in
1544 gotoxy (state.x - truncate x0) (state.y + truncate y0);
1545 setzoom zoom;
1548 let pivotzoom ?vw ?vh ?x ?y zoom =
1549 if nogeomcmds state.geomcmds
1550 then
1551 if zoom > 1.0
1552 then pivotzoom ?vw ?vh ?x ?y zoom
1553 else setzoom zoom
1556 let setcolumns mode columns coverA coverB =
1557 state.prevcolumns <- Some (conf.columns, conf.zoom);
1558 if columns < 0
1559 then (
1560 if isbirdseye mode
1561 then impmsg "split mode doesn't work in bird's eye"
1562 else (
1563 conf.columns <- Csplit (-columns, E.a);
1564 state.x <- 0;
1565 conf.zoom <- 1.0;
1568 else (
1569 if columns < 2
1570 then (
1571 conf.columns <- Csingle E.a;
1572 state.x <- 0;
1573 setzoom 1.0;
1575 else (
1576 conf.columns <- Cmulti ((columns, coverA, coverB), E.a);
1577 conf.zoom <- 1.0;
1580 reshape state.winw state.winh;
1583 let resetmstate () =
1584 state.mstate <- Mnone;
1585 Wsi.setcursor Wsi.CURSOR_INHERIT;
1588 let enterbirdseye () =
1589 let zoom = float conf.thumbw /. float state.winw in
1590 let birdseyepageno =
1591 let cy = state.winh / 2 in
1592 let fold = function
1593 | [] -> 0
1594 | l :: rest ->
1595 let rec fold best = function
1596 | [] -> best.pageno
1597 | l :: rest ->
1598 let d = cy - (l.pagedispy + l.pagevh/2)
1599 and dbest = cy - (best.pagedispy + best.pagevh/2) in
1600 if abs d < abs dbest
1601 then fold l rest
1602 else best.pageno
1603 in fold l rest
1605 fold state.layout
1607 state.mode <-
1608 Birdseye (
1609 { conf with zoom = conf.zoom },
1610 state.x, birdseyepageno, -1, getanchor ()
1612 resetmstate ();
1613 conf.zoom <- zoom;
1614 conf.presentation <- false;
1615 conf.interpagespace <- 10;
1616 conf.hlinks <- false;
1617 conf.fitmodel <- FitPage;
1618 state.x <- 0;
1619 conf.columns <- (
1620 match conf.beyecolumns with
1621 | Some c ->
1622 conf.zoom <- 1.0;
1623 Cmulti ((c, 0, 0), E.a)
1624 | None -> Csingle E.a
1626 if conf.verbose
1627 then state.text <- Printf.sprintf "birds eye mode on (zoom %3.1f%%)"
1628 (100.0*.zoom)
1629 else state.text <- E.s;
1630 reshape state.winw state.winh;
1633 let leavebirdseye (c, leftx, pageno, _, anchor) goback =
1634 state.mode <- View;
1635 conf.zoom <- c.zoom;
1636 conf.presentation <- c.presentation;
1637 conf.interpagespace <- c.interpagespace;
1638 conf.hlinks <- c.hlinks;
1639 conf.fitmodel <- c.fitmodel;
1640 conf.beyecolumns <- (
1641 match conf.columns with
1642 | Cmulti ((c, _, _), _) -> Some c
1643 | Csingle _ -> None
1644 | Csplit _ -> error "leaving bird's eye split mode"
1646 conf.columns <- (
1647 match c.columns with
1648 | Cmulti (c, _) -> Cmulti (c, E.a)
1649 | Csingle _ -> Csingle E.a
1650 | Csplit (c, _) -> Csplit (c, E.a)
1652 if conf.verbose
1653 then state.text <- Printf.sprintf "birds eye mode off (zoom %3.1f%%)"
1654 (100.0*.conf.zoom);
1655 reshape state.winw state.winh;
1656 state.anchor <- if goback then anchor else (pageno, 0.0, 1.0);
1657 state.x <- leftx;
1660 let togglebirdseye () =
1661 match state.mode with
1662 | Birdseye vals -> leavebirdseye vals true
1663 | View -> enterbirdseye ()
1664 | Textentry _ | LinkNav _ -> ()
1667 let upbirdseye incr (conf, leftx, pageno, hooverpageno, anchor) =
1668 let pageno = max 0 (pageno - incr) in
1669 let rec loop = function
1670 | [] -> gotopage1 pageno 0
1671 | l :: _ when l.pageno = pageno ->
1672 if l.pagedispy >= 0 && l.pagey = 0
1673 then postRedisplay "upbirdseye"
1674 else gotopage1 pageno 0
1675 | _ :: rest -> loop rest
1677 loop state.layout;
1678 state.text <- E.s;
1679 state.mode <- Birdseye (conf, leftx, pageno, hooverpageno, anchor)
1682 let downbirdseye incr (conf, leftx, pageno, hooverpageno, anchor) =
1683 let pageno = min (state.pagecount - 1) (pageno + incr) in
1684 state.mode <- Birdseye (conf, leftx, pageno, hooverpageno, anchor);
1685 let rec loop = function
1686 | [] ->
1687 let y, h = getpageyh pageno in
1688 let dy = (y - state.y) - (state.winh - h - conf.interpagespace) in
1689 gotoxy state.x (clamp dy)
1690 | l :: _ when l.pageno = pageno ->
1691 if l.pagevh != l.pageh
1692 then gotoxy state.x (clamp (l.pageh - l.pagevh + conf.interpagespace))
1693 else postRedisplay "downbirdseye"
1694 | _ :: rest -> loop rest
1696 loop state.layout;
1697 state.text <- E.s;
1700 let optentry mode _ key =
1701 let btos b = if b then "on" else "off" in
1702 match [@warning "-4"] key with
1703 | Keys.Ascii 'C' ->
1704 let ondone s =
1706 let n, a, b = multicolumns_of_string s in
1707 setcolumns mode n a b;
1708 with exn ->
1709 state.text <- Printf.sprintf "bad columns `%s': %s" s @@ exntos exn
1711 TEswitch ("columns: ", E.s, None, textentry, ondone, true)
1713 | Keys.Ascii 'Z' ->
1714 let ondone s =
1716 let zoom = float (int_of_string s) /. 100.0 in
1717 pivotzoom zoom
1718 with exn ->
1719 state.text <- Printf.sprintf "bad integer `%s': %s" s @@ exntos exn
1721 TEswitch ("zoom: ", E.s, None, intentry, ondone, true)
1723 | Keys.Ascii 'i' ->
1724 conf.icase <- not conf.icase;
1725 TEdone ("case insensitive search " ^ (btos conf.icase))
1727 | Keys.Ascii 'v' ->
1728 conf.verbose <- not conf.verbose;
1729 TEdone ("verbose " ^ (btos conf.verbose))
1731 | Keys.Ascii 'd' ->
1732 conf.debug <- not conf.debug;
1733 TEdone ("debug " ^ (btos conf.debug))
1735 | Keys.Ascii 'f' ->
1736 conf.underinfo <- not conf.underinfo;
1737 TEdone ("underinfo " ^ btos conf.underinfo)
1739 | Keys.Ascii 'T' ->
1740 settrim (not conf.trimmargins) conf.trimfuzz;
1741 TEdone ("trim margins " ^ btos conf.trimmargins)
1743 | Keys.Ascii 'I' ->
1744 conf.invert <- not conf.invert;
1745 TEdone ("invert colors " ^ btos conf.invert)
1747 | Keys.Ascii 'x' ->
1748 let ondone s =
1749 cbput state.hists.sel s;
1750 conf.selcmd <- s;
1752 TEswitch ("selection command: ", E.s, Some (onhist state.hists.sel),
1753 textentry, ondone, true)
1755 | Keys.Ascii 'M' ->
1756 if conf.pax == None
1757 then conf.pax <- Some 0.0
1758 else conf.pax <- None;
1759 TEdone ("PAX " ^ btos (conf.pax != None))
1761 | (Keys.Ascii c) ->
1762 state.text <- Printf.sprintf "bad option %d `%c'" (Char.code c) c;
1763 TEstop
1765 | _ -> TEcont state.text
1768 let adderrmsg src msg =
1769 Buffer.add_string state.errmsgs msg;
1770 state.newerrmsgs <- true;
1771 postRedisplay src
1774 let adderrfmt src fmt = Format.ksprintf (fun s -> adderrmsg src s) fmt;;
1776 class outlinelistview ~zebra ~source =
1777 let settext autonarrow s =
1778 if autonarrow
1779 then
1780 let ss = source#statestr in
1781 state.text <- if emptystr ss
1782 then "[" ^ s ^ "]"
1783 else "{" ^ ss ^ "} [" ^ s ^ "]"
1784 else state.text <- s
1786 object (self)
1787 inherit listview
1788 ~zebra
1789 ~helpmode:false
1790 ~source:(source :> lvsource)
1791 ~trusted:false
1792 ~modehash:(findkeyhash conf "outline")
1793 as super
1795 val m_autonarrow = false
1797 method! key key mask =
1798 let maxrows =
1799 if emptystr state.text
1800 then fstate.maxrows
1801 else fstate.maxrows - 2
1803 let calcfirst first active =
1804 if active > first
1805 then
1806 let rows = active - first in
1807 if rows > maxrows then active - maxrows else first
1808 else active
1810 let navigate incr =
1811 let active = m_active + incr in
1812 let active = bound active 0 (source#getitemcount - 1) in
1813 let first = calcfirst m_first active in
1814 postRedisplay "outline navigate";
1815 coe {< m_active = active; m_first = first >}
1817 let navscroll first =
1818 let active =
1819 let dist = m_active - first in
1820 if dist < 0
1821 then first
1822 else (
1823 if dist < maxrows
1824 then m_active
1825 else first + maxrows
1828 postRedisplay "outline navscroll";
1829 coe {< m_first = first; m_active = active >}
1831 let ctrl = Wsi.withctrl mask in
1832 let open Keys in
1833 match Wsi.kc2kt key with
1834 | Ascii 'a' when ctrl ->
1835 let text =
1836 if m_autonarrow
1837 then (
1838 source#denarrow;
1841 else (
1842 let pattern = source#renarrow in
1843 if nonemptystr m_qsearch
1844 then (source#narrow m_qsearch; m_qsearch)
1845 else pattern
1848 settext (not m_autonarrow) text;
1849 postRedisplay "toggle auto narrowing";
1850 coe {< m_first = 0; m_active = 0; m_autonarrow = not m_autonarrow >}
1852 | Ascii '/' when emptystr m_qsearch && not m_autonarrow ->
1853 settext true E.s;
1854 postRedisplay "toggle auto narrowing";
1855 coe {< m_first = 0; m_active = 0; m_autonarrow = true >}
1857 | Ascii 'n' when ctrl ->
1858 source#narrow m_qsearch;
1859 if not m_autonarrow
1860 then source#add_narrow_pattern m_qsearch;
1861 postRedisplay "outline ctrl-n";
1862 coe {< m_first = 0; m_active = 0 >}
1864 | Ascii 'S' when ctrl ->
1865 let active = source#calcactive (getanchor ()) in
1866 let first = firstof m_first active in
1867 postRedisplay "outline ctrl-s";
1868 coe {< m_first = first; m_active = active >}
1870 | Ascii 'u' when ctrl ->
1871 postRedisplay "outline ctrl-u";
1872 if m_autonarrow && nonemptystr m_qsearch
1873 then (
1874 ignore (source#renarrow);
1875 settext m_autonarrow E.s;
1876 coe {< m_first = 0; m_active = 0; m_qsearch = E.s >}
1878 else (
1879 source#del_narrow_pattern;
1880 let pattern = source#renarrow in
1881 let text =
1882 if emptystr pattern then E.s else "Narrowed to " ^ pattern
1884 settext m_autonarrow text;
1885 coe {< m_first = 0; m_active = 0; m_qsearch = E.s >}
1888 | Ascii 'l' when ctrl ->
1889 let first = max 0 (m_active - (fstate.maxrows / 2)) in
1890 postRedisplay "outline ctrl-l";
1891 coe {< m_first = first >}
1893 | Ascii '\t' when m_autonarrow ->
1894 if nonemptystr m_qsearch
1895 then (
1896 postRedisplay "outline list view tab";
1897 source#add_narrow_pattern m_qsearch;
1898 settext true E.s;
1899 coe {< m_qsearch = E.s >}
1901 else coe self
1903 | Escape when m_autonarrow ->
1904 if nonemptystr m_qsearch
1905 then source#add_narrow_pattern m_qsearch;
1906 super#key key mask
1908 | Enter when m_autonarrow ->
1909 if nonemptystr m_qsearch
1910 then source#add_narrow_pattern m_qsearch;
1911 super#key key mask
1913 | (Ascii _ | Code _) when m_autonarrow ->
1914 let pattern = m_qsearch ^ toutf8 key in
1915 postRedisplay "outlinelistview autonarrow add";
1916 source#narrow pattern;
1917 settext true pattern;
1918 coe {< m_first = 0; m_active = 0; m_qsearch = pattern >}
1920 | Backspace when m_autonarrow ->
1921 if emptystr m_qsearch
1922 then coe self
1923 else
1924 let pattern = withoutlastutf8 m_qsearch in
1925 postRedisplay "outlinelistview autonarrow backspace";
1926 ignore (source#renarrow);
1927 source#narrow pattern;
1928 settext true pattern;
1929 coe {< m_first = 0; m_active = 0; m_qsearch = pattern >}
1931 | Up when ctrl -> navscroll (max 0 (m_first - 1))
1933 | Down when ctrl ->
1934 navscroll (min (source#getitemcount - 1) (m_first + 1))
1936 | Up -> navigate ~-1
1937 | Down -> navigate 1
1938 | Prior -> navigate ~-(fstate.maxrows)
1939 | Next -> navigate fstate.maxrows
1941 | Right ->
1942 let o =
1943 if ctrl
1944 then (
1945 postRedisplay "outline ctrl right";
1946 {< m_pan = m_pan + 1 >}
1948 else (
1949 if Wsi.withshift mask
1950 then self#nextcurlevel 1
1951 else self#updownlevel 1
1954 coe o
1956 | Left ->
1957 let o =
1958 if ctrl
1959 then (
1960 postRedisplay "outline ctrl left";
1961 {< m_pan = m_pan - 1 >}
1963 else (
1964 if Wsi.withshift mask
1965 then self#nextcurlevel ~-1
1966 else self#updownlevel ~-1
1969 coe o
1971 | Home ->
1972 postRedisplay "outline home";
1973 coe {< m_first = 0; m_active = 0 >}
1975 | End ->
1976 let active = source#getitemcount - 1 in
1977 let first = max 0 (active - fstate.maxrows) in
1978 postRedisplay "outline end";
1979 coe {< m_active = active; m_first = first >}
1981 | Delete|Escape|Insert|Enter|Ascii _|Code _|Ctrl _|Backspace|Fn _ ->
1982 super#key key mask
1983 end;;
1985 let genhistoutlines () =
1986 Config.gethist ()
1987 |> List.sort (fun (_, c1, _, _, _, _) (_, c2, _, _, _, _) ->
1988 compare c2.lastvisit c1.lastvisit)
1989 |> List.map (fun ((path, c, _, _, _, origin) as hist) ->
1990 let path = if nonemptystr origin then origin else path in
1991 let base = mbtoutf8 @@ Filename.basename path in
1992 (base ^ "\000" ^ c.title, 1, Ohistory hist)
1996 let gotohist (path, c, bookmarks, x, anchor, origin) =
1997 Config.save leavebirdseye;
1998 state.anchor <- anchor;
1999 state.bookmarks <- bookmarks;
2000 state.origin <- origin;
2001 state.x <- x;
2002 setconf conf c;
2003 let x0, y0, x1, y1 = conf.trimfuzz in
2004 wcmd "trimset %d %d %d %d %d" (btod conf.trimmargins) x0 y0 x1 y1;
2005 reshape ~firsttime:true state.winw state.winh;
2006 opendoc path origin;
2007 setzoom c.zoom;
2010 let setcheckers enabled =
2011 match !checkerstexid with
2012 | None -> if enabled then checkerstexid := Some (makecheckers ())
2013 | Some id ->
2014 if not enabled
2015 then (
2016 GlTex.delete_texture id;
2017 checkerstexid := None;
2021 let describe_layout layout =
2022 let d =
2023 match layout with
2024 | [] -> "Page 0"
2025 | l :: [] -> Printf.sprintf "Page %d" (l.pageno+1)
2026 | l :: rest ->
2027 let rangestr a b =
2028 if a.pageno = b.pageno then Printf.sprintf "%d" (a.pageno+1)
2029 else Printf.sprintf "%d%s%d" (a.pageno+1)
2030 (if a.pageno+1 = b.pageno then ", " else Utf8syms.ellipsis)
2031 (b.pageno+1)
2033 let rec fold s la lb = function
2034 | [] -> Printf.sprintf "%s %s" s (rangestr la lb)
2035 | l :: rest when l.pageno = succ lb.pageno -> fold s la l rest
2036 | l :: rest -> fold (s ^ " " ^ rangestr la lb ^ ",") l l rest
2038 fold "Pages" l l rest
2040 let percent =
2041 let maxy = maxy () in
2042 if maxy <= 0
2043 then 100.
2044 else 100. *. (float state.y /. float maxy)
2046 Printf.sprintf "%s of %d [%.2f%%]" d state.pagecount percent
2049 let setpresentationmode v =
2050 let n = page_of_y state.y in
2051 state.anchor <- (n, 0.0, 1.0);
2052 conf.presentation <- v;
2053 if conf.fitmodel = FitPage
2054 then reqlayout conf.angle conf.fitmodel;
2055 represent ();
2058 let enterinfomode =
2059 let btos b = if b then Utf8syms.radical else E.s in
2060 let showextended = ref false in
2061 let showcolors = ref false in
2062 let leave mode _ = state.mode <- mode in
2063 let src =
2064 (object
2065 val mutable m_l = []
2066 val mutable m_a = E.a
2067 val mutable m_prev_uioh = nouioh
2068 val mutable m_prev_mode = View
2070 inherit lvsourcebase
2072 method reset prev_mode prev_uioh =
2073 m_a <- Array.of_list (List.rev m_l);
2074 m_l <- [];
2075 m_prev_mode <- prev_mode;
2076 m_prev_uioh <- prev_uioh;
2078 method int name get set =
2079 m_l <-
2080 (name, `int get, 1,
2081 Action (
2082 fun u ->
2083 let ondone s =
2084 try set (int_of_string s)
2085 with exn ->
2086 state.text <- Printf.sprintf "bad integer `%s': %s"
2087 s @@ exntos exn
2089 state.text <- E.s;
2090 let te = name ^ ": ", E.s, None, intentry, ondone, true in
2091 state.mode <- Textentry (te, leave m_prev_mode);
2093 )) :: m_l
2095 method int_with_suffix name get set =
2096 m_l <-
2097 (name, `intws get, 1,
2098 Action (
2099 fun u ->
2100 let ondone s =
2101 try set (int_of_string_with_suffix s)
2102 with exn ->
2103 state.text <- Printf.sprintf "bad integer `%s': %s"
2104 s @@ exntos exn
2106 state.text <- E.s;
2107 let te =
2108 name ^ ": ", E.s, None, intentry_with_suffix, ondone, true
2110 state.mode <- Textentry (te, leave m_prev_mode);
2112 )) :: m_l
2114 method bool ?(offset=1) ?(btos=btos) name get set =
2115 m_l <-
2116 (name, `bool (btos, get), offset, Action (
2117 fun u ->
2118 let v = get () in
2119 set (not v);
2121 )) :: m_l
2123 method color name get set =
2124 m_l <-
2125 (name, `color get, 1,
2126 Action (
2127 fun u ->
2128 let invalid = (nan, nan, nan) in
2129 let ondone s =
2130 let c =
2131 try color_of_string s
2132 with exn ->
2133 state.text <- Printf.sprintf "bad color `%s': %s"
2134 s @@ exntos exn;
2135 invalid
2137 if c <> invalid
2138 then set c;
2140 let te = name ^ ": ", E.s, None, textentry, ondone, true in
2141 state.text <- color_to_string (get ());
2142 state.mode <- Textentry (te, leave m_prev_mode);
2144 )) :: m_l
2146 method string name get set =
2147 m_l <-
2148 (name, `string get, 1,
2149 Action (
2150 fun u ->
2151 let ondone s = set s in
2152 let te = name ^ ": ", E.s, None, textentry, ondone, true in
2153 state.mode <- Textentry (te, leave m_prev_mode);
2155 )) :: m_l
2157 method colorspace name get set =
2158 m_l <-
2159 (name, `string get, 1,
2160 Action (
2161 fun _ ->
2162 let source =
2163 (object
2164 inherit lvsourcebase
2166 initializer
2167 m_active <- CSTE.to_int conf.colorspace;
2168 m_first <- 0;
2170 method getitemcount =
2171 Array.length CSTE.names
2172 method getitem n =
2173 (CSTE.names.(n), 0)
2174 method exit ~uioh ~cancel ~active ~first ~pan =
2175 ignore (uioh, first, pan);
2176 if not cancel then set active;
2177 None
2178 method hasaction _ = true
2179 end)
2181 state.text <- E.s;
2182 let modehash = findkeyhash conf "info" in
2183 coe (new listview ~zebra:false ~helpmode:false
2184 ~source ~trusted:true ~modehash)
2185 )) :: m_l
2187 method paxmark name get set =
2188 m_l <-
2189 (name, `string get, 1,
2190 Action (
2191 fun _ ->
2192 let source =
2193 (object
2194 inherit lvsourcebase
2196 initializer
2197 m_active <- MTE.to_int conf.paxmark;
2198 m_first <- 0;
2200 method getitemcount = Array.length MTE.names
2201 method getitem n = (MTE.names.(n), 0)
2202 method exit ~uioh ~cancel ~active ~first ~pan =
2203 ignore (uioh, first, pan);
2204 if not cancel then set active;
2205 None
2206 method hasaction _ = true
2207 end)
2209 state.text <- E.s;
2210 let modehash = findkeyhash conf "info" in
2211 coe (new listview ~zebra:false ~helpmode:false
2212 ~source ~trusted:true ~modehash)
2213 )) :: m_l
2215 method fitmodel name get set =
2216 m_l <-
2217 (name, `string get, 1,
2218 Action (
2219 fun _ ->
2220 let source =
2221 (object
2222 inherit lvsourcebase
2224 initializer
2225 m_active <- FMTE.to_int conf.fitmodel;
2226 m_first <- 0;
2228 method getitemcount = Array.length FMTE.names
2229 method getitem n = (FMTE.names.(n), 0)
2230 method exit ~uioh ~cancel ~active ~first ~pan =
2231 ignore (uioh, first, pan);
2232 if not cancel then set active;
2233 None
2234 method hasaction _ = true
2235 end)
2237 state.text <- E.s;
2238 let modehash = findkeyhash conf "info" in
2239 coe (new listview ~zebra:false ~helpmode:false
2240 ~source ~trusted:true ~modehash)
2241 )) :: m_l
2243 method caption s offset =
2244 m_l <- (s, `empty, offset, Noaction) :: m_l
2246 method caption2 s f offset =
2247 m_l <- (s, `string f, offset, Noaction) :: m_l
2249 method getitemcount = Array.length m_a
2251 method getitem n =
2252 let tostr = function
2253 | `int f -> string_of_int (f ())
2254 | `intws f -> string_with_suffix_of_int (f ())
2255 | `string f -> f ()
2256 | `color f -> color_to_string (f ())
2257 | `bool (btos, f) -> btos (f ())
2258 | `empty -> E.s
2260 let name, t, offset, _ = m_a.(n) in
2261 ((let s = tostr t in
2262 if nonemptystr s
2263 then Printf.sprintf "%s\t%s" name s
2264 else name),
2265 offset)
2267 method exit ~uioh ~cancel ~active ~first ~pan =
2268 let uiohopt =
2269 if not cancel
2270 then (
2271 let uioh =
2272 match m_a.(active) with
2273 | _, _, _, Action f -> f uioh
2274 | _, _, _, Noaction -> uioh
2276 Some uioh
2278 else None
2280 m_active <- active;
2281 m_first <- first;
2282 m_pan <- pan;
2283 uiohopt
2285 method hasaction n =
2286 match m_a.(n) with
2287 | _, _, _, Action _ -> true
2288 | _, _, _, Noaction -> false
2290 initializer m_active <- 1
2291 end)
2293 let rec fillsrc prevmode prevuioh =
2294 let sep () = src#caption E.s 0 in
2295 let colorp name get set =
2296 src#string name
2297 (fun () -> color_to_string (get ()))
2298 (fun v ->
2299 try set @@ color_of_string v
2300 with exn ->
2301 state.text <-
2302 Printf.sprintf "bad color `%s': %s" v @@ exntos exn
2305 let rgba name get set =
2306 src#string name
2307 (fun () -> get () |> rgba_to_string)
2308 (fun v ->
2309 try set @@ rgba_of_string v
2310 with exn ->
2311 state.text <-
2312 Printf.sprintf "bad color `%s': %s" v @@ exntos exn
2315 let oldmode = state.mode in
2316 let birdseye = isbirdseye state.mode in
2318 src#caption (if birdseye then "Setup (Bird's eye)" else "Setup") 0;
2320 src#bool "presentation mode"
2321 (fun () -> conf.presentation)
2322 (fun v -> setpresentationmode v);
2324 src#bool "ignore case in searches"
2325 (fun () -> conf.icase)
2326 (fun v -> conf.icase <- v);
2328 src#bool "preload"
2329 (fun () -> conf.preload)
2330 (fun v -> conf.preload <- v);
2332 src#bool "highlight links"
2333 (fun () -> conf.hlinks)
2334 (fun v -> conf.hlinks <- v);
2336 src#bool "under info"
2337 (fun () -> conf.underinfo)
2338 (fun v -> conf.underinfo <- v);
2340 src#fitmodel "fit model"
2341 (fun () -> FMTE.to_string conf.fitmodel)
2342 (fun v -> reqlayout conf.angle (FMTE.of_int v));
2344 src#bool "trim margins"
2345 (fun () -> conf.trimmargins)
2346 (fun v -> settrim v conf.trimfuzz; fillsrc prevmode prevuioh);
2348 sep ();
2349 src#int "inter-page space"
2350 (fun () -> conf.interpagespace)
2351 (fun n ->
2352 conf.interpagespace <- n;
2353 docolumns conf.columns;
2354 let pageno, py =
2355 match state.layout with
2356 | [] -> 0, 0
2357 | l :: _ -> l.pageno, l.pagey
2359 state.maxy <- calcheight ();
2360 let y = getpagey pageno in
2361 gotoxy state.x (y + py)
2364 src#int "page bias"
2365 (fun () -> conf.pagebias)
2366 (fun v -> conf.pagebias <- v);
2368 src#int "scroll step"
2369 (fun () -> conf.scrollstep)
2370 (fun n -> conf.scrollstep <- n);
2372 src#int "horizontal scroll step"
2373 (fun () -> conf.hscrollstep)
2374 (fun v -> conf.hscrollstep <- v);
2376 src#int "auto scroll step"
2377 (fun () ->
2378 match state.autoscroll with
2379 | Some step -> step
2380 | _ -> conf.autoscrollstep)
2381 (fun n ->
2382 let n = boundastep state.winh n in
2383 if state.autoscroll <> None
2384 then state.autoscroll <- Some n;
2385 conf.autoscrollstep <- n);
2387 src#int "zoom"
2388 (fun () -> truncate (conf.zoom *. 100.))
2389 (fun v -> pivotzoom ((float v) /. 100.));
2391 src#int "rotation"
2392 (fun () -> conf.angle)
2393 (fun v -> reqlayout v conf.fitmodel);
2395 src#int "scroll bar width"
2396 (fun () -> conf.scrollbw)
2397 (fun v ->
2398 conf.scrollbw <- v;
2399 reshape state.winw state.winh;
2402 src#int "scroll handle height"
2403 (fun () -> conf.scrollh)
2404 (fun v -> conf.scrollh <- v;);
2406 src#int "thumbnail width"
2407 (fun () -> conf.thumbw)
2408 (fun v ->
2409 conf.thumbw <- min 4096 v;
2410 match oldmode with
2411 | Birdseye beye ->
2412 leavebirdseye beye false;
2413 enterbirdseye ()
2414 | Textentry _
2415 | View
2416 | LinkNav _ -> ()
2419 let mode = state.mode in
2420 src#string "columns"
2421 (fun () ->
2422 match conf.columns with
2423 | Csingle _ -> "1"
2424 | Cmulti (multi, _) -> multicolumns_to_string multi
2425 | Csplit (count, _) -> "-" ^ string_of_int count
2427 (fun v ->
2428 let n, a, b = multicolumns_of_string v in
2429 setcolumns mode n a b);
2431 sep ();
2432 src#caption "Pixmap cache" 0;
2433 src#int_with_suffix "size (advisory)"
2434 (fun () -> conf.memlimit)
2435 (fun v -> conf.memlimit <- v);
2437 src#caption2 "used"
2438 (fun () ->
2439 Printf.sprintf "%s bytes, %d tiles"
2440 (string_with_suffix_of_int state.memused)
2441 (Hashtbl.length state.tilemap)) 1;
2443 sep ();
2444 src#caption "Layout" 0;
2445 src#caption2 "Dimension"
2446 (fun () -> Printf.sprintf "%dx%d (virtual %dx%d)"
2447 state.winw state.winh
2448 state.w state.maxy)
2450 if conf.debug
2451 then src#caption2 "Position" (fun () ->
2452 Printf.sprintf "%dx%d" state.x state.y
2454 else src#caption2 "Position" (fun () -> describe_layout state.layout) 1;
2456 sep ();
2457 src#bool ~offset:0 ~btos:(fun v -> if v then "(on)" else "(off)")
2458 "Save these parameters as global defaults at exit"
2459 (fun () -> conf.bedefault)
2460 (fun v -> conf.bedefault <- v);
2462 sep ();
2463 let btos b = Utf8syms.(if b then lguillemet else rguillemet) in
2464 src#bool ~offset:0 ~btos "Extended parameters"
2465 (fun () -> !showextended)
2466 (fun v -> showextended := v; fillsrc prevmode prevuioh);
2467 if !showextended
2468 then (
2469 src#bool "checkers"
2470 (fun () -> conf.checkers)
2471 (fun v -> conf.checkers <- v; setcheckers v);
2472 src#bool "update cursor"
2473 (fun () -> conf.updatecurs)
2474 (fun v -> conf.updatecurs <- v);
2475 src#bool "scroll-bar on the left"
2476 (fun () -> conf.leftscroll)
2477 (fun v -> conf.leftscroll <- v);
2478 src#bool "verbose"
2479 (fun () -> conf.verbose)
2480 (fun v -> conf.verbose <- v);
2481 src#bool "invert colors"
2482 (fun () -> conf.invert)
2483 (fun v -> conf.invert <- v);
2484 src#bool "max fit"
2485 (fun () -> conf.maxhfit)
2486 (fun v -> conf.maxhfit <- v);
2487 src#bool "pax mode"
2488 (fun () -> conf.pax != None)
2489 (fun v ->
2490 if v
2491 then conf.pax <- Some (now ())
2492 else conf.pax <- None);
2493 src#string "uri launcher"
2494 (fun () -> conf.urilauncher)
2495 (fun v -> conf.urilauncher <- v);
2496 src#string "path launcher"
2497 (fun () -> conf.pathlauncher)
2498 (fun v -> conf.pathlauncher <- v);
2499 src#string "tile size"
2500 (fun () -> Printf.sprintf "%dx%d" conf.tilew conf.tileh)
2501 (fun v ->
2503 let w, h = Scanf.sscanf v "%dx%d" (fun w h -> w, h) in
2504 conf.tilew <- max 64 w;
2505 conf.tileh <- max 64 h;
2506 flushtiles ();
2507 with exn ->
2508 state.text <- Printf.sprintf "bad tile size `%s': %s"
2509 v @@ exntos exn
2511 src#int "texture count"
2512 (fun () -> conf.texcount)
2513 (fun v ->
2514 if Ffi.realloctexts v
2515 then conf.texcount <- v
2516 else impmsg "failed to set texture count please retry later"
2518 src#int "slice height"
2519 (fun () -> conf.sliceheight)
2520 (fun v ->
2521 conf.sliceheight <- v;
2522 wcmd "sliceh %d" conf.sliceheight;
2524 src#int "anti-aliasing level"
2525 (fun () -> conf.aalevel)
2526 (fun v ->
2527 conf.aalevel <- bound v 0 8;
2528 state.anchor <- getanchor ();
2529 opendoc state.path state.password;
2531 src#string "page scroll scaling factor"
2532 (fun () -> string_of_float conf.pgscale)
2533 (fun v ->
2534 try conf.pgscale <- float_of_string v
2535 with exn ->
2536 state.text <-
2537 Printf.sprintf "bad page scroll scaling factor `%s': %s" v
2538 @@ exntos exn
2540 src#int "ui font size"
2541 (fun () -> fstate.fontsize)
2542 (fun v -> setfontsize (bound v 5 100));
2543 src#int "hint font size"
2544 (fun () -> conf.hfsize)
2545 (fun v -> conf.hfsize <- bound v 5 100);
2546 src#string "trim fuzz"
2547 (fun () -> irect_to_string conf.trimfuzz)
2548 (fun v ->
2550 conf.trimfuzz <- irect_of_string v;
2551 if conf.trimmargins
2552 then settrim true conf.trimfuzz;
2553 with exn ->
2554 state.text <- Printf.sprintf "bad irect `%s': %s" v
2555 @@ exntos exn
2557 src#string "selection command"
2558 (fun () -> conf.selcmd)
2559 (fun v -> conf.selcmd <- v);
2560 src#string "synctex command"
2561 (fun () -> conf.stcmd)
2562 (fun v -> conf.stcmd <- v);
2563 src#string "pax command"
2564 (fun () -> conf.paxcmd)
2565 (fun v -> conf.paxcmd <- v);
2566 src#string "ask password command"
2567 (fun () -> conf.passcmd)
2568 (fun v -> conf.passcmd <- v);
2569 src#string "save path command"
2570 (fun () -> conf.savecmd)
2571 (fun v -> conf.savecmd <- v);
2572 src#colorspace "color space"
2573 (fun () -> CSTE.to_string conf.colorspace)
2574 (fun v ->
2575 conf.colorspace <- CSTE.of_int v;
2576 wcmd "cs %d" v;
2577 load state.layout;
2579 src#paxmark "pax mark method"
2580 (fun () -> MTE.to_string conf.paxmark)
2581 (fun v -> conf.paxmark <- MTE.of_int v);
2582 if Ffi.bousable ()
2583 then
2584 src#bool "use PBO"
2585 (fun () -> conf.usepbo)
2586 (fun v -> conf.usepbo <- v);
2587 src#bool "mouse wheel scrolls pages"
2588 (fun () -> conf.wheelbypage)
2589 (fun v -> conf.wheelbypage <- v);
2590 src#bool "open remote links in a new instance"
2591 (fun () -> conf.riani)
2592 (fun v -> conf.riani <- v);
2593 src#bool "edit annotations inline"
2594 (fun () -> conf.annotinline)
2595 (fun v -> conf.annotinline <- v);
2596 src#bool "coarse positioning in presentation mode"
2597 (fun () -> conf.coarseprespos)
2598 (fun v -> conf.coarseprespos <- v);
2599 src#bool "use document CSS"
2600 (fun () -> conf.usedoccss)
2601 (fun v ->
2602 conf.usedoccss <- v;
2603 state.anchor <- getanchor ();
2604 opendoc state.path state.password;
2606 src#bool ~btos "colors"
2607 (fun () -> !showcolors)
2608 (fun v -> showcolors := v; fillsrc prevmode prevuioh);
2609 if !showcolors
2610 then (
2611 colorp " background"
2612 (fun () -> conf.bgcolor)
2613 (fun v -> conf.bgcolor <- v);
2615 rgba " paper color"
2616 (fun () -> conf.papercolor)
2617 (fun v ->
2618 conf.papercolor <- v;
2619 Ffi.setpapercolor conf.papercolor;
2620 flushtiles ();
2622 rgba " scrollbar"
2623 (fun () -> conf.sbarcolor)
2624 (fun v -> conf.sbarcolor <- v);
2625 rgba " scrollbar handle"
2626 (fun () -> conf.sbarhndlcolor)
2627 (fun v -> conf.sbarhndlcolor <- v);
2628 rgba " texture color"
2629 (fun () -> conf.texturecolor)
2630 (fun v ->
2631 GlTex.env (`color v);
2632 conf.texturecolor <- v;
2637 sep ();
2638 src#caption "Document" 0;
2639 List.iter (fun (_, s) -> src#caption s 1) state.docinfo;
2640 src#caption2 "Pages" (fun () -> string_of_int state.pagecount) 1;
2641 src#caption2 "Dimensions"
2642 (fun () -> string_of_int (List.length state.pdims)) 1;
2643 if nonemptystr conf.css
2644 then src#caption2 "CSS" (fun () -> conf.css) 1;
2645 if conf.trimmargins
2646 then (
2647 sep ();
2648 src#caption "Trimmed margins" 0;
2649 src#caption2 "Dimensions"
2650 (fun () -> string_of_int (List.length state.pdims)) 1;
2653 sep ();
2654 src#caption "OpenGL" 0;
2655 src#caption (Printf.sprintf "Vendor\t%s" (GlMisc.get_string `vendor)) 1;
2656 src#caption (Printf.sprintf "Renderer\t%s" (GlMisc.get_string `renderer)) 1;
2658 sep ();
2659 src#caption "Location" 0;
2660 if nonemptystr state.origin
2661 then src#caption ("Orign\t" ^ mbtoutf8 state.origin) 1;
2662 src#caption ("Path\t" ^ mbtoutf8 state.path) 1;
2664 src#reset prevmode prevuioh;
2666 fun () -> (
2667 state.text <- E.s;
2668 resetmstate ();
2669 let prevmode = state.mode
2670 and prevuioh = state.uioh in
2671 fillsrc prevmode prevuioh;
2672 let source = (src :> lvsource) in
2673 let modehash = findkeyhash conf "info" in
2674 state.uioh <-
2675 coe (object (self)
2676 inherit listview ~zebra:false ~helpmode:false
2677 ~source ~trusted:true ~modehash as super
2678 val mutable m_prevmemused = 0
2679 method! infochanged = function
2680 | Memused ->
2681 if m_prevmemused != state.memused
2682 then (
2683 m_prevmemused <- state.memused;
2684 postRedisplay "memusedchanged";
2686 | Pdim -> postRedisplay "pdimchanged"
2687 | Docinfo -> fillsrc prevmode prevuioh
2689 method! key key mask =
2690 if not (Wsi.withctrl mask)
2691 then
2692 match [@warning "-4"] Wsi.kc2kt key with
2693 | Keys.Left -> coe (self#updownlevel ~-1)
2694 | Keys.Right -> coe (self#updownlevel 1)
2695 | _ -> super#key key mask
2696 else super#key key mask
2697 end);
2698 postRedisplay "info";
2702 let enterhelpmode =
2703 let source =
2704 (object
2705 inherit lvsourcebase
2706 method getitemcount = Array.length state.help
2707 method getitem n =
2708 let s, l, _ = state.help.(n) in
2709 (s, l)
2711 method exit ~uioh ~cancel ~active ~first ~pan =
2712 let optuioh =
2713 if not cancel
2714 then (
2715 match state.help.(active) with
2716 | _, _, Action f -> Some (f uioh)
2717 | _, _, Noaction -> Some uioh
2719 else None
2721 m_active <- active;
2722 m_first <- first;
2723 m_pan <- pan;
2724 optuioh
2726 method hasaction n =
2727 match state.help.(n) with
2728 | _, _, Action _ -> true
2729 | _, _, Noaction -> false
2731 initializer
2732 m_active <- -1
2733 end)
2735 fun () ->
2736 let modehash = findkeyhash conf "help" in
2737 resetmstate ();
2738 state.uioh <- coe (new listview
2739 ~zebra:false ~helpmode:true
2740 ~source ~trusted:true ~modehash);
2741 postRedisplay "help";
2744 let entermsgsmode =
2745 let msgsource =
2746 (object
2747 inherit lvsourcebase
2748 val mutable m_items = E.a
2750 method getitemcount = 1 + Array.length m_items
2752 method getitem n =
2753 if n = 0
2754 then "[Clear]", 0
2755 else m_items.(n-1), 0
2757 method exit ~uioh ~cancel ~active ~first ~pan =
2758 ignore uioh;
2759 if not cancel
2760 then (
2761 if active = 0
2762 then Buffer.clear state.errmsgs;
2764 m_active <- active;
2765 m_first <- first;
2766 m_pan <- pan;
2767 None
2769 method hasaction n =
2770 n = 0
2772 method reset =
2773 state.newerrmsgs <- false;
2774 let l = Str.split Utils.Re.crlf (Buffer.contents state.errmsgs) in
2775 m_items <- Array.of_list l
2777 initializer
2778 m_active <- 0
2779 end)
2780 in fun () ->
2781 state.text <- E.s;
2782 resetmstate ();
2783 msgsource#reset;
2784 let source = (msgsource :> lvsource) in
2785 let modehash = findkeyhash conf "listview" in
2786 state.uioh <-
2787 coe (object
2788 inherit listview ~zebra:false ~helpmode:false
2789 ~source ~trusted:false ~modehash as super
2790 method! display =
2791 if state.newerrmsgs
2792 then msgsource#reset;
2793 super#display
2794 end);
2795 postRedisplay "msgs";
2798 let getusertext s =
2799 let editor = getenvdef "EDITOR" E.s in
2800 if emptystr editor
2801 then E.s
2802 else
2803 let tmppath = Filename.temp_file "llpp" "note" in
2804 if nonemptystr s
2805 then (
2806 let oc = open_out tmppath in
2807 output_string oc s;
2808 close_out oc;
2810 let execstr = editor ^ " " ^ tmppath in
2811 let s =
2812 match spawn execstr [] with
2813 | exception exn ->
2814 impmsg "spawn(%S) failed: %s" execstr @@ exntos exn;
2816 | pid ->
2817 match Unix.waitpid [] pid with
2818 | exception exn ->
2819 impmsg "waitpid(%d) failed: %s" pid @@ exntos exn;
2821 | (_pid, status) ->
2822 match status with
2823 | Unix.WEXITED 0 -> filecontents tmppath
2824 | Unix.WEXITED n ->
2825 impmsg "editor process(%s) exited abnormally: %d" execstr n;
2827 | Unix.WSIGNALED n ->
2828 impmsg "editor process(%s) was killed by signal %d" execstr n;
2830 | Unix.WSTOPPED n ->
2831 impmsg "editor(%s) process was stopped by signal %d" execstr n;
2834 match Unix.unlink tmppath with
2835 | exception exn ->
2836 impmsg "failed to ulink %S: %s" tmppath @@ exntos exn;
2838 | () -> s
2841 let enterannotmode opaque slinkindex =
2842 let msgsource =
2843 (object
2844 inherit lvsourcebase
2845 val mutable m_text = E.s
2846 val mutable m_items = E.a
2848 method getitemcount = Array.length m_items
2850 method getitem n =
2851 let label, _func = m_items.(n) in
2852 label, 0
2854 method exit ~uioh ~cancel ~active ~first ~pan =
2855 ignore (uioh, first, pan);
2856 if not cancel
2857 then (
2858 let _label, func = m_items.(active) in
2859 func ()
2861 None
2863 method hasaction n = nonemptystr @@ fst m_items.(n)
2865 method reset s =
2866 let rec split accu b i =
2867 let p = b+i in
2868 if p = String.length s
2869 then (String.sub s b (p-b), fun () -> ()) :: accu
2870 else
2871 if (i > 70 && s.[p] = ' ') || s.[p] = '\r' || s.[p] = '\n'
2872 then
2873 let ss = if i = 0 then E.s else String.sub s b i in
2874 split ((ss, fun () -> ())::accu) (p+1) 0
2875 else split accu b (i+1)
2877 let cleanup () =
2878 wcmd "freepage %s" (~> opaque);
2879 let keys =
2880 Hashtbl.fold (fun key opaque' accu ->
2881 if opaque' = opaque'
2882 then key :: accu else accu) state.pagemap []
2884 List.iter (Hashtbl.remove state.pagemap) keys;
2885 flushtiles ();
2886 gotoxy state.x state.y
2888 let dele () =
2889 Ffi.delannot opaque slinkindex;
2890 cleanup ();
2892 let edit inline () =
2893 let update s =
2894 if emptystr s
2895 then dele ()
2896 else (
2897 Ffi.modannot opaque slinkindex s;
2898 cleanup ();
2901 if inline
2902 then
2903 let mode = state.mode in
2904 state.mode <-
2905 Textentry (
2906 ("annotation: ", m_text, None, textentry, update, true),
2907 fun _ -> state.mode <- mode
2909 state.text <- E.s;
2910 enttext ();
2911 else
2912 let s = getusertext m_text in
2913 update s
2915 m_text <- s;
2916 m_items <-
2917 ( "[Copy]", fun () -> selstring conf.selcmd m_text)
2918 :: ("[Delete]", dele)
2919 :: ("[Edit]", edit conf.annotinline)
2920 :: (E.s, fun () -> ())
2921 :: split [] 0 0 |> List.rev |> Array.of_list
2923 initializer
2924 m_active <- 0
2925 end)
2927 state.text <- E.s;
2928 let s = Ffi.getannotcontents opaque slinkindex in
2929 resetmstate ();
2930 msgsource#reset s;
2931 let source = (msgsource :> lvsource) in
2932 let modehash = findkeyhash conf "listview" in
2933 state.uioh <- coe (object
2934 inherit listview ~zebra:false ~helpmode:false
2935 ~source ~trusted:false ~modehash
2936 end);
2937 postRedisplay "enterannotmode";
2940 let gotoremote spec =
2941 let filename, dest = splitatchar spec '#' in
2942 let getpath filename =
2943 let path =
2944 if nonemptystr filename
2945 then
2946 if Filename.is_relative filename
2947 then
2948 let dir = Filename.dirname state.path in
2949 let dir =
2950 if Filename.is_implicit dir
2951 then Filename.concat (Sys.getcwd ()) dir
2952 else dir
2954 Filename.concat dir filename
2955 else filename
2956 else E.s
2958 if Sys.file_exists path
2959 then path
2960 else E.s
2962 let path = getpath filename in
2963 let dospawn lcmd =
2964 if conf.riani
2965 then
2966 let cmd = Lazy.force_val lcmd in
2967 match spawn cmd with
2968 | _pid -> ()
2969 | exception exn -> dolog "failed to execute `%s': %s" cmd @@ exntos exn
2970 else
2971 let anchor = getanchor () in
2972 let ranchor = state.path, state.password, anchor, state.origin in
2973 state.origin <- E.s;
2974 state.ranchors <- ranchor :: state.ranchors;
2975 opendoc path E.s;
2977 if substratis spec 0 "page="
2978 then
2979 match Scanf.sscanf spec "page=%d" (fun n -> n) with
2980 | pageno ->
2981 state.anchor <- (pageno, 0.0, 0.0);
2982 dospawn @@ lazy (Printf.sprintf "%s -page %d %S" !selfexec pageno path);
2983 | exception exn ->
2984 adderrfmt "error parsing remote destination" "page: %s" @@ exntos exn
2985 else (
2986 state.nameddest <- dest;
2987 dospawn @@ lazy (!selfexec ^ " " ^ path ^ " -dest " ^ dest)
2991 let gotounder = function
2992 | Ulinkuri s when Ffi.isexternallink s ->
2993 if substratis s 0 "file://"
2994 then gotoremote @@ String.sub s 7 (String.length s - 7)
2995 else Help.gotouri conf.urilauncher s
2996 | Ulinkuri s ->
2997 let pageno, x, y = Ffi.uritolocation s in
2998 addnav ();
2999 gotopagexy pageno x y
3000 | Utext _ | Unone -> ()
3001 | Uannotation (opaque, slinkindex) -> enterannotmode opaque slinkindex
3004 let gotooutline (_, _, kind) =
3005 match kind with
3006 | Onone -> ()
3007 | Oanchor ((pageno, y, _) as anchor) ->
3008 addnav ();
3009 gotoxy state.x @@
3010 getanchory (if conf.presentation then (pageno, y, 1.0) else anchor)
3011 | Ouri uri -> gotounder (Ulinkuri uri)
3012 | Olaunch cmd -> error "gotounder (Ulaunch %S)" cmd
3013 | Oremote (remote, pageno) ->
3014 error "gotounder (Uremote (%S,%d) )" remote pageno
3015 | Ohistory hist -> gotohist hist
3016 | Oremotedest (path, dest) ->
3017 error "gotounder (Uremotedest (%S, %S))" path dest
3020 class outlinesoucebase fetchoutlines = object (self)
3021 inherit lvsourcebase
3022 val mutable m_items = E.a
3023 val mutable m_minfo = E.a
3024 val mutable m_orig_items = E.a
3025 val mutable m_orig_minfo = E.a
3026 val mutable m_narrow_patterns = []
3027 val mutable m_gen = -1
3029 method getitemcount = Array.length m_items
3031 method getitem n =
3032 let s, n, _ = m_items.(n) in
3033 (s, n+0)
3035 method exit ~(uioh:uioh) ~cancel ~active ~(first:int) ~pan : uioh option =
3036 ignore (uioh, first);
3037 let items, minfo =
3038 if m_narrow_patterns = []
3039 then m_orig_items, m_orig_minfo
3040 else m_items, m_minfo
3042 m_pan <- pan;
3043 if not cancel
3044 then (
3045 m_items <- items;
3046 m_minfo <- minfo;
3047 gotooutline m_items.(active);
3049 else (
3050 m_items <- items;
3051 m_minfo <- minfo;
3053 None
3055 method hasaction (_:int) = true
3057 method greetmsg =
3058 if Array.length m_items != Array.length m_orig_items
3059 then
3060 let s =
3061 match m_narrow_patterns with
3062 | one :: [] -> one
3063 | many -> String.concat Utf8syms.ellipsis (List.rev many)
3065 "Narrowed to " ^ s ^ " (ctrl-u to restore)"
3066 else E.s
3068 method statestr =
3069 match m_narrow_patterns with
3070 | [] -> E.s
3071 | one :: [] -> one
3072 | head :: _ -> Utf8syms.ellipsis ^ head
3074 method narrow pattern =
3075 match Str.regexp_case_fold pattern with
3076 | exception _ -> ()
3077 | re ->
3078 let rec loop accu minfo n =
3079 if n = -1
3080 then (
3081 m_items <- Array.of_list accu;
3082 m_minfo <- Array.of_list minfo;
3084 else
3085 let (s, _, _) as o = m_items.(n) in
3086 let accu, minfo =
3087 match Str.search_forward re s 0 with
3088 | exception Not_found -> accu, minfo
3089 | first -> o :: accu, (first, Str.match_end ()) :: minfo
3091 loop accu minfo (n-1)
3093 loop [] [] (Array.length m_items - 1)
3095 method! getminfo = m_minfo
3097 method denarrow =
3098 m_orig_items <- fetchoutlines ();
3099 m_minfo <- m_orig_minfo;
3100 m_items <- m_orig_items
3102 method add_narrow_pattern pattern =
3103 m_narrow_patterns <- pattern :: m_narrow_patterns
3105 method del_narrow_pattern =
3106 match m_narrow_patterns with
3107 | _ :: rest -> m_narrow_patterns <- rest
3108 | [] -> ()
3110 method renarrow =
3111 self#denarrow;
3112 match m_narrow_patterns with
3113 | pattern :: [] -> self#narrow pattern; pattern
3114 | list ->
3115 List.fold_left (fun accu pattern ->
3116 self#narrow pattern;
3117 pattern ^ Utf8syms.ellipsis ^ accu) E.s list
3119 method calcactive (_:anchor) = 0
3121 method reset anchor items =
3122 if state.gen != m_gen
3123 then (
3124 m_orig_items <- items;
3125 m_items <- items;
3126 m_narrow_patterns <- [];
3127 m_minfo <- E.a;
3128 m_orig_minfo <- E.a;
3129 m_gen <- state.gen;
3131 else (
3132 if items != m_orig_items
3133 then (
3134 m_orig_items <- items;
3135 if m_narrow_patterns == []
3136 then m_items <- items;
3139 let active = self#calcactive anchor in
3140 m_active <- active;
3141 m_first <- firstof m_first active
3145 let outlinesource fetchoutlines =
3146 (object
3147 inherit outlinesoucebase fetchoutlines
3148 method! calcactive anchor =
3149 let rely = getanchory anchor in
3150 let rec loop n best bestd =
3151 if n = Array.length m_items
3152 then best
3153 else
3154 let _, _, kind = m_items.(n) in
3155 match kind with
3156 | Oanchor anchor ->
3157 let orely = getanchory anchor in
3158 let d = abs (orely - rely) in
3159 if d < bestd
3160 then loop (n+1) n d
3161 else loop (n+1) best bestd
3162 | Onone | Oremote _ | Olaunch _
3163 | Oremotedest _ | Ouri _ | Ohistory _ ->
3164 loop (n+1) best bestd
3166 loop 0 ~-1 max_int
3167 end)
3170 let enteroutlinemode, enterbookmarkmode, enterhistmode =
3171 let fetchoutlines sourcetype () =
3172 match sourcetype with
3173 | `bookmarks -> Array.of_list state.bookmarks
3174 | `outlines -> state.outlines
3175 | `history -> genhistoutlines () |> Array.of_list
3177 let so = outlinesource (fetchoutlines `outlines) in
3178 let sb = outlinesource (fetchoutlines `bookmarks) in
3179 let sh = outlinesource (fetchoutlines `history) in
3180 let mkselector sourcetype source =
3181 (fun errmsg ->
3182 let outlines = fetchoutlines sourcetype () in
3183 if Array.length outlines = 0
3184 then showtext ' ' errmsg
3185 else (
3186 resetmstate ();
3187 Wsi.setcursor Wsi.CURSOR_INHERIT;
3188 let anchor = getanchor () in
3189 source#reset anchor outlines;
3190 state.text <- source#greetmsg;
3191 state.uioh <-
3192 coe (new outlinelistview ~zebra:(sourcetype=`history) ~source);
3193 postRedisplay "enter selector";
3197 let mkenter sourcetype errmsg s = fun () -> mkselector sourcetype s errmsg in
3198 ( mkenter `outlines "document has no outline" so
3199 , mkenter `bookmarks "document has no bookmarks (yet)" sb
3200 , mkenter `history "history is empty" sh )
3203 let quickbookmark ?title () =
3204 match state.layout with
3205 | [] -> ()
3206 | l :: _ ->
3207 let title =
3208 match title with
3209 | None ->
3210 Unix.(
3211 let tm = localtime (now ()) in
3212 Printf.sprintf
3213 "Quick (page %d) (bookmarked on %02d/%02d/%d at %02d:%02d)"
3214 (l.pageno+1)
3215 tm.tm_mday (tm.tm_mon+1) (tm.tm_year+1900) tm.tm_hour tm.tm_min
3217 | Some title -> title
3219 state.bookmarks <- (title, 0, Oanchor (getanchor1 l)) :: state.bookmarks
3222 let setautoscrollspeed step goingdown =
3223 let incr = max 1 ((abs step) / 2) in
3224 let incr = if goingdown then incr else -incr in
3225 let astep = boundastep state.winh (step + incr) in
3226 state.autoscroll <- Some astep;
3229 let canpan () =
3230 match conf.columns with
3231 | Csplit _ -> true
3232 | Csingle _ | Cmulti _ -> state.x != 0 || conf.zoom > 1.0
3235 let panbound x = bound x (-state.w) state.winw;;
3237 let existsinrow pageno (columns, coverA, coverB) p =
3238 let last = ((pageno - coverA) mod columns) + columns in
3239 let rec any = function
3240 | [] -> false
3241 | l :: rest ->
3242 if l.pageno = coverA - 1 || l.pageno = state.pagecount - coverB
3243 then p l
3244 else (
3245 if not (p l)
3246 then (if l.pageno = last then false else any rest)
3247 else true
3250 any state.layout
3253 let nextpage () =
3254 match state.layout with
3255 | [] ->
3256 let pageno = page_of_y state.y in
3257 gotoxy state.x (getpagey (pageno+1))
3258 | l :: rest ->
3259 match conf.columns with
3260 | Csingle _ ->
3261 if conf.presentation && rest == [] && l.pageh > l.pagey + l.pagevh
3262 then
3263 let y = clamp (pgscale state.winh) in
3264 gotoxy state.x y
3265 else
3266 let pageno = min (l.pageno+1) (state.pagecount-1) in
3267 gotoxy state.x (getpagey pageno)
3268 | Cmulti ((c, _, _) as cl, _) ->
3269 if conf.presentation
3270 && (existsinrow l.pageno cl
3271 (fun l -> l.pageh > l.pagey + l.pagevh))
3272 then
3273 let y = clamp (pgscale state.winh) in
3274 gotoxy state.x y
3275 else
3276 let pageno = min (l.pageno+c) (state.pagecount-1) in
3277 gotoxy state.x (getpagey pageno)
3278 | Csplit (n, _) ->
3279 if l.pageno < state.pagecount - 1 || l.pagecol < n - 1
3280 then
3281 let pagey, pageh = getpageyh l.pageno in
3282 let pagey = pagey + pageh * l.pagecol in
3283 let ips = if l.pagecol = 0 then 0 else conf.interpagespace in
3284 gotoxy state.x (pagey + pageh + ips)
3287 let prevpage () =
3288 match state.layout with
3289 | [] ->
3290 let pageno = page_of_y state.y in
3291 gotoxy state.x (getpagey (pageno-1))
3292 | l :: _ ->
3293 match conf.columns with
3294 | Csingle _ ->
3295 if conf.presentation && l.pagey != 0
3296 then gotoxy state.x (clamp (pgscale ~-(state.winh)))
3297 else
3298 let pageno = max 0 (l.pageno-1) in
3299 gotoxy state.x (getpagey pageno)
3300 | Cmulti ((c, _, coverB) as cl, _) ->
3301 if conf.presentation &&
3302 (existsinrow l.pageno cl (fun l -> l.pagey != 0))
3303 then gotoxy state.x (clamp (pgscale ~-(state.winh)))
3304 else
3305 let decr =
3306 if l.pageno = state.pagecount - coverB
3307 then 1
3308 else c
3310 let pageno = max 0 (l.pageno-decr) in
3311 gotoxy state.x (getpagey pageno)
3312 | Csplit (n, _) ->
3313 let y =
3314 if l.pagecol = 0
3315 then
3316 if l.pageno = 0
3317 then l.pagey
3318 else
3319 let pageno = max 0 (l.pageno-1) in
3320 let pagey, pageh = getpageyh pageno in
3321 pagey + (n-1)*pageh
3322 else
3323 let pagey, pageh = getpageyh l.pageno in
3324 pagey + pageh * (l.pagecol-1) - conf.interpagespace
3326 gotoxy state.x y
3329 let save () =
3330 if emptystr conf.savecmd
3331 then adderrmsg "savepath-command is empty"
3332 "don't know where to save modified document"
3333 else
3334 let savecmd = Str.global_replace Utils.Re.percent state.path conf.savecmd in
3335 let path =
3336 getcmdoutput
3337 (fun exn ->
3338 adderrfmt savecmd "failed to produce path to the saved copy: %s" exn)
3339 savecmd
3341 if nonemptystr path
3342 then
3343 let tmp = path ^ ".tmp" in
3344 Ffi.savedoc tmp;
3345 Unix.rename tmp path;
3348 let viewkeyboard key mask =
3349 let enttext te =
3350 let mode = state.mode in
3351 state.mode <- Textentry (te, fun _ -> state.mode <- mode);
3352 state.text <- E.s;
3353 enttext ();
3354 postRedisplay "view:enttext"
3356 let ctrl = Wsi.withctrl mask in
3357 let open Keys in
3358 match Wsi.kc2kt key with
3359 | Ascii 'S' -> state.slideshow <- state.slideshow lxor 1
3361 | Ascii 'Q' -> exit 0
3363 | Ascii 'z' ->
3364 let yloc f =
3365 match List.rev state.rects with
3366 | [] -> ()
3367 | (pageno, _, (_, y0, _, y1, _, y2, _, y3)) :: _ ->
3368 f pageno (y0, y1, y2, y3)
3369 and yminmax (y0, y1, y2, y3) =
3370 let ym = min y0 y1 |> min y2 |> min y3 |> truncate in
3371 let yM = max y0 y1 |> max y2 |> max y3 |> truncate in
3372 ym, yM
3374 let ondone msg = state.text <- msg
3375 and zmod _ _ k =
3376 match [@warning "-4"] k with
3377 | Keys.Ascii 'z' ->
3378 let f pageno ys =
3379 let ym, yM = yminmax ys in
3380 let hh = (yM - ym)/2 in
3381 gotopage1 pageno (ym + hh - state.winh/2)
3383 yloc f;
3384 TEdone "center"
3385 | Keys.Ascii 't' ->
3386 let f pageno ys =
3387 let ym, _ = yminmax ys in
3388 gotopage1 pageno ym
3390 yloc f;
3391 TEdone "top"
3392 | Keys.Ascii 'b' ->
3393 let f pageno ys =
3394 let _, yM = yminmax ys in
3395 gotopage1 pageno (yM - state.winh)
3397 yloc f;
3398 TEdone "bottom"
3399 | _ -> TEstop
3401 enttext (": ", E.s, None, zmod state.mode, ondone, true)
3403 | Ascii 'W' ->
3404 if Ffi.hasunsavedchanges ()
3405 then save ()
3407 | Insert ->
3408 if conf.angle mod 360 = 0 && not (isbirdseye state.mode)
3409 then (
3410 state.mode <- (
3411 match state.lnava with
3412 | None -> LinkNav (Ltgendir 0)
3413 | Some pn -> LinkNav (Ltexact pn)
3415 gotoxy state.x state.y;
3417 else impmsg "keyboard link navigation does not work under rotation"
3419 | Escape | Ascii 'q' ->
3420 begin match state.mstate with
3421 | Mzoomrect _ ->
3422 resetmstate ();
3423 postRedisplay "kill rect";
3424 | Msel _
3425 | Mpan _
3426 | Mscrolly | Mscrollx
3427 | Mzoom _
3428 | Mnone ->
3429 begin match state.mode with
3430 | LinkNav ln ->
3431 begin match ln with
3432 | Ltexact pl -> state.lnava <- Some pl
3433 | Ltgendir _ | Ltnotready _ -> state.lnava <- None
3434 end;
3435 state.mode <- View;
3436 postRedisplay "esc leave linknav"
3437 | Birdseye _ | Textentry _ | View ->
3438 match state.ranchors with
3439 | [] -> raise Quit
3440 | (path, password, anchor, origin) :: rest ->
3441 state.ranchors <- rest;
3442 state.anchor <- anchor;
3443 state.origin <- origin;
3444 state.nameddest <- E.s;
3445 opendoc path password
3446 end;
3447 end;
3449 | Backspace ->
3450 addnavnorc ();
3451 gotoxy state.x (getnav ~-1)
3453 | Ascii 'o' -> enteroutlinemode ()
3454 | Ascii 'H' -> enterhistmode ()
3456 | Ascii 'u' ->
3457 state.rects <- [];
3458 state.text <- E.s;
3459 Hashtbl.iter (fun _ opaque ->
3460 Ffi.clearmark opaque;
3461 Hashtbl.clear state.prects) state.pagemap;
3462 postRedisplay "dehighlight";
3464 | Ascii (('/' | '?') as c) ->
3465 let ondone isforw s =
3466 cbput state.hists.pat s;
3467 state.searchpattern <- s;
3468 search s isforw
3470 let s = String.make 1 c in
3471 enttext (s, E.s, Some (onhist state.hists.pat),
3472 textentry, ondone (c = '/'), true)
3474 | Ascii '+' | Ascii '=' when ctrl ->
3475 let incr = if conf.zoom +. 0.01 > 0.1 then 0.1 else 0.01 in
3476 pivotzoom (conf.zoom +. incr)
3478 | Ascii '+' ->
3479 let ondone s =
3480 let n =
3481 try int_of_string s with exn ->
3482 state.text <-
3483 Printf.sprintf "bad integer `%s': %s" s @@ exntos exn;
3484 max_int
3486 if n != max_int
3487 then (
3488 conf.pagebias <- n;
3489 state.text <- "page bias is now " ^ string_of_int n;
3492 enttext ("page bias: ", E.s, None, intentry, ondone, true)
3494 | Ascii '-' when ctrl ->
3495 let decr = if conf.zoom -. 0.1 < 0.1 then 0.01 else 0.1 in
3496 pivotzoom (max 0.01 (conf.zoom -. decr))
3498 | Ascii '-' ->
3499 let ondone msg = state.text <- msg in
3500 enttext ("option: ", E.s, None,
3501 optentry state.mode, ondone, true)
3503 | Ascii '0' when ctrl ->
3504 if conf.zoom = 1.0
3505 then gotoxy 0 state.y
3506 else setzoom 1.0
3508 | Ascii ('1'|'2' as c) when ctrl && conf.fitmodel != FitPage ->
3509 let cols =
3510 match conf.columns with
3511 | Csingle _ | Cmulti _ -> 1
3512 | Csplit (n, _) -> n
3514 let h = state.winh -
3515 conf.interpagespace lsl (if conf.presentation then 1 else 0)
3517 let zoom = Ffi.zoomforh state.winw h 0 cols in
3518 if zoom > 0.0 && (c = '2' || zoom < 1.0)
3519 then setzoom zoom
3521 | Ascii '3' when ctrl ->
3522 let fm =
3523 match conf.fitmodel with
3524 | FitWidth -> FitProportional
3525 | FitProportional -> FitPage
3526 | FitPage -> FitWidth
3528 state.text <- "fit model: " ^ FMTE.to_string fm;
3529 reqlayout conf.angle fm
3531 | Ascii '4' when ctrl ->
3532 let zoom = Ffi.getmaxw () /. float state.winw in
3533 if zoom > 0.0 then setzoom zoom
3535 | Fn 9 | Ascii '9' when ctrl -> togglebirdseye ()
3537 | Ascii ('0'..'9' as c) when not ctrl ->
3538 let ondone s =
3539 let n =
3540 try int_of_string s with exn ->
3541 state.text <- Printf.sprintf "bad integer `%s': %s" s @@ exntos exn;
3544 if n >= 0
3545 then (
3546 addnav ();
3547 cbput state.hists.pag (string_of_int n);
3548 gotopage1 (n + conf.pagebias - 1) 0;
3551 let pageentry text = function [@warning "-4"]
3552 | Keys.Ascii 'g' -> TEdone text
3553 | key -> intentry text key
3555 let text = String.make 1 c in
3556 enttext (":", text, Some (onhist state.hists.pag),
3557 pageentry, ondone, true)
3559 | Ascii 'b' ->
3560 conf.scrollb <- if conf.scrollb = 0 then (scrollbvv lor scrollbhv) else 0;
3561 postRedisplay "toggle scrollbar";
3563 | Ascii 'B' ->
3564 state.bzoom <- not state.bzoom;
3565 state.rects <- [];
3566 showtext ' ' ("block zoom " ^ if state.bzoom then "on" else "off")
3568 | Ascii 'l' ->
3569 conf.hlinks <- not conf.hlinks;
3570 state.text <- "highlightlinks " ^ if conf.hlinks then "on" else "off";
3571 postRedisplay "toggle highlightlinks";
3573 | Ascii 'F' ->
3574 if conf.angle mod 360 = 0
3575 then (
3576 state.glinks <- true;
3577 let mode = state.mode in
3578 state.mode <-
3579 Textentry (
3580 ("goto: ", E.s, None, linknentry, linknact gotounder, false),
3581 (fun _ ->
3582 state.glinks <- false;
3583 state.mode <- mode)
3585 state.text <- E.s;
3586 postRedisplay "view:linkent(F)"
3588 else impmsg "hint mode does not work under rotation"
3590 | Ascii 'y' ->
3591 state.glinks <- true;
3592 let mode = state.mode in
3593 state.mode <-
3594 Textentry (
3595 ("copy: ", E.s, None, linknentry,
3596 linknact (fun under ->
3597 selstring conf.selcmd (undertext under)), false),
3598 (fun _ ->
3599 state.glinks <- false;
3600 state.mode <- mode)
3602 state.text <- E.s;
3603 postRedisplay "view:linkent"
3605 | Ascii 'a' ->
3606 begin match state.autoscroll with
3607 | Some step ->
3608 conf.autoscrollstep <- step;
3609 state.autoscroll <- None
3610 | None ->
3611 state.autoscroll <- Some conf.autoscrollstep;
3612 state.slideshow <- state.slideshow land lnot 2
3615 | Ascii 'p' when ctrl ->
3616 launchpath () (* XXX where do error messages go? *)
3618 | Ascii 'P' ->
3619 setpresentationmode (not conf.presentation);
3620 showtext ' ' ("presentation mode " ^
3621 if conf.presentation then "on" else "off");
3623 | Ascii 'f' ->
3624 if List.mem Wsi.Fullscreen state.winstate
3625 then Wsi.reshape conf.cwinw conf.cwinh
3626 else Wsi.fullscreen ()
3628 | Ascii ('p'|'N') -> search state.searchpattern false
3629 | Ascii 'n' | Fn 3 -> search state.searchpattern true
3631 | Ascii 't' ->
3632 begin match state.layout with
3633 | [] -> ()
3634 | l :: _ -> gotoxy state.x (getpagey l.pageno)
3637 | Ascii ' ' -> nextpage ()
3638 | Delete -> prevpage ()
3639 | Ascii '=' -> showtext ' ' (describe_layout state.layout);
3641 | Ascii 'w' ->
3642 begin match state.layout with
3643 | [] -> ()
3644 | l :: _ ->
3645 Wsi.reshape l.pagew l.pageh;
3646 postRedisplay "w"
3649 | Ascii '\'' -> enterbookmarkmode ()
3650 | Ascii 'h' | Fn 1 -> enterhelpmode ()
3651 | Ascii 'i' -> enterinfomode ()
3652 | Ascii 'e' when Buffer.length state.errmsgs > 0 -> entermsgsmode ()
3654 | Ascii 'm' ->
3655 let ondone s =
3656 match state.layout with
3657 | l :: _ when nonemptystr s ->
3658 state.bookmarks <- (s, 0, Oanchor (getanchor1 l)) :: state.bookmarks
3659 | _ -> ()
3661 enttext ("bookmark: ", E.s, None, textentry, ondone, true)
3663 | Ascii '~' ->
3664 quickbookmark ();
3665 showtext ' ' "Quick bookmark added";
3667 | Ascii 'x' -> state.roam ()
3669 | Ascii ('<'|'>' as c) ->
3670 reqlayout (conf.angle + (if c = '>' then 30 else -30)) conf.fitmodel
3672 | Ascii ('['|']' as c) ->
3673 conf.colorscale <-
3674 bound (conf.colorscale +. (if c = ']' then 0.1 else -0.1)) 0.0 1.0;
3675 postRedisplay "brightness";
3677 | Ascii 'c' when state.mode = View ->
3678 if Wsi.withalt mask
3679 then (
3680 if conf.zoom > 1.0
3681 then
3682 let m = (state.winw - state.w) / 2 in
3683 gotoxy m state.y
3685 else
3686 let (c, a, b), z =
3687 match state.prevcolumns with
3688 | None -> (1, 0, 0), 1.0
3689 | Some (columns, z) ->
3690 let cab =
3691 match columns with
3692 | Csplit (c, _) -> -c, 0, 0
3693 | Cmulti ((c, a, b), _) -> c, a, b
3694 | Csingle _ -> 1, 0, 0
3696 cab, z
3698 setcolumns View c a b;
3699 setzoom z
3701 | Down | Up when ctrl && Wsi.withshift mask ->
3702 let zoom, x = state.prevzoom in
3703 setzoom zoom;
3704 state.x <- x;
3706 | Up ->
3707 begin match state.autoscroll with
3708 | None ->
3709 begin match state.mode with
3710 | Birdseye beye -> upbirdseye 1 beye
3711 | Textentry _ | View | LinkNav _ ->
3712 if ctrl
3713 then gotoxy state.x (clamp ~-(state.winh/2))
3714 else (
3715 if not (Wsi.withshift mask) && conf.presentation
3716 then prevpage ()
3717 else gotoxy state.x (clamp (-conf.scrollstep))
3720 | Some n -> setautoscrollspeed n false
3723 | Down ->
3724 begin match state.autoscroll with
3725 | None ->
3726 begin match state.mode with
3727 | Birdseye beye -> downbirdseye 1 beye
3728 | Textentry _ | View | LinkNav _ ->
3729 if ctrl
3730 then gotoxy state.x (clamp (state.winh/2))
3731 else (
3732 if not (Wsi.withshift mask) && conf.presentation
3733 then nextpage ()
3734 else gotoxy state.x (clamp (conf.scrollstep))
3737 | Some n -> setautoscrollspeed n true
3740 | Left | Right when not (Wsi.withalt mask) ->
3741 if canpan ()
3742 then
3743 let dx =
3744 if ctrl
3745 then state.winw / 2
3746 else conf.hscrollstep
3748 let dx =
3749 let pv = Wsi.kc2kt key in
3750 if pv = Keys.Left then dx else -dx
3752 gotoxy (panbound (state.x + dx)) state.y
3753 else (
3754 state.text <- E.s;
3755 postRedisplay "left/right"
3758 | Prior ->
3759 let y =
3760 if ctrl
3761 then
3762 match state.layout with
3763 | [] -> state.y
3764 | l :: _ -> state.y - l.pagey
3765 else clamp (pgscale (-state.winh))
3767 gotoxy state.x y
3769 | Next ->
3770 let y =
3771 if ctrl
3772 then
3773 match List.rev state.layout with
3774 | [] -> state.y
3775 | l :: _ -> getpagey l.pageno
3776 else clamp (pgscale state.winh)
3778 gotoxy state.x y
3780 | Ascii 'g' | Home ->
3781 addnav ();
3782 gotoxy 0 0
3783 | Ascii 'G' | End ->
3784 addnav ();
3785 gotoxy 0 (clamp state.maxy)
3787 | Right when Wsi.withalt mask ->
3788 addnavnorc ();
3789 gotoxy state.x (getnav 1)
3790 | Left when Wsi.withalt mask ->
3791 addnavnorc ();
3792 gotoxy state.x (getnav ~-1)
3794 | Ascii 'r' ->
3795 reload ()
3797 | Ascii 'v' when conf.debug ->
3798 state.rects <- [];
3799 List.iter (fun l ->
3800 match getopaque l.pageno with
3801 | None -> ()
3802 | Some opaque ->
3803 let x0, y0, x1, y1 = Ffi.pagebbox opaque in
3804 let rect = (float x0, float y0,
3805 float x1, float y0,
3806 float x1, float y1,
3807 float x0, float y1) in
3808 debugrect rect;
3809 let color = (0.0, 0.0, 1.0 /. (l.pageno mod 3 |> float), 0.5) in
3810 state.rects <- (l.pageno, color, rect) :: state.rects;
3811 ) state.layout;
3812 postRedisplay "v";
3814 | Ascii '|' ->
3815 let mode = state.mode in
3816 let cmd = ref E.s in
3817 let onleave = function
3818 | Cancel -> state.mode <- mode
3819 | Confirm ->
3820 List.iter (fun l ->
3821 match getopaque l.pageno with
3822 | Some opaque -> pipesel opaque !cmd
3823 | None -> ()) state.layout;
3824 state.mode <- mode
3826 let ondone s =
3827 cbput state.hists.sel s;
3828 cmd := s
3830 let te =
3831 "| ", !cmd, Some (onhist state.hists.sel), textentry, ondone, true
3833 postRedisplay "|";
3834 state.mode <- Textentry (te, onleave);
3836 | (Ascii _|Fn _|Enter|Left|Right|Code _|Ctrl _) ->
3837 vlog "huh? %s" (Wsi.keyname key)
3840 let linknavkeyboard key mask linknav =
3841 let pv = Wsi.kc2kt key in
3842 let getpage pageno =
3843 let rec loop = function
3844 | [] -> None
3845 | l :: _ when l.pageno = pageno -> Some l
3846 | _ :: rest -> loop rest
3847 in loop state.layout
3849 let doexact (pageno, n) =
3850 match getopaque pageno, getpage pageno with
3851 | Some opaque, Some l ->
3852 if pv = Keys.Enter
3853 then
3854 let under = Ffi.getlink opaque n in
3855 postRedisplay "link gotounder";
3856 gotounder under;
3857 state.mode <- View;
3858 else
3859 let opt, dir =
3860 let open Keys in
3861 match pv with
3862 | Home -> Some (Ffi.findlink opaque LDfirst), -1
3863 | End -> Some (Ffi.findlink opaque LDlast), 1
3864 | Left -> Some (Ffi.findlink opaque (LDleft n)), -1
3865 | Right -> Some (Ffi.findlink opaque (LDright n)), 1
3866 | Up -> Some (Ffi.findlink opaque (LDup n)), -1
3867 | Down -> Some (Ffi.findlink opaque (LDdown n)), 1
3868 | Delete|Escape|Insert|Enter|Next|Prior|Ascii _
3869 | Code _|Fn _|Ctrl _|Backspace -> None, 0
3871 let pwl l dir =
3872 begin match Ffi.findpwl l.pageno dir with
3873 | Pwlnotfound -> ()
3874 | Pwl pageno ->
3875 let notfound dir =
3876 state.mode <- LinkNav (Ltgendir dir);
3877 let y, h = getpageyh pageno in
3878 let y =
3879 if dir < 0
3880 then y + h - state.winh
3881 else y
3883 gotoxy state.x y
3885 begin match getopaque pageno, getpage pageno with
3886 | Some opaque, Some _ ->
3887 let link =
3888 let ld = if dir > 0 then LDfirst else LDlast in
3889 Ffi.findlink opaque ld
3891 begin match link with
3892 | Lfound m ->
3893 showlinktype (Ffi.getlink opaque m);
3894 state.mode <- LinkNav (Ltexact (pageno, m));
3895 postRedisplay "linknav jpage";
3896 | Lnotfound -> notfound dir
3897 end;
3898 | _ -> notfound dir
3899 end;
3900 end;
3902 begin match opt with
3903 | Some Lnotfound -> pwl l dir;
3904 | Some (Lfound m) ->
3905 if m = n
3906 then pwl l dir
3907 else (
3908 let _, y0, _, y1 = Ffi.getlinkrect opaque m in
3909 if y0 < l.pagey
3910 then gotopage1 l.pageno y0
3911 else (
3912 let d = fstate.fontsize + 1 in
3913 if y1 - l.pagey > l.pagevh - d
3914 then gotopage1 l.pageno (y1 - state.winh + d)
3915 else postRedisplay "linknav";
3917 showlinktype (Ffi.getlink opaque m);
3918 state.mode <- LinkNav (Ltexact (l.pageno, m));
3921 | None -> viewkeyboard key mask
3922 end;
3923 | _ -> viewkeyboard key mask
3925 if pv = Keys.Insert
3926 then (
3927 begin match linknav with
3928 | Ltexact pa -> state.lnava <- Some pa
3929 | Ltgendir _ | Ltnotready _ -> ()
3930 end;
3931 state.mode <- View;
3932 postRedisplay "leave linknav"
3934 else
3935 match linknav with
3936 | Ltgendir _ | Ltnotready _ -> viewkeyboard key mask
3937 | Ltexact exact -> doexact exact
3940 let keyboard key mask =
3941 if (key = Char.code 'g' && Wsi.withctrl mask) && not (istextentry state.mode)
3942 then wcmd "interrupt"
3943 else state.uioh <- state.uioh#key key mask
3946 let birdseyekeyboard key mask
3947 ((oconf, leftx, pageno, hooverpageno, anchor) as beye) =
3948 let incr =
3949 match conf.columns with
3950 | Csingle _ -> 1
3951 | Cmulti ((c, _, _), _) -> c
3952 | Csplit _ -> error "bird's eye split mode"
3954 let pgh layout = List.fold_left
3955 (fun m l -> max l.pageh m) state.winh layout in
3956 let open Keys in
3957 match Wsi.kc2kt key with
3958 | Ascii 'l' when Wsi.withctrl mask ->
3959 let y, h = getpageyh pageno in
3960 let top = (state.winh - h) / 2 in
3961 gotoxy state.x (max 0 (y - top))
3962 | Enter -> leavebirdseye beye false
3963 | Escape -> leavebirdseye beye true
3964 | Up -> upbirdseye incr beye
3965 | Down -> downbirdseye incr beye
3966 | Left -> upbirdseye 1 beye
3967 | Right -> downbirdseye 1 beye
3969 | Prior ->
3970 begin match state.layout with
3971 | l :: _ ->
3972 if l.pagey != 0
3973 then (
3974 state.mode <- Birdseye (
3975 oconf, leftx, l.pageno, hooverpageno, anchor
3977 gotopage1 l.pageno 0;
3979 else (
3980 let layout = layout state.x (state.y-state.winh)
3981 state.winw
3982 (pgh state.layout) in
3983 match layout with
3984 | [] -> gotoxy state.x (clamp (-state.winh))
3985 | l :: _ ->
3986 state.mode <- Birdseye (
3987 oconf, leftx, l.pageno, hooverpageno, anchor
3989 gotopage1 l.pageno 0
3992 | [] -> gotoxy state.x (clamp (-state.winh))
3993 end;
3995 | Next ->
3996 begin match List.rev state.layout with
3997 | l :: _ ->
3998 let layout = layout state.x
3999 (state.y + (pgh state.layout))
4000 state.winw state.winh in
4001 begin match layout with
4002 | [] ->
4003 let incr = l.pageh - l.pagevh in
4004 if incr = 0
4005 then (
4006 state.mode <-
4007 Birdseye (
4008 oconf, leftx, state.pagecount - 1, hooverpageno, anchor
4010 postRedisplay "birdseye pagedown";
4012 else gotoxy state.x (clamp (incr + conf.interpagespace*2));
4014 | l :: _ ->
4015 state.mode <-
4016 Birdseye (oconf, leftx, l.pageno, hooverpageno, anchor);
4017 gotopage1 l.pageno 0;
4020 | [] -> gotoxy state.x (clamp state.winh)
4021 end;
4023 | Home ->
4024 state.mode <- Birdseye (oconf, leftx, 0, hooverpageno, anchor);
4025 gotopage1 0 0
4027 | End ->
4028 let pageno = state.pagecount - 1 in
4029 state.mode <- Birdseye (oconf, leftx, pageno, hooverpageno, anchor);
4030 if not (pagevisible state.layout pageno)
4031 then
4032 let h =
4033 match List.rev state.pdims with
4034 | [] -> state.winh
4035 | (_, _, h, _) :: _ -> h
4037 gotoxy
4038 state.x
4039 (max 0 (getpagey pageno - (state.winh - h - conf.interpagespace)))
4040 else postRedisplay "birdseye end";
4042 | Delete|Insert|Ascii _|Code _|Ctrl _|Fn _|Backspace -> viewkeyboard key mask
4045 let drawpage l =
4046 let color =
4047 match state.mode with
4048 | Textentry _ -> scalecolor 0.4
4049 | LinkNav _ | View -> scalecolor 1.0
4050 | Birdseye (_, _, pageno, hooverpageno, _) ->
4051 if l.pageno = hooverpageno
4052 then scalecolor 0.9
4053 else (
4054 if l.pageno = pageno
4055 then (
4056 let c = scalecolor 1.0 in
4057 GlDraw.color c;
4058 GlDraw.line_width 3.0;
4059 let dispx = l.pagedispx in
4060 linerect
4061 (float (dispx-1)) (float (l.pagedispy-1))
4062 (float (dispx+l.pagevw+1))
4063 (float (l.pagedispy+l.pagevh+1));
4064 GlDraw.line_width 1.0;
4067 else scalecolor 0.8
4070 drawtiles l color;
4073 let postdrawpage l linkindexbase =
4074 match getopaque l.pageno with
4075 | Some opaque ->
4076 if tileready l l.pagex l.pagey
4077 then
4078 let x = l.pagedispx - l.pagex
4079 and y = l.pagedispy - l.pagey in
4080 let hlmask =
4081 match conf.columns with
4082 | Csingle _ | Cmulti _ ->
4083 (if conf.hlinks then 1 else 0)
4084 + (if state.glinks
4085 && not (isbirdseye state.mode) then 2 else 0)
4086 | Csplit _ -> 0
4088 let s =
4089 match state.mode with
4090 | Textentry ((_, s, _, _, _, _), _) when state.glinks -> s
4091 | Textentry _
4092 | Birdseye _
4093 | View
4094 | LinkNav _ -> E.s
4096 Hashtbl.find_all state.prects l.pageno |>
4097 List.iter (fun vals -> Ffi.drawprect opaque x y vals);
4098 let n =
4099 Ffi.postprocess opaque hlmask x y (linkindexbase, s, conf.hfsize) in
4100 if n < 0
4101 then (Glutils.redisplay := true; 0)
4102 else n
4103 else 0
4104 | _ -> 0
4107 let scrollindicator () =
4108 let sbw, ph, sh = state.uioh#scrollph in
4109 let sbh, pw, sw = state.uioh#scrollpw in
4111 let x0,x1,hx0 =
4112 if conf.leftscroll
4113 then (0, sbw, sbw)
4114 else ((state.winw - sbw), state.winw, 0)
4117 Gl.enable `blend;
4118 GlFunc.blend_func ~src:`src_alpha ~dst:`one_minus_src_alpha;
4119 let (r, g, b, alpha) = conf.sbarcolor in
4120 GlDraw.color (r, g, b) ~alpha;
4121 filledrect (float x0) 0. (float x1) (float state.winh);
4122 filledrect
4123 (float hx0) (float (state.winh - sbh))
4124 (float (hx0 + state.winw)) (float state.winh);
4125 let (r, g, b, alpha) = conf.sbarhndlcolor in
4126 GlDraw.color (r, g, b) ~alpha;
4128 filledrect (float x0) ph (float x1) (ph +. sh);
4129 let pw = pw +. float hx0 in
4130 filledrect pw (float (state.winh - sbh)) (pw +. sw) (float state.winh);
4131 Gl.disable `blend;
4134 let showsel () =
4135 match state.mstate with
4136 | Mnone | Mscrolly | Mscrollx | Mpan _ | Mzoom _ | Mzoomrect _ -> ()
4137 | Msel ((x0, y0), (x1, y1)) ->
4138 let identify opaque l px py = Some (opaque, l.pageno, px, py) in
4139 let o0,n0,px0,py0 = onppundermouse identify x0 y0 (~< E.s, -1, 0, 0) in
4140 let _o1,n1,px1,py1 = onppundermouse identify x1 y1 (~< E.s, -1, 0, 0) in
4141 if n0 != -1 && n0 = n1 then Ffi.seltext o0 (px0, py0, px1, py1);
4144 let showrects = function
4145 | [] -> ()
4146 | rects ->
4147 Gl.enable `blend;
4148 GlDraw.color (0.0, 0.0, 1.0) ~alpha:0.5;
4149 GlFunc.blend_func ~src:`src_alpha ~dst:`one_minus_src_alpha;
4150 List.iter
4151 (fun (pageno, c, (x0, y0, x1, y1, x2, y2, x3, y3)) ->
4152 List.iter (fun l ->
4153 if l.pageno = pageno
4154 then
4155 let dx = float (l.pagedispx - l.pagex) in
4156 let dy = float (l.pagedispy - l.pagey) in
4157 let r, g, b, alpha = c in
4158 GlDraw.color (r, g, b) ~alpha;
4159 filledrect2
4160 (x0+.dx) (y0+.dy)
4161 (x1+.dx) (y1+.dy)
4162 (x3+.dx) (y3+.dy)
4163 (x2+.dx) (y2+.dy);
4164 ) state.layout
4165 ) rects;
4166 Gl.disable `blend;
4169 let display () =
4170 GlDraw.color (scalecolor2 conf.bgcolor);
4171 GlClear.color (scalecolor2 conf.bgcolor);
4172 GlClear.clear [`color];
4173 List.iter drawpage state.layout;
4174 let rects =
4175 match state.mode with
4176 | LinkNav (Ltexact (pageno, linkno)) ->
4177 begin match getopaque pageno with
4178 | Some opaque ->
4179 let x0, y0, x1, y1 = Ffi.getlinkrect opaque linkno in
4180 let color =
4181 if conf.invert
4182 then (1.0, 1.0, 1.0, 0.5)
4183 else (0.0, 0.0, 0.5, 0.5)
4185 (pageno, color,
4186 (float x0, float y0,
4187 float x1, float y0,
4188 float x1, float y1,
4189 float x0, float y1)
4190 ) :: state.rects
4191 | None -> state.rects
4193 | LinkNav (Ltgendir _) | LinkNav (Ltnotready _)
4194 | Birdseye _
4195 | Textentry _
4196 | View -> state.rects
4198 showrects rects;
4199 let rec postloop linkindexbase = function
4200 | l :: rest ->
4201 let linkindexbase = linkindexbase + postdrawpage l linkindexbase in
4202 postloop linkindexbase rest
4203 | [] -> ()
4205 showsel ();
4206 postloop 0 state.layout;
4207 state.uioh#display;
4208 begin match state.mstate with
4209 | Mzoomrect ((x0, y0), (x1, y1)) ->
4210 Gl.enable `blend;
4211 GlDraw.color (0.3, 0.3, 0.3) ~alpha:0.5;
4212 GlFunc.blend_func ~src:`src_alpha ~dst:`one_minus_src_alpha;
4213 filledrect (float x0) (float y0) (float x1) (float y1);
4214 Gl.disable `blend;
4215 | Msel _
4216 | Mpan _
4217 | Mscrolly | Mscrollx
4218 | Mzoom _
4219 | Mnone -> ()
4220 end;
4221 enttext ();
4222 scrollindicator ();
4223 Wsi.swapb ();
4226 let display () =
4227 match state.reload with
4228 | Some (x, y, t) ->
4229 if x != state.x || y != state.y || abs_float @@ now () -. t > 0.5
4230 || (state.layout != [] && layoutready state.layout)
4231 then (
4232 state.reload <- None;
4233 display ()
4235 | None -> display ()
4238 let zoomrect x y x1 y1 =
4239 let x0 = min x x1
4240 and x1 = max x x1
4241 and y0 = min y y1 in
4242 let zoom = (float state.w) /. float (x1 - x0) in
4243 let margin =
4244 let simple () =
4245 if state.w < state.winw
4246 then (state.winw - state.w) / 2
4247 else 0
4249 match conf.fitmodel with
4250 | FitWidth | FitProportional -> simple ()
4251 | FitPage ->
4252 match conf.columns with
4253 | Csplit _ ->
4254 onppundermouse (fun _ l _ _ -> Some l.pagedispx) x0 y0 x0
4255 | Cmulti _ | Csingle _ -> simple ()
4257 gotoxy ((state.x + margin) - x0) (state.y + y0);
4258 state.anchor <- getanchor ();
4259 setzoom zoom;
4260 resetmstate ();
4263 let annot inline x y =
4264 match unproject x y with
4265 | Some (opaque, n, ux, uy) ->
4266 let add text =
4267 Ffi.addannot opaque ux uy text;
4268 wcmd "freepage %s" (~> opaque);
4269 Hashtbl.remove state.pagemap (n, state.gen);
4270 flushtiles ();
4271 gotoxy state.x state.y
4273 if inline
4274 then
4275 let ondone s = add s in
4276 let mode = state.mode in
4277 state.mode <- Textentry (
4278 ("annotation: ", E.s, None, textentry, ondone, true),
4279 fun _ -> state.mode <- mode);
4280 state.text <- E.s;
4281 enttext ();
4282 postRedisplay "annot"
4283 else add @@ getusertext E.s
4284 | _ -> ()
4287 let zoomblock x y =
4288 let g opaque l px py =
4289 match Ffi.rectofblock opaque px py with
4290 | Some a ->
4291 let x0 = a.(0) -. 20. in
4292 let x1 = a.(1) +. 20. in
4293 let y0 = a.(2) -. 20. in
4294 let zoom = (float state.w) /. (x1 -. x0) in
4295 let pagey = getpagey l.pageno in
4296 let margin = (state.w - l.pagew)/2 in
4297 let nx = -truncate x0 - margin in
4298 gotoxy nx (pagey + truncate y0);
4299 state.anchor <- getanchor ();
4300 setzoom zoom;
4301 None
4302 | None -> None
4304 match conf.columns with
4305 | Csplit _ ->
4306 impmsg "block zooming does not work properly in split columns mode"
4307 | Cmulti _ | Csingle _ -> onppundermouse g x y ()
4310 let scrollx x =
4311 let winw = state.winw - 1 in
4312 let s = float x /. float winw in
4313 let destx = truncate (float (state.w + winw) *. s) in
4314 gotoxy (winw - destx) state.y;
4315 state.mstate <- Mscrollx;
4318 let scrolly y =
4319 let s = float y /. float state.winh in
4320 let desty = truncate (s *. float (maxy ())) in
4321 gotoxy state.x desty;
4322 state.mstate <- Mscrolly;
4325 let viewmulticlick clicks x y mask =
4326 let g opaque l px py =
4327 let mark =
4328 match clicks with
4329 | 2 -> Mark_word
4330 | 3 -> Mark_line
4331 | 4 -> Mark_block
4332 | _ -> Mark_page
4334 if Ffi.markunder opaque px py mark
4335 then (
4336 Some (fun () ->
4337 let dopipe cmd =
4338 match getopaque l.pageno with
4339 | None -> ()
4340 | Some opaque -> pipesel opaque cmd
4342 state.roam <- (fun () -> dopipe conf.paxcmd);
4343 if not (Wsi.withctrl mask) then dopipe conf.selcmd;
4346 else None
4348 postRedisplay "viewmulticlick";
4349 onppundermouse g x y (fun () -> impmsg "nothing to select") ();
4352 let canselect () =
4353 match conf.columns with
4354 | Csplit _ -> false
4355 | Csingle _ | Cmulti _ -> conf.angle mod 360 = 0
4358 let viewmouse button down x y mask =
4359 match button with
4360 | n when (n == 4 || n == 5) && not down ->
4361 if Wsi.withctrl mask
4362 then (
4363 let incr =
4364 if n = 5
4365 then if conf.zoom +. 0.01 > 0.1 then 0.1 else 0.01
4366 else if conf.zoom -. 0.1 < 0.1 then -0.01 else -0.1
4368 let fx, fy =
4369 match state.mstate with
4370 | Mzoom (oldn, _, pos) when n = oldn -> pos
4371 | Mzoomrect _ | Mnone | Mpan _
4372 | Msel _ | Mscrollx | Mscrolly | Mzoom _ -> (x, y)
4374 let zoom = conf.zoom -. incr in
4375 state.mstate <- Mzoom (n, 0, (x, y));
4376 if false && abs (fx - x) > 5 || abs (fy - y) > 5
4377 then pivotzoom ~x ~y zoom
4378 else pivotzoom zoom
4380 else (
4381 match state.autoscroll with
4382 | Some step -> setautoscrollspeed step (n=4)
4383 | None ->
4384 if conf.wheelbypage || conf.presentation
4385 then (
4386 if n = 4
4387 then prevpage ()
4388 else nextpage ()
4390 else
4391 let incr = if n = 4 then -conf.scrollstep else conf.scrollstep in
4392 let incr = incr * 2 in
4393 let y = clamp incr in
4394 gotoxy state.x y
4397 | n when (n = 6 || n = 7) && not down && canpan () ->
4398 let x =
4399 panbound (state.x + (if n = 7 then -2 else 2) * conf.hscrollstep) in
4400 gotoxy x state.y
4402 | 1 when Wsi.withshift mask ->
4403 state.mstate <- Mnone;
4404 if not down
4405 then (
4406 match unproject x y with
4407 | None -> ()
4408 | Some (_, pageno, ux, uy) ->
4409 let cmd = Printf.sprintf
4410 "%s %s %d %d %d"
4411 conf.stcmd state.path pageno ux uy
4413 match spawn cmd [] with
4414 | exception exn ->
4415 impmsg "execution of synctex command(%S) failed: %S"
4416 conf.stcmd @@ exntos exn
4417 | _pid -> ()
4420 | 1 when Wsi.withctrl mask ->
4421 if down
4422 then (
4423 Wsi.setcursor Wsi.CURSOR_FLEUR;
4424 state.mstate <- Mpan (x, y)
4426 else state.mstate <- Mnone
4428 | 3 ->
4429 if down
4430 then (
4431 if Wsi.withshift mask
4432 then (
4433 annot conf.annotinline x y;
4434 postRedisplay "addannot"
4436 else
4437 let p = (x, y) in
4438 Wsi.setcursor Wsi.CURSOR_CYCLE;
4439 state.mstate <- Mzoomrect (p, p)
4441 else (
4442 match state.mstate with
4443 | Mzoomrect ((x0, y0), _) ->
4444 if abs (x-x0) > 10 && abs (y - y0) > 10
4445 then zoomrect x0 y0 x y
4446 else (
4447 resetmstate ();
4448 postRedisplay "kill accidental zoom rect";
4450 | Msel _
4451 | Mpan _
4452 | Mscrolly | Mscrollx
4453 | Mzoom _
4454 | Mnone -> resetmstate ()
4457 | 1 when vscrollhit x ->
4458 if down
4459 then
4460 let _, position, sh = state.uioh#scrollph in
4461 if y > truncate position && y < truncate (position +. sh)
4462 then state.mstate <- Mscrolly
4463 else scrolly y
4464 else state.mstate <- Mnone
4466 | 1 when y > state.winh - hscrollh () ->
4467 if down
4468 then
4469 let _, position, sw = state.uioh#scrollpw in
4470 if x > truncate position && x < truncate (position +. sw)
4471 then state.mstate <- Mscrollx
4472 else scrollx x
4473 else state.mstate <- Mnone
4475 | 1 when state.bzoom -> if not down then zoomblock x y
4477 | 1 ->
4478 let dest = if down then getunder x y else Unone in
4479 begin match dest with
4480 | Ulinkuri _ -> gotounder dest
4481 | Unone when down ->
4482 Wsi.setcursor Wsi.CURSOR_FLEUR;
4483 state.mstate <- Mpan (x, y);
4484 | Uannotation (opaque, slinkindex) -> enterannotmode opaque slinkindex
4485 | Unone | Utext _ ->
4486 if down
4487 then (
4488 if canselect ()
4489 then (
4490 state.mstate <- Msel ((x, y), (x, y));
4491 postRedisplay "mouse select";
4494 else (
4495 match state.mstate with
4496 | Mnone -> ()
4497 | Mzoom _ | Mscrollx | Mscrolly -> state.mstate <- Mnone
4498 | Mzoomrect ((x0, y0), _) -> zoomrect x0 y0 x y
4499 | Mpan _ ->
4500 Wsi.setcursor Wsi.CURSOR_INHERIT;
4501 state.mstate <- Mnone
4502 | Msel ((x0, y0), (x1, y1)) ->
4503 let rec loop = function
4504 | [] -> ()
4505 | l :: rest ->
4506 let inside =
4507 let a0 = l.pagedispy in
4508 let a1 = a0 + l.pagevh in
4509 let b0 = l.pagedispx in
4510 let b1 = b0 + l.pagevw in
4511 ((y0 >= a0 && y0 <= a1) || (y1 >= a0 && y1 <= a1))
4512 && ((x0 >= b0 && x0 <= b1) || (x1 >= b0 && x1 <= b1))
4514 if inside
4515 then
4516 match getopaque l.pageno with
4517 | Some opaque ->
4518 let dosel cmd () =
4519 pipef ~closew:false "Msel"
4520 (fun w ->
4521 Ffi.copysel w opaque;
4522 postRedisplay "Msel") cmd
4524 dosel conf.selcmd ();
4525 state.roam <- dosel conf.paxcmd;
4526 | None -> ()
4527 else loop rest
4529 loop state.layout;
4530 resetmstate ();
4533 | _ -> ()
4536 let birdseyemouse button down x y mask
4537 (conf, leftx, _, hooverpageno, anchor) =
4538 match button with
4539 | 1 when down ->
4540 let rec loop = function
4541 | [] -> ()
4542 | l :: rest ->
4543 if y > l.pagedispy && y < l.pagedispy + l.pagevh
4544 && x > l.pagedispx && x < l.pagedispx + l.pagevw
4545 then
4546 leavebirdseye (conf, leftx, l.pageno, hooverpageno, anchor) false
4547 else loop rest
4549 loop state.layout
4550 | 3 -> ()
4551 | _ -> viewmouse button down x y mask
4554 let uioh = object
4555 method display = ()
4557 method key key mask =
4558 begin match state.mode with
4559 | Textentry textentry -> textentrykeyboard key mask textentry
4560 | Birdseye birdseye -> birdseyekeyboard key mask birdseye
4561 | View -> viewkeyboard key mask
4562 | LinkNav linknav -> linknavkeyboard key mask linknav
4563 end;
4564 state.uioh
4566 method button button bstate x y mask =
4567 begin match state.mode with
4568 | LinkNav _ | View -> viewmouse button bstate x y mask
4569 | Birdseye beye -> birdseyemouse button bstate x y mask beye
4570 | Textentry _ -> ()
4571 end;
4572 state.uioh
4574 method multiclick clicks x y mask =
4575 begin match state.mode with
4576 | LinkNav _ | View -> viewmulticlick clicks x y mask
4577 | Birdseye _ | Textentry _ -> ()
4578 end;
4579 state.uioh
4581 method motion x y =
4582 begin match state.mode with
4583 | Textentry _ -> ()
4584 | View | Birdseye _ | LinkNav _ ->
4585 match state.mstate with
4586 | Mzoom _ | Mnone -> ()
4587 | Mpan (x0, y0) ->
4588 let dx = x - x0
4589 and dy = y0 - y in
4590 state.mstate <- Mpan (x, y);
4591 let x = if canpan () then panbound (state.x + dx) else state.x in
4592 let y = clamp dy in
4593 gotoxy x y
4595 | Msel (a, _) ->
4596 state.mstate <- Msel (a, (x, y));
4597 postRedisplay "motion select";
4599 | Mscrolly ->
4600 let y = min state.winh (max 0 y) in
4601 scrolly y
4603 | Mscrollx ->
4604 let x = min state.winw (max 0 x) in
4605 scrollx x
4607 | Mzoomrect (p0, _) ->
4608 state.mstate <- Mzoomrect (p0, (x, y));
4609 postRedisplay "motion zoomrect";
4610 end;
4611 state.uioh
4613 method pmotion x y =
4614 begin match state.mode with
4615 | Birdseye (conf, leftx, pageno, hooverpageno, anchor) ->
4616 let rec loop = function
4617 | [] ->
4618 if hooverpageno != -1
4619 then (
4620 state.mode <- Birdseye (conf, leftx, pageno, -1, anchor);
4621 postRedisplay "pmotion birdseye no hoover";
4623 | l :: rest ->
4624 if y > l.pagedispy && y < l.pagedispy + l.pagevh
4625 && x > l.pagedispx && x < l.pagedispx + l.pagevw
4626 then (
4627 state.mode <- Birdseye (conf, leftx, pageno, l.pageno, anchor);
4628 postRedisplay "pmotion birdseye hoover";
4630 else loop rest
4632 loop state.layout
4634 | Textentry _ -> ()
4636 | LinkNav _ | View ->
4637 match state.mstate with
4638 | Mpan _ | Msel _ | Mzoom _ | Mscrolly | Mscrollx | Mzoomrect _ -> ()
4639 | Mnone ->
4640 updateunder x y;
4641 if canselect ()
4642 then
4643 match conf.pax with
4644 | None -> ()
4645 | Some past ->
4646 let now = now () in
4647 let delta = now -. past in
4648 if delta > 0.01
4649 then paxunder x y
4650 else conf.pax <- Some now
4651 end;
4652 state.uioh
4654 method infochanged _ = ()
4656 method scrollph =
4657 let maxy = maxy () in
4658 let p, h =
4659 if maxy = 0
4660 then 0.0, float state.winh
4661 else scrollph state.y maxy
4663 vscrollw (), p, h
4665 method scrollpw =
4666 let fwinw = float (state.winw - vscrollw ()) in
4667 let sw =
4668 let sw = fwinw /. float state.w in
4669 let sw = fwinw *. sw in
4670 max sw (float conf.scrollh)
4672 let position =
4673 let maxx = state.w + state.winw in
4674 let x = state.winw - state.x in
4675 let percent = float x /. float maxx in
4676 (fwinw -. sw) *. percent
4678 hscrollh (), position, sw
4680 method modehash =
4681 let modename =
4682 match state.mode with
4683 | LinkNav _ -> "links"
4684 | Textentry _ -> "textentry"
4685 | Birdseye _ -> "birdseye"
4686 | View -> "view"
4688 findkeyhash conf modename
4690 method eformsgs = true
4691 method alwaysscrolly = false
4692 method scroll dx dy =
4693 let x = if canpan () then panbound (state.x + dx) else state.x in
4694 gotoxy x (clamp (2 * dy));
4695 state.uioh
4696 method zoom z x y =
4697 pivotzoom ~x ~y (conf.zoom *. exp z);
4698 end;;
4700 let addrect pageno r g b a x0 y0 x1 y1 =
4701 Hashtbl.add state.prects pageno [|r; g; b; a; x0; y0; x1; y1|];
4704 let ract cmds =
4705 let cl = splitatchar cmds ' ' in
4706 let scan s fmt f =
4707 try Scanf.sscanf s fmt f
4708 with exn -> adderrfmt "remote exec" "error processing '%S': %s\n"
4709 cmds @@ exntos exn
4711 let rectx s pageno (r, g, b, a) x0 y0 x1 y1 =
4712 vlog "%s page %d color (%f %f %f %f) x0,y0,x1,y1 = %f %f %f %f"
4713 s pageno r g b a x0 y0 x1 y1;
4714 onpagerect
4715 pageno
4716 (fun w h ->
4717 let _,w1,h1,_ = getpagedim pageno in
4718 let sw = float w1 /. float w
4719 and sh = float h1 /. float h in
4720 let x0s = x0 *. sw
4721 and x1s = x1 *. sw
4722 and y0s = y0 *. sh
4723 and y1s = y1 *. sh in
4724 let rect = (x0s,y0s,x1s,y0s,x1s,y1s,x0s,y1s) in
4725 let color = (r, g, b, a) in
4726 if conf.verbose then debugrect rect;
4727 state.rects <- (pageno, color, rect) :: state.rects;
4728 postRedisplay s;
4731 match cl with
4732 | "reload", "" -> reload ()
4733 | "goto", args ->
4734 scan args "%u %f %f"
4735 (fun pageno x y ->
4736 let cmd, _ = state.geomcmds in
4737 if emptystr cmd
4738 then gotopagexy pageno x y
4739 else
4740 let f prevf () =
4741 gotopagexy pageno x y;
4742 prevf ()
4744 state.reprf <- f state.reprf
4746 | "goto1", args -> scan args "%u %f" gotopage
4747 | "gotor", args -> scan args "%S" gotoremote
4748 | "rect", args ->
4749 scan args "%u %u %f %f %f %f"
4750 (fun pageno c x0 y0 x1 y1 ->
4751 let color = (0.0, 0.0, 1.0 /. float c, 0.5) in
4752 rectx "rect" pageno color x0 y0 x1 y1;
4754 | "prect", args ->
4755 scan args "%u %f %f %f %f %f %f %f %f"
4756 (fun pageno r g b alpha x0 y0 x1 y1 ->
4757 addrect pageno r g b alpha x0 y0 x1 y1;
4758 postRedisplay "prect"
4760 | "pgoto", args ->
4761 scan args "%u %f %f"
4762 (fun pageno x y ->
4763 let optopaque =
4764 match getopaque pageno with
4765 | Some opaque -> opaque
4766 | None -> ~< E.s
4768 pgoto optopaque pageno x y;
4769 let rec fixx = function
4770 | [] -> ()
4771 | l :: rest ->
4772 if l.pageno = pageno
4773 then gotoxy (state.x - l.pagedispx) state.y
4774 else fixx rest
4776 let layout =
4777 let mult =
4778 match conf.columns with
4779 | Csingle _ | Csplit _ -> 1
4780 | Cmulti ((n, _, _), _) -> n
4782 layout 0 state.y (state.winw * mult) state.winh
4784 fixx layout
4786 | "activatewin", "" -> Wsi.activatewin ()
4787 | "quit", "" -> raise Quit
4788 | "keys", keys ->
4789 begin try
4790 let l = Config.keys_of_string keys in
4791 List.iter (fun (k, m) -> keyboard k m) l
4792 with exn -> adderrfmt "error processing keys" "`%S': %s\n"
4793 cmds @@ exntos exn
4795 | "clearrects", "" ->
4796 Hashtbl.clear state.prects;
4797 postRedisplay "clearrects"
4798 | _ ->
4799 adderrfmt "remote command"
4800 "error processing remote command: %S\n" cmds;
4803 let remote =
4804 let scratch = Bytes.create 80 in
4805 let buf = Buffer.create 80 in
4806 fun fd ->
4807 match tempfailureretry (Unix.read fd scratch 0) 80 with
4808 | exception Unix.Unix_error (Unix.EAGAIN, _, _) -> None
4809 | 0 ->
4810 Unix.close fd;
4811 if Buffer.length buf > 0
4812 then (
4813 let s = Buffer.contents buf in
4814 Buffer.clear buf;
4815 ract s;
4817 None
4818 | n ->
4819 let rec eat ppos =
4820 let nlpos =
4821 match Bytes.index_from scratch ppos '\n' with
4822 | pos -> if pos >= n then -1 else pos
4823 | exception Not_found -> -1
4825 if nlpos >= 0
4826 then (
4827 Buffer.add_subbytes buf scratch ppos (nlpos-ppos);
4828 let s = Buffer.contents buf in
4829 Buffer.clear buf;
4830 ract s;
4831 eat (nlpos+1);
4833 else (
4834 Buffer.add_subbytes buf scratch ppos (n-ppos);
4835 Some fd
4837 in eat 0
4840 let remoteopen path =
4841 try Some (Unix.openfile path [Unix.O_NONBLOCK; Unix.O_RDONLY] 0o0)
4842 with exn ->
4843 adderrfmt "remoteopen" "error opening %S: %s" path @@ exntos exn;
4844 None
4847 let () =
4848 Utils.vlogf := (fun s -> if conf.verbose then prerr_endline s else ignore s);
4849 let gcconfig = ref false in
4850 let trimcachepath = ref E.s in
4851 let rcmdpath = ref E.s in
4852 let pageno = ref None in
4853 let openlast = ref false in
4854 let doreap = ref false in
4855 let csspath = ref None in
4856 selfexec := Sys.executable_name;
4857 Arg.parse
4858 (Arg.align
4859 [("-p", Arg.String (fun s -> state.password <- s),
4860 "<password> Set password");
4862 ("-f", Arg.String
4863 (fun s ->
4864 Config.fontpath := s;
4865 selfexec := !selfexec ^ " -f " ^ Filename.quote s;
4867 "<path> Set path to the user interface font");
4869 ("-c", Arg.String
4870 (fun s ->
4871 selfexec := !selfexec ^ " -c " ^ Filename.quote s;
4872 Config.confpath := s),
4873 "<path> Set path to the configuration file");
4875 ("-last", Arg.Set openlast, " Open last document");
4877 ("-page", Arg.Int (fun pageno1 -> pageno := Some (pageno1-1)),
4878 "<page-number> Jump to page");
4880 ("-tcf", Arg.String (fun s -> trimcachepath := s),
4881 "<path> Set path to the trim cache file");
4883 ("-dest", Arg.String (fun s -> state.nameddest <- s),
4884 "<named-destination> Set named destination");
4886 ("-remote", Arg.String (fun s -> rcmdpath := s),
4887 "<path> Set path to the source of remote commands");
4889 ("-gc", Arg.Set gcconfig, " Collect config garbage");
4891 ("-v", Arg.Unit (fun () ->
4892 Printf.printf
4893 "%s\nconfiguration file: %s\n"
4894 (Help.version ())
4895 Config.defconfpath;
4896 exit 0), " Print version and exit");
4898 ("-css", Arg.String (fun s -> csspath := Some s),
4899 "<path> Set path to the style sheet to use with EPUB/HTML");
4901 ("-origin", Arg.String (fun s -> state.origin <- s),
4902 "<origin> <undocumented>");
4904 ("-no-title", Arg.Set ignoredoctitlte, " ignore document title");
4905 ("-layout-height", Arg.Set_int layouth,
4906 "<height> layout height html/epub/etc (-1, 0, N)");
4909 (fun s -> state.path <- s)
4910 ("Usage: " ^ Sys.argv.(0) ^ " [options] some.pdf\nOptions:");
4912 let histmode = emptystr state.path && not !openlast in
4914 if not (Config.load !openlast)
4915 then dolog "failed to load configuration";
4917 begin match !pageno with
4918 | Some pageno -> state.anchor <- (pageno, 0.0, 0.0)
4919 | None -> ()
4920 end;
4922 fillhelp ();
4923 if !gcconfig
4924 then (
4925 Config.gc ();
4926 exit 0
4929 let mu =
4930 object (self)
4931 val mutable m_clicks = 0
4932 val mutable m_click_x = 0
4933 val mutable m_click_y = 0
4934 val mutable m_lastclicktime = infinity
4936 method private cleanup =
4937 state.roam <- noroam;
4938 Hashtbl.iter (fun _ opaque -> Ffi.clearmark opaque) state.pagemap
4939 method expose = postRedisplay "expose"
4940 method visible v =
4941 let name =
4942 match v with
4943 | Wsi.Unobscured -> "unobscured"
4944 | Wsi.PartiallyObscured -> "partiallyobscured"
4945 | Wsi.FullyObscured -> "fullyobscured"
4947 vlog "visibility change %s" name
4948 method display = display ()
4949 method map mapped = vlog "mapped %b" mapped
4950 method reshape w h =
4951 self#cleanup;
4952 reshape w h
4953 method mouse b d x y m =
4954 if d && canselect ()
4955 then (
4957 * http://blogs.msdn.com/b/oldnewthing/archive/2004/10/18/243925.aspx
4959 m_click_x <- x;
4960 m_click_y <- y;
4961 if b = 1
4962 then (
4963 let t = now () in
4964 if abs x - m_click_x > 10
4965 || abs y - m_click_y > 10
4966 || abs_float (t -. m_lastclicktime) > 0.3
4967 then m_clicks <- 0;
4968 m_clicks <- m_clicks + 1;
4969 m_lastclicktime <- t;
4970 if m_clicks = 1
4971 then (
4972 self#cleanup;
4973 postRedisplay "cleanup";
4974 state.uioh <- state.uioh#button b d x y m;
4976 else state.uioh <- state.uioh#multiclick m_clicks x y m
4978 else (
4979 self#cleanup;
4980 m_clicks <- 0;
4981 m_lastclicktime <- infinity;
4982 state.uioh <- state.uioh#button b d x y m
4985 else state.uioh <- state.uioh#button b d x y m
4986 method motion x y =
4987 state.mpos <- (x, y);
4988 state.uioh <- state.uioh#motion x y
4989 method pmotion x y =
4990 state.mpos <- (x, y);
4991 state.uioh <- state.uioh#pmotion x y
4992 method key k m =
4993 vlog "k=%#x m=%#x" k m;
4994 let mascm = m land (
4995 Wsi.altmask + Wsi.shiftmask + Wsi.ctrlmask + Wsi.metamask
4996 ) in
4997 let keyboard k m =
4998 let x = state.x and y = state.y in
4999 keyboard k m;
5000 if x != state.x || y != state.y then self#cleanup
5002 match state.keystate with
5003 | KSnone ->
5004 let km = k, mascm in
5005 begin
5006 match
5007 let modehash = state.uioh#modehash in
5008 try Hashtbl.find modehash km
5009 with Not_found ->
5010 try Hashtbl.find (findkeyhash conf "global") km
5011 with Not_found -> KMinsrt (k, m)
5012 with
5013 | KMinsrt (k, m) -> keyboard k m
5014 | KMinsrl l -> List.iter (fun (k, m) -> keyboard k m) l
5015 | KMmulti (l, r) -> state.keystate <- KSinto (l, r)
5017 | KSinto ((k', m') :: [], insrt) when k'=k && m' land mascm = m' ->
5018 List.iter (fun (k, m) -> keyboard k m) insrt;
5019 state.keystate <- KSnone
5020 | KSinto ((k', m') :: keys, insrt) when k'=k && m' land mascm = m' ->
5021 state.keystate <- KSinto (keys, insrt)
5022 | KSinto _ -> state.keystate <- KSnone
5024 method enter x y =
5025 state.mpos <- (x, y);
5026 state.uioh <- state.uioh#pmotion x y
5027 method leave = state.mpos <- (-1, -1)
5028 method winstate wsl = state.winstate <- wsl
5029 method quit : 'a. 'a = raise Quit
5030 method scroll dx dy = state.uioh <- state.uioh#scroll dx dy
5031 method zoom z x y = state.uioh#zoom z x y
5032 method opendoc path =
5033 state.mode <- View;
5034 state.uioh <- uioh;
5035 postRedisplay "opendoc";
5036 opendoc path state.password
5039 let wsfd, winw, winh = Wsi.init mu conf.cwinw conf.cwinh platform in
5040 state.wsfd <- wsfd;
5042 if not @@ List.exists GlMisc.check_extension
5043 [ "GL_ARB_texture_rectangle"
5044 ; "GL_EXT_texture_recangle"
5045 ; "GL_NV_texture_rectangle" ]
5046 then (dolog "OpenGL does not suppport rectangular textures"; exit 1);
5048 let cs, ss =
5049 match Unix.socketpair Unix.PF_UNIX Unix.SOCK_STREAM 0 with
5050 | exception exn ->
5051 dolog "socketpair failed: %s" @@ exntos exn;
5052 exit 1
5053 | (r, w) ->
5054 cloexec r;
5055 cloexec w;
5056 r, w
5059 setcheckers conf.checkers;
5060 begin match !csspath with
5061 | None -> ()
5062 | Some "" -> conf.css <- E.s
5063 | Some path ->
5064 let css = filecontents path in
5065 let l = String.length css in
5066 conf.css <-
5067 if substratis css (l-2) "\r\n"
5068 then String.sub css 0 (l-2)
5069 else (if css.[l-1] = '\n' then String.sub css 0 (l-1) else css)
5070 end;
5071 Ffi.init cs (
5072 conf.angle, conf.fitmodel, (conf.trimmargins, conf.trimfuzz),
5073 conf.texcount, conf.sliceheight, conf.mustoresize, conf.colorspace,
5074 !Config.fontpath, !trimcachepath
5076 List.iter GlArray.enable [`texture_coord; `vertex];
5077 GlTex.env (`color conf.texturecolor);
5078 state.ss <- ss;
5079 reshape ~firsttime:true winw winh;
5080 state.uioh <- uioh;
5081 if histmode
5082 then (
5083 Wsi.settitle "llpp (history)";
5084 enterhistmode ();
5086 else (
5087 state.text <- "Opening " ^ (mbtoutf8 state.path);
5088 opendoc state.path state.password;
5090 display ();
5091 Wsi.mapwin ();
5092 Wsi.setcursor Wsi.CURSOR_INHERIT;
5093 Sys.set_signal Sys.sighup (Sys.Signal_handle (fun _ -> reload ()));
5095 let rec reap () =
5096 match Unix.waitpid [Unix.WNOHANG] ~-1 with
5097 | exception (Unix.Unix_error (Unix.ECHILD, _, _)) -> ()
5098 | exception exn -> dolog "Unix.waitpid: %s" @@ exntos exn
5099 | 0, _ -> ()
5100 | _pid, _status -> reap ()
5102 Sys.set_signal Sys.sigchld (Sys.Signal_handle (fun _ -> doreap := true));
5104 let optrfd =
5105 ref (if nonemptystr !rcmdpath then remoteopen !rcmdpath else None)
5108 let rec loop deadline =
5109 if !doreap
5110 then (
5111 doreap := false;
5112 reap ()
5114 let r = [state.ss; state.wsfd] in
5115 let r =
5116 match !optrfd with
5117 | None -> r
5118 | Some fd -> fd :: r
5120 if !redisplay
5121 then (
5122 Glutils.redisplay := false;
5123 display ();
5125 let timeout =
5126 let now = now () in
5127 if deadline > now
5128 then (
5129 if deadline = infinity
5130 then ~-.1.0
5131 else max 0.0 (deadline -. now)
5133 else 0.0
5135 let r, _, _ =
5136 try Unix.select r [] [] timeout
5137 with Unix.Unix_error (Unix.EINTR, _, _) -> [], [], []
5139 begin match r with
5140 | [] ->
5141 let newdeadline =
5142 match state.autoscroll with
5143 | Some step when step != 0 ->
5144 if state.slideshow land 1 = 1
5145 then (
5146 if state.slideshow land 2 = 0
5147 then state.slideshow <- state.slideshow lor 2
5148 else if step < 0 then prevpage () else nextpage ();
5149 deadline +. (float (abs step))
5151 else
5152 let y = state.y + step in
5153 let fy = if conf.maxhfit then state.winh else 0 in
5154 let y =
5155 if y < 0
5156 then state.maxy - fy
5157 else if y >= state.maxy - fy then 0 else y
5159 gotoxy state.x y;
5160 deadline +. 0.01
5161 | _ -> infinity
5163 loop newdeadline
5165 | l ->
5166 let rec checkfds = function
5167 | [] -> ()
5168 | fd :: rest when fd = state.ss ->
5169 let cmd = Ffi.rcmd state.ss in
5170 act cmd;
5171 checkfds rest
5173 | fd :: rest when fd = state.wsfd ->
5174 Wsi.readresp fd;
5175 checkfds rest
5177 | fd :: rest when Some fd = !optrfd ->
5178 begin match remote fd with
5179 | None -> optrfd := remoteopen !rcmdpath;
5180 | opt -> optrfd := opt
5181 end;
5182 checkfds rest
5184 | _ :: rest ->
5185 dolog "select returned unknown descriptor";
5186 checkfds rest
5188 checkfds l;
5189 let newdeadline =
5190 let deadline1 =
5191 if deadline = infinity
5192 then now () +. 0.01
5193 else deadline
5195 match state.autoscroll with
5196 | Some step when step != 0 -> deadline1
5197 | _ -> infinity
5199 loop newdeadline
5200 end;
5202 match loop infinity with
5203 | exception Quit ->
5204 Config.save leavebirdseye;
5205 if Ffi.hasunsavedchanges ()
5206 then save ()
5207 | _ -> error "umpossible - infinity reached"