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