System fallback font
[llpp.git] / config.ml
blob9b09408920555062e6646cb98e766a28d162b825
1 open Utils;;
3 type fontstate =
4 { mutable fontsize : int
5 ; mutable wwidth : float
6 ; mutable maxrows : int
8 ;;
10 let fstate =
11 { fontsize = 20 * Wsi.fontsizefactor ()
12 ; wwidth = nan
13 ; maxrows = -1
17 let irect_of_string s =
18 Scanf.sscanf s "%d/%d/%d/%d" (fun x0 y0 x1 y1 -> (x0,y0,x1,y1))
21 let irect_to_string (x0,y0,x1,y1) = Printf.sprintf "%d/%d/%d/%d" x0 y0 x1 y1;;
23 let multicolumns_to_string (n, a, b) =
24 if a = 0 && b = 0
25 then Printf.sprintf "%d" n
26 else Printf.sprintf "%d,%d,%d" n a b;
29 let multicolumns_of_string s =
30 try
31 (int_of_string s, 0, 0)
32 with _ ->
33 Scanf.sscanf s "%u,%u,%u" (fun n a b ->
34 if a > 1 || b > 1
35 then error "subtly broken";
36 (n, a, b)
40 include Confstruct;;
42 type angle = int
43 and opaque = Opaque.t
44 and rectcolor = rgba
45 and pixmapsize = int
46 and gen = int
47 and top = float
48 and dtop = float
49 and fontpath = string
50 and trimcachepath = string
51 and aalevel = int
52 and trimmargins = bool
53 and trimparams = (trimmargins * irect)
54 and usedoccss = bool
55 and uri = string
56 and caption = string
57 and tilex = int
58 and tiley = int
59 and tileparams = (x * y * width * height * tilex * tiley)
60 and under =
61 | Unone
62 | Ulinkuri of string
63 | Utext of facename
64 | Uannotation of (opaque * slinkindex)
65 and slinkindex = int
66 and facename = string
67 and launchcommand = string
68 and filename = string
69 and linkno = int
70 and destname = string
71 and link =
72 | Lnotfound
73 | Lfound of int
74 and linkdir =
75 | LDfirst
76 | LDlast
77 | LDfirstvisible of (int * int * int)
78 | LDleft of int
79 | LDright of int
80 | LDdown of int
81 | LDup of int
82 and pagewithlinks =
83 | Pwlnotfound
84 | Pwl of int
85 and scrollb = int
86 and anchor = pageno * top * dtop
87 and rect = float * float * float * float * float * float * float * float
88 and infochange = | Memused | Docinfo | Pdim
91 class type uioh =
92 object
93 method display : unit
94 method key : int -> int -> uioh
95 method button : int -> bool -> int -> int -> int -> uioh
96 method multiclick : int -> int -> int -> int -> uioh
97 method motion : int -> int -> uioh
98 method pmotion : int -> int -> uioh
99 method infochanged : infochange -> unit
100 method scrollpw : (int * float * float)
101 method scrollph : (int * float * float)
102 method modehash : keyhash
103 method eformsgs : bool
104 method alwaysscrolly : bool
105 method scroll : int -> int -> uioh
106 method zoom : float -> int -> int -> unit
107 end;;
109 module type TextEnumType =
111 type t
112 val name : string
113 val names : string array
114 end;;
116 module TextEnumMake (Ten : TextEnumType) =
117 struct
118 let names = Ten.names;;
119 let to_int (t : Ten.t) = Obj.magic t;;
120 let to_string t = names.(to_int t);;
121 let of_int n : Ten.t = Obj.magic n;;
122 let of_string s =
123 let rec find i =
124 if i = Array.length names
125 then error "invalid %s: %s" Ten.name s
126 else (
127 if Ten.names.(i) = s
128 then of_int i
129 else find (i+1)
131 in find 0;;
132 end;;
134 module CSTE = TextEnumMake (
135 struct
136 type t = colorspace;;
137 let name = "colorspace";;
138 let names = [|"rgb"; "gray"|];;
139 end);;
141 module MTE = TextEnumMake (
142 struct
143 type t = mark;;
144 let name = "mark";;
145 let names = [|"page"; "block"; "line"; "word"|];;
146 end);;
148 module FMTE = TextEnumMake (
149 struct
150 type t = fitmodel;;
151 let name = "fitmodel";;
152 let names = [|"width"; "proportional"; "page"|];;
153 end);;
155 type outlinekind =
156 | Onone
157 | Oanchor of anchor
158 | Ouri of uri
159 | Olaunch of launchcommand
160 | Oremote of (filename * pageno)
161 | Oremotedest of (filename * destname)
162 | Ohistory of (filename * conf * outline list * x * anchor * filename)
163 and outline = (caption * outlinelevel * outlinekind)
164 and outlinelevel = int
167 type page =
168 { pageno : int
169 ; pagedimno : int
170 ; pagew : int
171 ; pageh : int
172 ; pagex : int
173 ; pagey : int
174 ; pagevw : int
175 ; pagevh : int
176 ; pagedispx : int
177 ; pagedispy : int
178 ; pagecol : int
182 type tile = opaque * pixmapsize * elapsed
183 and elapsed = float;;
184 type pagemapkey = pageno * gen;;
185 type tilemapkey = pageno * gen * colorspace * angle * width * height * col * row
186 and row = int
187 and col = int
188 and currently =
189 | Idle
190 | Loading of (page * gen)
191 | Tiling
192 of (page * opaque * colorspace * angle * gen * col * row * width * height)
193 | Outlining of outline list
196 type mpos = int * int
197 and mstate =
198 | Msel of (mpos * mpos)
199 | Mpan of mpos
200 | Mscrolly | Mscrollx
201 | Mzoom of (buttonno * step * mpos)
202 | Mzoomrect of (mpos * mpos)
203 | Mnone
204 and buttonno = int
205 and step = int
208 type mode =
209 | Birdseye of (conf * leftx * pageno * pageno * anchor)
210 | Textentry of (textentry * onleave)
211 | View
212 | LinkNav of linktarget
213 and onleave = leavetextentrystatus -> unit
214 and leavetextentrystatus = | Cancel | Confirm
215 and helpitem = string * int * action
216 and action =
217 | Noaction
218 | Action of (uioh -> uioh)
219 and linktarget =
220 | Ltexact of (pageno * direction)
221 | Ltgendir of direction
222 | Ltnotready of (pageno * direction)
223 and direction = int (* -1, 0, 1 *)
224 and textentry = string * string * onhist option * onkey * ondone * cancelonempty
225 and onkey = string -> Keys.t -> te
226 and ondone = string -> unit
227 and histcancel = unit -> unit
228 and onhist = ((histcmd -> string) * histcancel)
229 and histcmd = HCnext | HCprev | HCfirst | HClast
230 and cancelonempty = bool
231 and te =
232 | TEstop
233 | TEdone of string
234 | TEcont of string
235 | TEswitch of textentry
238 type 'a circbuf =
239 { store : 'a array
240 ; mutable rc : int
241 ; mutable wc : int
242 ; mutable len : int
246 type state =
247 { mutable ss : Unix.file_descr
248 ; mutable wsfd : Unix.file_descr
249 ; mutable stderr : Unix.file_descr
250 ; mutable errmsgs : Buffer.t
251 ; mutable newerrmsgs : bool
252 ; mutable w : int
253 ; mutable x : x
254 ; mutable y : y
255 ; mutable anchor : anchor
256 ; mutable ranchors : (string * string * anchor * string) list
257 ; mutable maxy : int
258 ; mutable layout : page list
259 ; pagemap : (pagemapkey, opaque) Hashtbl.t
260 ; tilemap : (tilemapkey, tile) Hashtbl.t
261 ; tilelru : (tilemapkey * opaque * pixmapsize) Queue.t
262 ; mutable pdims : (pageno * width * height * leftx) list
263 ; mutable pagecount : int
264 ; mutable currently : currently
265 ; mutable mstate : mstate
266 ; mutable searchpattern : string
267 ; mutable rects : (pageno * rectcolor * rect) list
268 ; mutable rects1 : (pageno * rectcolor * rect) list
269 ; prects : (pageno, float array) Hashtbl.t
270 ; mutable text : string
271 ; mutable winstate : Wsi.winstate list
272 ; mutable mode : mode
273 ; mutable uioh : uioh
274 ; mutable outlines : outline array
275 ; mutable bookmarks : outline list
276 ; mutable path : string
277 ; mutable password : string
278 ; mutable nameddest : string
279 ; mutable geomcmds : (string * ((string * (unit -> unit)) list))
280 ; mutable memused : memsize
281 ; mutable gen : gen
282 ; mutable autoscroll : int option
283 ; mutable help : helpitem array
284 ; mutable docinfo : (int * string) list
285 ; hists : hists
286 ; mutable prevzoom : (float * int)
287 ; mutable progress : float
288 ; mutable mpos : mpos
289 ; mutable keystate : keystate
290 ; mutable glinks : bool
291 ; mutable prevcolumns : (columns * float) option
292 ; mutable winw : int
293 ; mutable winh : int
294 ; mutable reprf : (unit -> unit)
295 ; mutable origin : string
296 ; mutable roam : (unit -> unit)
297 ; mutable bzoom : bool
298 ; mutable lnava : (pageno * linkno) option
299 ; mutable slideshow : int
300 ; mutable reload : (x * y * float) option
302 and hists =
303 { pat : string circbuf
304 ; pag : string circbuf
305 ; nav : anchor circbuf
306 ; sel : string circbuf
310 let emptyanchor = (0, 0.0, 0.0);;
311 let emptykeyhash = Hashtbl.create 0;;
312 let noreprf () = ();;
313 let noroam () = ();;
315 let nouioh : uioh =
316 object (self)
317 method display = ()
318 method key _ _ = self
319 method multiclick _ _ _ _ = self
320 method button _ _ _ _ _ = self
321 method motion _ _ = self
322 method pmotion _ _ = self
323 method infochanged _ = ()
324 method scrollpw = (0, nan, nan)
325 method scrollph = (0, nan, nan)
326 method modehash = emptykeyhash
327 method eformsgs = false
328 method alwaysscrolly = false
329 method scroll _ _ = self
330 method zoom _ _ _ = ()
331 end;;
333 let platform_to_string = function
334 | Punknown -> "unknown"
335 | Plinux -> "Linux"
336 | Pmacos -> "macOS"
337 | Pbsd -> "BSD"
340 let conf = { defconf with keyhashes = copykeyhashes defconf };;
342 let cbnew n v =
343 { store = Array.make n v
344 ; rc = 0
345 ; wc = 0
346 ; len = 0
350 let cbcap b = Array.length b.store;;
352 let cbput ?(update_rc=true) b v =
353 let cap = cbcap b in
354 b.store.(b.wc) <- v;
355 b.wc <- (b.wc + 1) mod cap;
356 if update_rc
357 then b.rc <- b.wc;
358 b.len <- min (b.len + 1) cap;
361 let cbput_dont_update_rc b v = cbput ~update_rc:false b v;;
363 let cbempty b = b.len = 0;;
365 let cbgetg b circular dir =
366 if cbempty b
367 then b.store.(0)
368 else
369 let rc = b.rc + dir in
370 let rc =
371 if circular
372 then (
373 if rc = -1
374 then b.len-1
375 else (
376 if rc >= b.len
377 then 0
378 else rc
381 else bound rc 0 (b.len-1)
383 b.rc <- rc;
384 b.store.(rc);
387 let cbget b = cbgetg b false;;
388 let cbgetc b = cbgetg b true;;
390 let state =
391 { ss = Unix.stdin
392 ; wsfd = Unix.stdin
393 ; stderr = Unix.stderr
394 ; errmsgs = Buffer.create 0
395 ; newerrmsgs = false
396 ; x = 0
397 ; y = 0
398 ; w = 0
399 ; anchor = emptyanchor
400 ; ranchors = []
401 ; layout = []
402 ; maxy = max_int
403 ; tilelru = Queue.create ()
404 ; pagemap = Hashtbl.create 10
405 ; tilemap = Hashtbl.create 10
406 ; pdims = []
407 ; pagecount = 0
408 ; currently = Idle
409 ; mstate = Mnone
410 ; rects = []
411 ; rects1 = []
412 ; prects = Hashtbl.create 1
413 ; text = E.s
414 ; mode = View
415 ; winstate = []
416 ; searchpattern = E.s
417 ; outlines = E.a
418 ; bookmarks = []
419 ; path = E.s
420 ; password = E.s
421 ; nameddest = E.s
422 ; geomcmds = E.s, []
423 ; hists =
424 { nav = cbnew 10 emptyanchor
425 ; pat = cbnew 10 E.s
426 ; pag = cbnew 10 E.s
427 ; sel = cbnew 10 E.s
429 ; memused = 0
430 ; gen = 0
431 ; autoscroll = None
432 ; help = E.a
433 ; docinfo = []
434 ; prevzoom = (1.0, 0)
435 ; progress = -1.0
436 ; uioh = nouioh
437 ; mpos = (-1, -1)
438 ; keystate = KSnone
439 ; glinks = false
440 ; prevcolumns = None
441 ; winw = -1
442 ; winh = -1
443 ; reprf = noreprf
444 ; origin = E.s
445 ; roam = noroam
446 ; bzoom = false
447 ; lnava = None
448 ; slideshow = 0
449 ; reload = None
453 let calcips h =
454 let d = state.winh - h in
455 max conf.interpagespace ((d + 1) / 2)
458 let rowyh (c, coverA, coverB) b n =
459 if c = 1 || (n < coverA || n >= state.pagecount - coverB)
460 then
461 let _, _, vy, (_, _, h, _) = b.(n) in
462 (vy, h)
463 else
464 let n' = n - coverA in
465 let d = n' mod c in
466 let s = n - d in
467 let e = min state.pagecount (s + c) in
468 let rec find m miny maxh = if m = e then miny, maxh else
469 let _, _, y, (_, _, h, _) = b.(m) in
470 let miny = min miny y in
471 let maxh = max maxh h in
472 find (m+1) miny maxh
473 in find s max_int 0
476 let page_of_y y =
477 let ((c, coverA, coverB) as cl), b =
478 match conf.columns with
479 | Csplit (_, b) | Csingle b -> (1, 0, 0), b
480 | Cmulti (c, b) -> c, b
482 if Array.length b = 0
483 then -1
484 else
485 let rec bsearch nmin nmax =
486 if nmin > nmax
487 then bound nmin 0 (state.pagecount-1)
488 else
489 let n = (nmax + nmin) / 2 in
490 let vy, h = rowyh cl b n in
491 let y0, y1 =
492 if conf.presentation
493 then
494 let ips = calcips h in
495 let y0 = vy - ips in
496 let y1 = vy + h + ips in
497 y0, y1
498 else (
499 if n = 0
500 then 0, vy + h + conf.interpagespace
501 else
502 let y0 = vy - conf.interpagespace in
503 y0, y0 + h + conf.interpagespace
506 if y >= y0 && y < y1
507 then (
508 if c = 1
509 then n
510 else (
511 if n > coverA
512 then
513 if n < state.pagecount - coverB
514 then ((n-coverA)/c)*c + coverA
515 else n
516 else n
519 else (
520 if y > y0
521 then bsearch (n+1) nmax
522 else bsearch nmin (n-1)
525 bsearch 0 (state.pagecount-1);
528 let calcheight () =
529 match conf.columns with
530 | Cmulti ((_, _, _) as cl, b) ->
531 if Array.length b > 0
532 then
533 let y, h = rowyh cl b (Array.length b - 1) in
534 y + h + (if conf.presentation then calcips h else 0)
535 else 0
536 | Csingle b ->
537 if Array.length b > 0
538 then
539 let (_, _, y, (_, _, h, _)) = b.(Array.length b - 1) in
540 y + h + (if conf.presentation then calcips h else 0)
541 else 0
542 | Csplit (_, b) ->
543 if Array.length b > 0
544 then
545 let (_, _, y, (_, _, h, _)) = b.(Array.length b - 1) in
546 y + h
547 else 0
550 let getpageywh pageno =
551 let pageno = bound pageno 0 (state.pagecount-1) in
552 match conf.columns with
553 | Csingle b ->
554 if Array.length b = 0
555 then 0, 0, 0
556 else
557 let (_, _, y, (_, w, h, _)) = b.(pageno) in
558 let y =
559 if conf.presentation
560 then y - calcips h
561 else y
563 y, w, h
564 | Cmulti (cl, b) ->
565 if Array.length b = 0
566 then 0, 0, 0
567 else
568 let y, h = rowyh cl b pageno in
569 let (_, _, _, (_, w, _, _)) = b.(pageno) in
570 let y =
571 if conf.presentation
572 then y - calcips h
573 else y
575 y, w, h
576 | Csplit (c, b) ->
577 if Array.length b = 0
578 then 0, 0, 0
579 else
580 let n = pageno*c in
581 let (_, _, y, (_, w, h, _)) = b.(n) in
582 y, w / c, h
585 let getpageyh pageno =
586 let y,_,h = getpageywh pageno in
587 y, h;
590 let getpagedim pageno =
591 let rec f ppdim l =
592 match l with
593 | (n, _, _, _) as pdim :: rest ->
594 if n >= pageno
595 then (if n = pageno then pdim else ppdim)
596 else f pdim rest
597 | [] -> ppdim
599 f (-1, -1, -1, -1) state.pdims
602 let getpdimno pageno =
603 let rec f p l =
604 let np = succ p in
605 match l with
606 | (n, _, _, _) :: rest ->
607 if n >= pageno
608 then (if n = pageno then np else p)
609 else f np rest
610 | [] -> p
612 f ~-1 state.pdims
615 let getpagey pageno = fst (getpageyh pageno);;
617 let getanchor1 l =
618 let top =
619 let coloff = l.pagecol * l.pageh in
620 float (l.pagey + coloff) /. float l.pageh
622 let dtop =
623 if l.pagedispy = 0
624 then 0.0
625 else (
626 if conf.presentation
627 then float l.pagedispy /. float (calcips l.pageh)
628 else float l.pagedispy /. float conf.interpagespace
631 (l.pageno, top, dtop)
634 let getanchor () =
635 match state.layout with
636 | l :: _ -> getanchor1 l
637 | [] ->
638 let n = page_of_y state.y in
639 if n = -1
640 then state.anchor
641 else
642 let y, h = getpageyh n in
643 let dy = y - state.y in
644 let dtop =
645 if conf.presentation
646 then
647 let ips = calcips h in
648 float (dy + ips) /. float ips
649 else float dy /. float conf.interpagespace
651 (n, 0.0, dtop)
654 let fontpath = ref E.s;;
656 type historder = [ `lastvisit | `title | `path | `file ];;
658 module KeyMap =
659 Map.Make (struct type t = (int * int) let compare = compare end);;
661 let unentS s =
662 let l = String.length s in
663 let b = Buffer.create l in
664 Parser.unent b s 0 l;
665 Buffer.contents b;
668 let home =
669 try Sys.getenv "HOME"
670 with exn ->
671 dolog "cannot determine home directory location: %s" @@ exntos exn;
675 let modifier_of_string = function
676 | "alt" -> Wsi.altmask
677 | "shift" -> Wsi.shiftmask
678 | "ctrl" | "control" -> Wsi.ctrlmask
679 | "meta" -> Wsi.metamask
680 | _ -> 0
683 let keys_of_string s =
684 let key_of_string r s =
685 let elems = Str.full_split r s in
686 let f n k m =
687 let g s =
688 let m1 = modifier_of_string s in
689 if m1 = 0
690 then (Wsi.namekey s, m)
691 else (k, m lor m1)
692 in function
693 | Str.Delim s when n land 1 = 0 -> g s
694 | Str.Text s -> g s
695 | Str.Delim _ -> (k, m)
697 let rec loop n k m = function
698 | [] -> (k, m)
699 | x :: xs ->
700 let k, m = f n k m x in
701 loop (n+1) k m xs
703 loop 0 0 0 elems
705 let elems = Str.split Utils.Re.whitespace s in
706 List.map (key_of_string (Str.regexp "-")) elems
709 let config_of c attrs =
710 let maxv ?(f=int_of_string) u s = max u @@ f s in
711 let apply c k v =
713 match k with
714 | "scroll-bar-width" -> { c with scrollbw = maxv 0 v }
715 | "scroll-handle-height" -> { c with scrollh = maxv 0 v }
716 | "case-insensitive-search" -> { c with icase = bool_of_string v }
717 | "preload" -> { c with preload = bool_of_string v }
718 | "page-bias" -> { c with pagebias = int_of_string v }
719 | "scroll-step" -> { c with scrollstep = maxv 1 v }
720 | "horizontal-scroll-step" -> { c with hscrollstep = maxv 1 v }
721 | "auto-scroll-step" -> { c with autoscrollstep = maxv 0 v }
722 | "max-height-fit" -> { c with maxhfit = bool_of_string v }
723 | "highlight-links" -> { c with hlinks = bool_of_string v }
724 | "under-cursor-info" -> { c with underinfo = bool_of_string v }
725 | "vertical-margin" -> { c with interpagespace = maxv 0 v }
726 | "zoom" ->
727 let zoom = float_of_string v /. 100. in
728 let zoom = max zoom 0.0 in
729 { c with zoom = zoom }
730 | "presentation" -> { c with presentation = bool_of_string v }
731 | "rotation-angle" -> { c with angle = int_of_string v }
732 | "width" -> { c with cwinw = maxv 20 v }
733 | "height" -> { c with cwinh = maxv 20 v }
734 | "proportional-display" ->
735 let fm =
736 if bool_of_string v
737 then FitProportional
738 else FitWidth
740 { c with fitmodel = fm }
741 | "fit-model" -> { c with fitmodel = FMTE.of_string v }
742 | "pixmap-cache-size" ->
743 { c with memlimit = maxv ~f:int_of_string_with_suffix 2 v }
744 | "tex-count" -> { c with texcount = maxv 1 v }
745 | "slice-height" -> { c with sliceheight = maxv 2 v }
746 | "thumbnail-width" -> { c with thumbw = maxv 2 v }
747 | "background-color" -> { c with bgcolor = color_of_string v }
748 | "paper-color" -> { c with papercolor = rgba_of_string v }
749 | "scrollbar-color" -> { c with sbarcolor = rgba_of_string v }
750 | "scrollbar-handle-color" -> { c with sbarhndlcolor = rgba_of_string v }
751 | "texture-color" -> { c with texturecolor = rgba_of_string v }
752 | "tile-width" -> { c with tilew = maxv 2 v }
753 | "tile-height" -> { c with tileh = maxv 2 v }
754 | "mupdf-store-size" ->
755 { c with mustoresize = maxv ~f:int_of_string_with_suffix 1024 v }
756 | "checkers" -> { c with checkers = bool_of_string v }
757 | "aalevel" -> { c with aalevel = maxv 0 v }
758 | "trim-margins" -> { c with trimmargins = bool_of_string v }
759 | "trim-fuzz" -> { c with trimfuzz = irect_of_string v }
760 | "uri-launcher" -> { c with urilauncher = unentS v }
761 | "path-launcher" -> { c with pathlauncher = unentS v }
762 | "color-space" -> { c with colorspace = CSTE.of_string v }
763 | "invert-colors" -> { c with invert = bool_of_string v }
764 | "brightness" -> { c with colorscale = float_of_string v }
765 | "columns" ->
766 let (n, _, _) as nab = multicolumns_of_string v in
767 if n < 0
768 then { c with columns = Csplit (-n, E.a) }
769 else { c with columns = Cmulti (nab, E.a) }
770 | "birds-eye-columns" -> { c with beyecolumns = Some (maxv 2 v) }
771 | "selection-command" -> { c with selcmd = unentS v }
772 | "paste-command" -> { c with pastecmd = unentS v }
773 | "synctex-command" -> { c with stcmd = unentS v }
774 | "pax-command" -> { c with paxcmd = unentS v }
775 | "askpass-command" -> { c with passcmd = unentS v }
776 | "savepath-command" -> { c with savecmd = unentS v }
777 | "update-cursor" -> { c with updatecurs = bool_of_string v }
778 | "hint-font-size" -> { c with hfsize = bound (int_of_string v) 5 100 }
779 | "page-scroll-scale" -> { c with pgscale = float_of_string v }
780 | "use-pbo" -> { c with usepbo = bool_of_string v }
781 | "wheel-scrolls-pages" -> { c with wheelbypage = bool_of_string v }
782 | "horizontal-scrollbar-visible" ->
783 { c with scrollb = if bool_of_string v
784 then c.scrollb lor scrollbhv
785 else c.scrollb land (lnot scrollbhv)
787 | "vertical-scrollbar-visible" ->
788 { c with scrollb = if bool_of_string v
789 then c.scrollb lor scrollbvv
790 else c.scrollb land (lnot scrollbvv)
792 | "remote-in-a-new-instance" -> { c with riani = bool_of_string v }
793 | "point-and-x" ->
794 { c with pax = if bool_of_string v then Some 0.0 else None }
795 | "point-and-x-mark" -> { c with paxmark = MTE.of_string v }
796 | "scroll-bar-on-the-left" -> { c with leftscroll = bool_of_string v }
797 | "title" -> { c with title = unentS v }
798 | "last-visit" -> { c with lastvisit = float_of_string v }
799 | "edit-annotations-inline" -> { c with annotinline = bool_of_string v }
800 | "coarse-presentation-positioning" ->
801 { c with coarseprespos = bool_of_string v }
802 | "use-document-css" -> { c with usedoccss = bool_of_string v }
803 | _ -> c
804 with exn ->
805 dolog "error processing attribute (`%S' = `%S'): %s" k v @@ exntos exn;
808 let rec fold c = function
809 | [] -> c
810 | (k, v) :: rest ->
811 let c = apply c k v in
812 fold c rest
814 fold { c with keyhashes = copykeyhashes c } attrs;
817 let fromstring f pos n v d =
818 try f v
819 with exn ->
820 dolog "error processing attribute (%S=%S) at %d\n%s" n v pos @@ exntos exn;
824 let bookmark_of attrs =
825 let rec fold title page rely visy = function
826 | ("title", v) :: rest -> fold v page rely visy rest
827 | ("page", v) :: rest -> fold title v rely visy rest
828 | ("rely", v) :: rest -> fold title page v visy rest
829 | ("visy", v) :: rest -> fold title page rely v rest
830 | _ :: rest -> fold title page rely visy rest
831 | [] -> title, page, rely, visy
833 fold "invalid" "0" "0" "0" attrs
836 let doc_of attrs =
837 let rec fold path key page rely pan visy origin = function
838 | ("path", v) :: rest -> fold v key page rely pan visy origin rest
839 | ("key", v) :: rest -> fold path v page rely pan visy origin rest
840 | ("page", v) :: rest -> fold path key v rely pan visy origin rest
841 | ("rely", v) :: rest -> fold path key page v pan visy origin rest
842 | ("pan", v) :: rest -> fold path key page rely v visy origin rest
843 | ("visy", v) :: rest -> fold path key page rely pan v origin rest
844 | ("origin", v) :: rest -> fold path key page rely pan visy v rest
845 | _ :: rest -> fold path key page rely pan visy origin rest
846 | [] -> path, key, page, rely, pan, visy, origin
848 fold E.s E.s "0" "0" "0" "0" E.s attrs
851 let map_of attrs =
852 let rec fold rs ls = function
853 | ("out", v) :: rest -> fold v ls rest
854 | ("in", v) :: rest -> fold rs v rest
855 | _ :: rest -> fold ls rs rest
856 | [] -> ls, rs
858 fold E.s E.s attrs
861 let findkeyhash c name =
862 try List.assoc name c.keyhashes
863 with Not_found -> error "invalid mode name `%s'" name
866 let get s =
867 let open Parser in
868 let h = Hashtbl.create 10 in
869 let dc = { defconf with angle = defconf.angle } in
870 let rec toplevel v t spos _ =
871 match t with
872 | Vdata | Vcdata | Vend -> v
873 | Vopen ("llppconfig", _, closed) ->
874 if closed
875 then v
876 else { v with f = llppconfig }
877 | Vopen _ -> parse_error "unexpected subelement at top level" s spos
878 | Vclose _ -> parse_error "unexpected close at top level" s spos
880 and llppconfig v t spos _ =
881 match t with
882 | Vdata | Vcdata -> v
883 | Vend -> parse_error "unexpected end of input in llppconfig" s spos
884 | Vopen ("defaults", attrs, closed) ->
885 let c = config_of dc attrs in
886 setconf dc c;
887 if closed
888 then v
889 else { v with f = defaults }
891 | Vopen ("ui-font", attrs, closed) ->
892 let rec getsize size = function
893 | [] -> size
894 | ("size", v) :: rest ->
895 let size =
896 fromstring int_of_string spos "size" v fstate.fontsize in
897 getsize size rest
898 | l -> getsize size l
900 fstate.fontsize <- getsize fstate.fontsize attrs;
901 if closed
902 then v
903 else { v with f = uifont (Buffer.create 10) }
905 | Vopen ("doc", attrs, closed) ->
906 let pathent, key, spage, srely, span, svisy, origin = doc_of attrs in
907 let path = unentS pathent
908 and origin = unentS origin
909 and pageno = fromstring int_of_string spos "page" spage 0
910 and rely = fromstring float_of_string spos "rely" srely 0.0
911 and pan = fromstring int_of_string spos "pan" span 0
912 and visy = fromstring float_of_string spos "visy" svisy 0.0 in
913 let c = config_of dc attrs in
914 c.key <- key;
915 let anchor = (pageno, rely, visy) in
916 if closed
917 then (Hashtbl.add h path (c, [], pan, anchor, origin); v)
918 else { v with f = doc path origin pan anchor c [] }
920 | Vopen _ -> parse_error "unexpected subelement in llppconfig" s spos
921 | Vclose "llppconfig" -> { v with f = toplevel }
922 | Vclose _ -> parse_error "unexpected close in llppconfig" s spos
924 and defaults v t spos _ =
925 match t with
926 | Vdata | Vcdata -> v
927 | Vend -> parse_error "unexpected end of input in defaults" s spos
928 | Vopen ("keymap", attrs, closed) ->
929 let modename =
930 try List.assoc "mode" attrs
931 with Not_found -> "global" in
932 if closed
933 then v
934 else
935 let ret keymap =
936 let h = findkeyhash dc modename in
937 KeyMap.iter (Hashtbl.replace h) keymap;
938 defaults
940 { v with f = pkeymap ret KeyMap.empty }
942 | Vopen (_, _, _) ->
943 parse_error "unexpected subelement in defaults" s spos
945 | Vclose "defaults" ->
946 { v with f = llppconfig }
948 | Vclose _ -> parse_error "unexpected close in defaults" s spos
950 and uifont b v t spos epos =
951 match t with
952 | Vdata | Vcdata ->
953 Buffer.add_substring b s spos (epos - spos);
955 | Vopen (_, _, _) -> parse_error "unexpected subelement in ui-font" s spos
956 | Vclose "ui-font" ->
957 if emptystr !fontpath
958 then fontpath := Buffer.contents b;
959 { v with f = llppconfig }
960 | Vclose _ -> parse_error "unexpected close in ui-font" s spos
961 | Vend -> parse_error "unexpected end of input in ui-font" s spos
963 and doc path origin pan anchor c bookmarks v t spos _ =
964 match t with
965 | Vdata | Vcdata -> v
966 | Vend -> parse_error "unexpected end of input in doc" s spos
967 | Vopen ("bookmarks", _, closed) ->
968 if closed
969 then v
970 else { v with f = pbookmarks path origin pan anchor c bookmarks }
972 | Vopen ("keymap", attrs, closed) ->
973 let modename =
974 try List.assoc "mode" attrs
975 with Not_found -> "global"
977 if closed
978 then v
979 else
980 let ret keymap =
981 let h = findkeyhash c modename in
982 KeyMap.iter (Hashtbl.replace h) keymap;
983 doc path origin pan anchor c bookmarks
985 { v with f = pkeymap ret KeyMap.empty }
987 | Vopen ("css", [], false) ->
988 { v with f = pcss path origin pan anchor c bookmarks }
990 | Vopen (_, _, _) ->
991 parse_error "unexpected subelement in doc" s spos
993 | Vclose "doc" ->
994 Hashtbl.add h path (c, List.rev bookmarks, pan, anchor, origin);
995 { v with f = llppconfig }
997 | Vclose _ -> parse_error "unexpected close in doc" s spos
999 and pcss path origin pan anchor c bookmarks v t spos epos =
1000 match t with
1001 | Vdata | Vcdata ->
1002 let b = Buffer.create 10 in
1003 Buffer.add_substring b s spos (epos - spos);
1004 { v with f = pcss path origin pan anchor
1005 { c with css = Buffer.contents b }
1006 bookmarks }
1007 | Vend -> parse_error "unexpected end of input in css" s spos
1008 | Vopen _ -> parse_error "unexpected subelement in css" s spos
1009 | Vclose "css" -> { v with f = doc path origin pan anchor c bookmarks }
1010 | Vclose _ -> parse_error "unexpected close in css" s spos
1012 and pkeymap ret keymap v t spos _ =
1013 match t with
1014 | Vdata | Vcdata -> v
1015 | Vend -> parse_error "unexpected end of input in keymap" s spos
1016 | Vopen ("map", attrs, closed) ->
1017 let r, l = map_of attrs in
1018 let kss = fromstring keys_of_string spos "in" r [] in
1019 let lss = fromstring keys_of_string spos "out" l [] in
1020 let keymap =
1021 match kss with
1022 | [] -> keymap
1023 | ks :: [] -> KeyMap.add ks (KMinsrl lss) keymap
1024 | ks :: rest -> KeyMap.add ks (KMmulti (rest, lss)) keymap
1026 if closed
1027 then { v with f = pkeymap ret keymap }
1028 else
1029 let f () = v in
1030 { v with f = skip "map" f }
1032 | Vopen _ -> parse_error "unexpected subelement in keymap" s spos
1033 | Vclose "keymap" ->
1034 { v with f = ret keymap }
1035 | Vclose _ -> parse_error "unexpected close in keymap" s spos
1037 and pbookmarks path origin pan anchor c bookmarks v t spos _ =
1038 match t with
1039 | Vdata | Vcdata -> v
1040 | Vend -> parse_error "unexpected end of input in bookmarks" s spos
1041 | Vopen ("item", attrs, closed) ->
1042 let titleent, spage, srely, svisy = bookmark_of attrs in
1043 let page = fromstring int_of_string spos "page" spage 0
1044 and rely = fromstring float_of_string spos "rely" srely 0.0
1045 and visy = fromstring float_of_string spos "visy" svisy 0.0 in
1046 let bookmarks =
1047 (unentS titleent, 0, Oanchor (page, rely, visy)) :: bookmarks
1049 if closed
1050 then { v with f = pbookmarks path origin pan anchor c bookmarks }
1051 else
1052 let f () = v in
1053 { v with f = skip "item" f }
1055 | Vopen _ -> parse_error "unexpected subelement in bookmarks" s spos
1056 | Vclose "bookmarks" ->
1057 { v with f = doc path origin pan anchor c bookmarks }
1058 | Vclose _ -> parse_error "unexpected close in bookmarks" s spos
1060 and skip tag f v t spos _ =
1061 match t with
1062 | Vdata | Vcdata -> v
1063 | Vend ->
1064 parse_error ("unexpected end of input in skipped " ^ tag) s spos
1065 | Vopen (tag', _, closed) ->
1066 if closed
1067 then v
1068 else
1069 let f' () = { v with f = skip tag f } in
1070 { v with f = skip tag' f' }
1071 | Vclose ctag ->
1072 if tag = ctag
1073 then f ()
1074 else parse_error ("unexpected close in skipped " ^ tag) s spos
1076 parse { f = toplevel; accu = () } s;
1077 h, dc;
1080 let do_load f contents =
1081 try f contents
1082 with
1083 | Parser.Parse_error (msg, s, pos) ->
1084 let subs = Parser.subs s pos in
1085 Utils.error "parse error: %s: at %d [..%S..]" msg pos subs
1087 | exn -> Utils.error "parse error: %s" @@ exntos exn
1090 let defconfpath =
1091 let dir =
1092 let xdgconfdir = Utils.getenvdef "XDG_CONFIG_HOME" E.s in
1093 if emptystr xdgconfdir
1094 then
1096 let dir = Filename.concat home ".config" in
1097 if Sys.is_directory dir then dir else home
1098 with _ -> home
1099 else xdgconfdir
1101 Filename.concat dir "llpp.conf"
1104 let confpath = ref defconfpath;;
1106 let load2 f default =
1107 match filecontents !confpath with
1108 | contents -> f @@ do_load get contents
1109 | exception Unix.Unix_error (Unix.ENOENT, "open", _) ->
1110 f (Hashtbl.create 0, defconf)
1111 | exception exn ->
1112 dolog "error loading configuration from `%S': %s" !confpath @@ exntos exn;
1113 default
1116 let load1 f = load2 f false;;
1118 let load openlast =
1119 let f (h, dc) =
1120 if openlast
1121 then (
1122 let path, _ =
1123 Hashtbl.fold
1124 (fun path (conf, _, _, _, _) ((_, besttime) as best) ->
1125 if conf.lastvisit > besttime
1126 then (path, conf.lastvisit)
1127 else best)
1129 (state.path, -.infinity)
1131 state.path <- path;
1133 let pc, pb, px, pa, po =
1134 let def = dc, [], 0, emptyanchor, state.origin in
1135 if emptystr state.path
1136 then def
1137 else
1138 let absname = abspath state.path in
1139 match Hashtbl.find h absname with
1140 | (c,b,x,a,_) -> (c,b,x,a,state.origin)
1141 | exception Not_found ->
1142 let exception E of (conf * outline list * int * anchor * string) in
1143 let key = try Digest.file absname |> Digest.to_hex with _ -> E.s in
1144 match (
1145 if nonemptystr key
1146 then
1147 Hashtbl.iter (fun p ((c, _, _, _, _) as v) ->
1148 if c.key = key
1149 then (
1150 dolog "will use %s's settings due to matching keys" p;
1151 raise (E v)
1155 with
1156 | _ -> def
1157 | exception E v -> v
1159 setconf defconf dc;
1160 setconf conf pc;
1161 state.bookmarks <- pb;
1162 state.x <- px;
1163 state.origin <- po;
1164 state.anchor <- pa;
1165 cbput state.hists.nav pa;
1166 true
1168 load1 f
1171 let gethist () =
1172 let f (h, _) =
1173 Hashtbl.fold (fun path (pc, pb, px, pa, po) accu ->
1174 (path, pc, pb, px, pa, po) :: accu)
1175 h [];
1177 load2 f []
1180 let add_attrs bb always dc c time =
1181 let o' fmt s =
1182 Buffer.add_string bb "\n ";
1183 Printf.bprintf bb fmt s
1185 let o c fmt s = if c then o' fmt s else ignore in
1186 let ob s a b = o (always || a != b) "%s='%b'" s a
1187 and op s a b = o (always || a <> b) "%s='%b'" s (a != None)
1188 and oi s a b = o (always || a != b) "%s='%d'" s a
1189 and oI s a b = o (always || a != b) "%s='%s'" s (string_with_suffix_of_int a)
1190 and oz s a b = o (always || a <> b) "%s='%g'" s (a*.100.)
1191 and oF s a b = o (always || a <> b) "%s='%f'" s a
1192 and oL s a b = o (always || a <> b) "%s='%Ld'" s a
1193 and oc s a b = o (always || a <> b) "%s='%s'" s (color_to_string a)
1194 and oA s a b = o (always || a <> b) "%s='%s'" s (rgba_to_string a)
1195 and oC s a b = o (always || a <> b) "%s='%s'" s (CSTE.to_string a)
1196 and oR s a b = o (always || a <> b) "%s='%s'" s (irect_to_string a)
1197 and oFm s a b = o (always || a <> b) "%s='%s'" s (FMTE.to_string a)
1198 and oSv s a b m =
1199 o (always || a land m <> b land m) "%s='%b'" s (a land m != 0)
1200 and oPm s a b = o (always || a <> b) "%s='%s'" s (MTE.to_string a)
1201 and os s a b =
1202 o (always || a <> b) "%s='%s'" s @@ Parser.enent a 0 (String.length a)
1203 and oco s a b =
1204 if always || a <> b
1205 then
1206 match a with
1207 | Cmulti ((n, a, b), _) when n > 1 -> o' "%s='%d,%d,%d'" s n a b
1208 | Csplit (n, _) when n > 1 -> o' "%s='%d'" s ~-n
1209 | Cmulti _ | Csplit _ | Csingle _ -> ()
1210 and obeco s a b =
1211 if always || a <> b
1212 then
1213 match a with
1214 | Some c when c > 1 -> o' "%s='%d'" s c
1215 | _ -> ()
1217 oi "width" c.cwinw dc.cwinw;
1218 oi "height" c.cwinh dc.cwinh;
1219 oi "scroll-bar-width" c.scrollbw dc.scrollbw;
1220 oi "scroll-handle-height" c.scrollh dc.scrollh;
1221 oSv "horizontal-scrollbar-visible" c.scrollb dc.scrollb scrollbhv;
1222 oSv "vertical-scrollbar-visible" c.scrollb dc.scrollb scrollbvv;
1223 ob "case-insensitive-search" c.icase dc.icase;
1224 ob "preload" c.preload dc.preload;
1225 oi "page-bias" c.pagebias dc.pagebias;
1226 oi "scroll-step" c.scrollstep dc.scrollstep;
1227 oi "auto-scroll-step" c.autoscrollstep dc.autoscrollstep;
1228 ob "max-height-fit" c.maxhfit dc.maxhfit;
1229 ob "highlight-links" c.hlinks dc.hlinks;
1230 ob "under-cursor-info" c.underinfo dc.underinfo;
1231 oi "vertical-margin" c.interpagespace dc.interpagespace;
1232 oz "zoom" c.zoom dc.zoom;
1233 ob "presentation" c.presentation dc.presentation;
1234 oi "rotation-angle" c.angle dc.angle;
1235 oFm "fit-model" c.fitmodel dc.fitmodel;
1236 oI "pixmap-cache-size" c.memlimit dc.memlimit;
1237 oi "tex-count" c.texcount dc.texcount;
1238 oi "slice-height" c.sliceheight dc.sliceheight;
1239 oi "thumbnail-width" c.thumbw dc.thumbw;
1240 oc "background-color" c.bgcolor dc.bgcolor;
1241 oA "paper-color" c.papercolor dc.papercolor;
1242 oA "scrollbar-color" c.sbarcolor dc.sbarcolor;
1243 oA "scrollbar-handle-color" c.sbarhndlcolor dc.sbarhndlcolor;
1244 oA "texture-color" c.texturecolor dc.texturecolor;
1245 oi "tile-width" c.tilew dc.tilew;
1246 oi "tile-height" c.tileh dc.tileh;
1247 oI "mupdf-store-size" c.mustoresize dc.mustoresize;
1248 ob "checkers" c.checkers dc.checkers;
1249 oi "aalevel" c.aalevel dc.aalevel;
1250 ob "trim-margins" c.trimmargins dc.trimmargins;
1251 oR "trim-fuzz" c.trimfuzz dc.trimfuzz;
1252 os "uri-launcher" c.urilauncher dc.urilauncher;
1253 os "path-launcher" c.pathlauncher dc.pathlauncher;
1254 oC "color-space" c.colorspace dc.colorspace;
1255 ob "invert-colors" c.invert dc.invert;
1256 oF "brightness" c.colorscale dc.colorscale;
1257 oco "columns" c.columns dc.columns;
1258 obeco "birds-eye-columns" c.beyecolumns dc.beyecolumns;
1259 os "selection-command" c.selcmd dc.selcmd;
1260 os "paste-command" c.pastecmd dc.pastecmd;
1261 os "synctex-command" c.stcmd dc.stcmd;
1262 os "pax-command" c.paxcmd dc.paxcmd;
1263 os "askpass-command" c.passcmd dc.passcmd;
1264 os "savepath-command" c.savecmd dc.savecmd;
1265 ob "update-cursor" c.updatecurs dc.updatecurs;
1266 oi "hint-font-size" c.hfsize dc.hfsize;
1267 oi "horizontal-scroll-step" c.hscrollstep dc.hscrollstep;
1268 oF "page-scroll-scale" c.pgscale dc.pgscale;
1269 ob "use-pbo" c.usepbo dc.usepbo;
1270 ob "wheel-scrolls-pages" c.wheelbypage dc.wheelbypage;
1271 ob "remote-in-a-new-instance" c.riani dc.riani;
1272 op "point-and-x" c.pax dc.pax;
1273 oPm "point-and-x-mark" c.paxmark dc.paxmark;
1274 ob "scroll-bar-on-the-left" c.leftscroll dc.leftscroll;
1275 if not always
1276 then os "title" c.title dc.title;
1277 oL "last-visit" (Int64.of_float time) 0L;
1278 ob "edit-annotations-inline" c.annotinline dc.annotinline;
1279 ob "coarse-presentation-positioning" c.coarseprespos dc.coarseprespos;
1280 ob "use-document-css" c.usedoccss dc.usedoccss;
1283 let keymapsbuf always dc c =
1284 let open Buffer in
1285 let bb = create 16 in
1286 let rec loop = function
1287 | [] -> ()
1288 | (modename, h) :: rest ->
1289 let dh = findkeyhash dc modename in
1290 if always || h <> dh
1291 then (
1292 if Hashtbl.length h > 0
1293 then (
1294 if length bb > 0 then add_char bb '\n';
1295 Printf.bprintf bb "<keymap mode='%s'>\n" modename;
1296 Hashtbl.iter (fun i o ->
1297 if always || match Hashtbl.find dh i
1298 with | dO -> dO <> o | exception Not_found -> false
1299 then
1300 let addkm (k, m) =
1301 if Wsi.withctrl m then add_string bb "ctrl-";
1302 if Wsi.withalt m then add_string bb "alt-";
1303 if Wsi.withshift m then add_string bb "shift-";
1304 if Wsi.withmeta m then add_string bb "meta-";
1305 add_string bb (Wsi.keyname k);
1307 let addkms l =
1308 let rec loop = function
1309 | [] -> ()
1310 | km :: [] -> addkm km
1311 | km :: rest -> addkm km; add_char bb ' '; loop rest
1313 loop l
1315 add_string bb "<map in='";
1316 addkm i;
1317 match o with
1318 | KMinsrt km ->
1319 add_string bb "' out='"; addkm km; add_string bb "'/>\n"
1321 | KMinsrl kms ->
1322 add_string bb "' out='"; addkms kms; add_string bb "'/>\n"
1324 | KMmulti (ins, kms) ->
1325 add_char bb ' '; addkms ins; add_string bb "' out='";
1326 addkms kms; add_string bb "'/>\n"
1327 ) h;
1328 add_string bb "</keymap>";
1331 loop rest
1333 loop c.keyhashes;
1337 let keystostrlist c =
1338 let rec loop accu = function
1339 | [] -> accu
1340 | (modename, h) :: rest ->
1341 let accu =
1342 if Hashtbl.length h > 0
1343 then (
1344 let accu = Printf.sprintf "\xc2\xb7Keys for %s" modename :: accu in
1345 Hashtbl.fold (fun i o a ->
1346 let bb = Buffer.create 10 in
1347 let addkm (k, m) =
1348 if Wsi.withctrl m then Buffer.add_string bb "ctrl-";
1349 if Wsi.withalt m then Buffer.add_string bb "alt-";
1350 if Wsi.withshift m then Buffer.add_string bb "shift-";
1351 if Wsi.withmeta m then Buffer.add_string bb "meta-";
1352 Buffer.add_string bb (Wsi.keyname k);
1354 let addkms l =
1355 let rec loop = function
1356 | [] -> ()
1357 | km :: [] -> addkm km
1358 | km :: rest ->
1359 addkm km; Buffer.add_char bb ' ';
1360 loop rest
1362 loop l
1364 addkm i;
1365 Buffer.add_char bb '\t';
1366 begin match o with
1367 | KMinsrt km -> addkm km
1368 | KMinsrl kms -> addkms kms
1369 | KMmulti (ins, kms) ->
1370 Buffer.add_char bb ' ';
1371 addkms ins;
1372 Buffer.add_string bb "\t";
1373 addkms kms
1374 end;
1375 Buffer.contents bb :: a
1376 ) h accu
1378 else accu
1380 loop accu rest
1382 loop [] c.keyhashes
1385 let save1 bb leavebirdseye x h dc =
1386 let uifontsize = fstate.fontsize in
1387 let dc = if conf.bedefault then conf else dc in
1388 Buffer.add_string bb "<llppconfig>\n";
1390 if nonemptystr !fontpath
1391 then Printf.bprintf bb "<ui-font size='%d'><![CDATA[%s]]></ui-font>\n"
1392 uifontsize
1393 !fontpath
1394 else
1395 if uifontsize <> 14
1396 then Printf.bprintf bb "<ui-font size='%d'/>\n" uifontsize
1399 Buffer.add_string bb "<defaults";
1400 add_attrs bb true dc dc nan;
1401 let kb = keymapsbuf true dc dc in
1402 if Buffer.length kb > 0
1403 then (
1404 Buffer.add_string bb ">\n";
1405 Buffer.add_buffer bb kb;
1406 Buffer.add_string bb "\n</defaults>\n";
1408 else Buffer.add_string bb "/>\n";
1410 let adddoc path pan anchor c bookmarks time origin =
1411 if not (bookmarks == [] && c = dc && anchor = emptyanchor)
1412 then (
1413 Printf.bprintf bb "<doc path='%s'"
1414 (Parser.enent path 0 (String.length path));
1416 if nonemptystr c.key
1417 then Printf.bprintf bb "\n key='%s'" c.key;
1419 if nonemptystr origin
1420 then Printf.bprintf bb "\n origin='%s'"
1421 (Parser.enent origin 0 (String.length origin));
1423 if anchor <> emptyanchor
1424 then (
1425 let n, rely, visy = anchor in
1426 Printf.bprintf bb "\n page='%d'" n;
1428 if rely > 1e-6
1429 then Printf.bprintf bb " rely='%f'" rely;
1431 if abs_float visy > 1e-6
1432 then Printf.bprintf bb " visy='%f'" visy;
1435 if pan != 0
1436 then Printf.bprintf bb " pan='%d'" pan;
1438 add_attrs bb false dc c time;
1439 if nonemptystr c.css
1440 then Printf.bprintf bb ">\n <css><![CDATA[%s]]></css>" c.css;
1441 let kb = keymapsbuf false dc c in
1443 begin match bookmarks with
1444 | [] ->
1445 if Buffer.length kb > 0
1446 then (
1447 Buffer.add_string bb ">\n";
1448 Buffer.add_buffer bb kb;
1449 Buffer.add_string bb "\n</doc>\n";
1451 else (
1452 if nonemptystr c.css
1453 then Buffer.add_string bb "\n</doc>\n"
1454 else Buffer.add_string bb "/>\n"
1456 | _ ->
1457 Buffer.add_string bb ">\n<bookmarks>\n";
1458 List.iter (fun (title, _, kind) ->
1459 begin match kind with
1460 | Oanchor (page, rely, visy) ->
1461 Printf.bprintf bb
1462 "<item title='%s' page='%d'"
1463 (Parser.enent title 0 (String.length title))
1464 page;
1465 if rely > 1e-6
1466 then Printf.bprintf bb " rely='%f'" rely;
1467 if abs_float visy > 1e-6
1468 then Printf.bprintf bb " visy='%f'" visy;
1470 | Ohistory _ | Onone | Ouri _ | Oremote _
1471 | Oremotedest _ | Olaunch _ -> error "unexpected link in bookmarks"
1472 end;
1473 Buffer.add_string bb "/>\n";
1474 ) bookmarks;
1475 Buffer.add_string bb "</bookmarks>";
1476 if Buffer.length kb > 0
1477 then (
1478 Buffer.add_string bb "\n";
1479 Buffer.add_buffer bb kb;
1481 Buffer.add_string bb "\n</doc>\n";
1482 end;
1486 let pan, conf =
1487 match state.mode with
1488 | Birdseye (c, pan, _, _, _) ->
1489 let beyecolumns =
1490 match conf.columns with
1491 | Cmulti ((c, _, _), _) -> Some c
1492 | Csingle _ -> None
1493 | Csplit _ -> None
1494 and columns =
1495 match c.columns with
1496 | Cmulti (c, _) -> Cmulti (c, E.a)
1497 | Csingle _ -> Csingle E.a
1498 | Csplit _ -> failwith "quit from bird's eye while split"
1500 pan, { c with beyecolumns = beyecolumns; columns = columns }
1501 | Textentry _
1502 | View
1503 | LinkNav _ -> x, conf
1505 let docpath = if nonemptystr state.path then abspath state.path else E.s in
1506 if nonemptystr docpath
1507 then (
1508 adddoc docpath pan (getanchor ())
1510 let autoscrollstep =
1511 match state.autoscroll with
1512 | Some step -> step
1513 | None -> conf.autoscrollstep
1515 begin match state.mode with
1516 | Birdseye beye -> leavebirdseye beye true
1517 | Textentry _
1518 | View
1519 | LinkNav _ -> ()
1520 end;
1521 let key = try Digest.file docpath |> Digest.to_hex
1522 with _ -> E.s in
1523 { conf with autoscrollstep; key }
1525 state.bookmarks
1526 (now ())
1527 state.origin
1529 Hashtbl.iter (fun path (c, bookmarks, x, anchor, origin) ->
1530 if docpath <> abspath path
1531 then adddoc path x anchor c bookmarks c.lastvisit origin
1532 ) h;
1533 Buffer.add_string bb "</llppconfig>\n";
1534 true;
1537 let save leavebirdseye =
1538 let relx = float state.x /. float state.winw in
1539 let w, h, x =
1540 let cx w = truncate (relx *. float w) in
1541 List.fold_left
1542 (fun (w, h, x) ws ->
1543 match ws with
1544 | Wsi.Fullscreen -> (conf.cwinw, conf.cwinh, cx conf.cwinw)
1545 | Wsi.MaxVert -> (w, conf.cwinh, x)
1546 | Wsi.MaxHorz -> (conf.cwinw, h, cx conf.cwinw)
1548 (state.winw, state.winh, state.x) state.winstate
1550 conf.cwinw <- w;
1551 conf.cwinh <- h;
1552 let bb = Buffer.create 32768 in
1553 let save2 (h, dc) = save1 bb leavebirdseye x h dc in
1554 if load1 save2 && Buffer.length bb > 0
1555 then
1557 let tmp = !confpath ^ ".tmp" in
1558 let oc = open_out_bin tmp in
1559 Buffer.output_buffer oc bb;
1560 close_out oc;
1561 Unix.rename tmp !confpath;
1562 with exn -> dolog "error saving configuration: %s" @@ exntos exn
1565 let gc () =
1566 let href = ref @@ Hashtbl.create 0 in
1567 let cref = ref defconf in
1568 let push (h, dc) =
1569 let f path v =
1570 if Sys.file_exists path
1571 then Some v
1572 else (dolog "removing entry for '%s'" path; None) in
1573 Hashtbl.filter_map_inplace f h;
1574 href := h;
1575 cref := dc;
1576 true
1578 ignore (load1 push);
1579 let bb = Buffer.create 32768 in
1580 let save2 (_h, dc) = save1 bb (fun _ _ -> ()) 0 !href dc in
1581 if load1 save2 && Buffer.length bb > 0
1582 then (
1584 let tmp = !confpath ^ ".tmp" in
1585 let oc = open_out_bin tmp in
1586 Buffer.output_buffer oc bb;
1587 close_out oc;
1588 Unix.rename tmp !confpath;
1589 with exn -> dolog "error saving configuration: %s" @@ exntos exn
1593 let logcurrently = function
1594 | Idle -> dolog "Idle"
1595 | Loading (l, gen) ->
1596 dolog "Loading %d gen=%d curgen=%d" l.pageno gen state.gen
1597 | Tiling (l, pageopaque, colorspace, angle, gen, col, row, tilew, tileh) ->
1598 dolog "Tiling %d[%d,%d] page=%s cs=%s angle=%d"
1599 l.pageno col row (~> pageopaque)
1600 (CSTE.to_string colorspace) angle;
1601 dolog "gen=(%d,%d) (%d,%d) tile=(%d,%d) (%d,%d)"
1602 angle gen conf.angle state.gen
1603 tilew tileh
1604 conf.tilew conf.tileh
1605 | Outlining _ -> dolog "outlining"
1608 let logpage l =
1609 dolog {|l %d dim=%d {
1610 WxH %dx%d
1611 vWxH %dx%d
1612 pagex,y %d,%d
1613 dispx,y %d,%d
1614 column %d
1616 l.pageno l.pagedimno
1617 l.pagew l.pageh
1618 l.pagevw l.pagevh
1619 l.pagex l.pagey
1620 l.pagedispx l.pagedispy
1621 l.pagecol