Refactor
[llpp/slowscroll.git] / config.ml
blob2819bcd2d5cbe426828e3ea2077bf510520f7d24
1 open Utils;;
3 external fz_version : unit -> string = "ml_fz_version";;
5 type fontstate =
6 { mutable fontsize : int
7 ; mutable wwidth : float
8 ; mutable maxrows : int
12 let fstate =
13 { fontsize = 20 * Wsi.fontsizefactor ()
14 ; wwidth = nan
15 ; maxrows = -1
19 let scrollbvv = 1;;
20 let scrollbhv = 2;;
21 let fastghyllscroll = (5,1,2);;
22 let neatghyllscroll = (10,1,9);;
24 let irect_of_string s =
25 Scanf.sscanf s "%d/%d/%d/%d" (fun x0 y0 x1 y1 -> (x0,y0,x1,y1))
28 let irect_to_string (x0,y0,x1,y1) =
29 Printf.sprintf "%d/%d/%d/%d" x0 y0 x1 y1
32 let ghyllscroll_of_string s =
33 match s with
34 | "fast" -> Some fastghyllscroll
35 | "neat" -> Some (10,1,9)
36 | "" | "none" -> None
37 | _ ->
38 let (n,a,b) as nab =
39 Scanf.sscanf s "%u,%u,%u" (fun n a b -> n, a, b) in
40 if n <= a || n <= b || a >= b
41 then error "N(%d),A(%d),B(%d) (N <= A, A < B, N <= B)" n a b;
42 Some nab
45 let ghyllscroll_to_string ((n, a, b) as nab) =
46 if nab = fastghyllscroll then "fast"
47 else if nab = neatghyllscroll then "neat"
48 else Printf.sprintf "%d,%d,%d" n a b;
51 let multicolumns_to_string (n, a, b) =
52 if a = 0 && b = 0
53 then Printf.sprintf "%d" n
54 else Printf.sprintf "%d,%d,%d" n a b;
57 let multicolumns_of_string s =
58 try
59 (int_of_string s, 0, 0)
60 with _ ->
61 Scanf.sscanf s "%u,%u,%u" (fun n a b ->
62 if a > 1 || b > 1
63 then failwith "subtly broken";
64 (n, a, b)
68 type keymap =
69 | KMinsrt of key
70 | KMinsrl of key list
71 | KMmulti of key list * key list
72 and key = int * int
73 and keyhash = (key, keymap) Hashtbl.t
74 and keystate =
75 | KSnone
76 | KSinto of (key list * key list)
77 and interpagespace = int
78 and multicolumns = multicol * pagegeom
79 and singlecolumn = pagegeom
80 and splitcolumns = columncount * pagegeom
81 and pagegeom = (pdimno * x * y * (pageno * width * height * leftx)) array
82 and multicol = columncount * covercount * covercount
83 and pdimno = int
84 and columncount = int
85 and covercount = int
86 and fitmodel = | FitWidth | FitProportional | FitPage
87 and trimmargins = bool
88 and irect = (int * int * int * int)
89 and memsize = int
90 and texcount = int
91 and sliceheight = int
92 and angle = int
93 and initparams =
94 (angle * fitmodel * trimparams * texcount * sliceheight * memsize
95 * colorspace * fontpath * trimcachepath * haspbo)
96 and width = int
97 and height = int
98 and leftx = int
99 and opaque = Opaque.t
100 and rectcolor = (float * float * float * float)
101 and pixmapsize = int
102 and gen = int
103 and top = float
104 and dtop = float
105 and fontpath = string
106 and trimcachepath = string
107 and css = string
108 and aalevel = int
109 and trimparams = (trimmargins * irect)
110 and colorspace = | Rgb | Bgr | Gray
111 and haspbo = bool
112 and usefontconfig = bool
113 and usedoccss = bool
114 and uri = string
115 and caption = string
116 and x = int
117 and y = int
118 and tilex = int
119 and tiley = int
120 and tileparams = (x * y * width * height * tilex * tiley)
121 and under =
122 | Unone
123 | Ulinkuri of string
124 | Utext of facename
125 | Uannotation of (opaque * slinkindex)
126 and slinkindex = int
127 and facename = string
128 and launchcommand = string
129 and filename = string
130 and pageno = int
131 and linkno = int
132 and destname = string
133 and mark =
134 | Mark_page
135 | Mark_block
136 | Mark_line
137 | Mark_word
138 and link =
139 | Lnotfound
140 | Lfound of int
141 and linkdir =
142 | LDfirst
143 | LDlast
144 | LDfirstvisible of (int * int * int)
145 | LDleft of int
146 | LDright of int
147 | LDdown of int
148 | LDup of int
149 and pagewithlinks =
150 | Pwlnotfound
151 | Pwl of int
152 and scrollb = int
153 and anchor = pageno * top * dtop
154 and rect = float * float * float * float * float * float * float * float
155 and infochange = | Memused | Docinfo | Pdim
158 class type uioh =
159 object
160 method display : unit
161 method key : int -> int -> uioh
162 method button : int -> bool -> int -> int -> int -> uioh
163 method multiclick : int -> int -> int -> int -> uioh
164 method motion : int -> int -> uioh
165 method pmotion : int -> int -> uioh
166 method infochanged : infochange -> unit
167 method scrollpw : (int * float * float)
168 method scrollph : (int * float * float)
169 method modehash : keyhash
170 method eformsgs : bool
171 method alwaysscrolly : bool
172 method scroll : int -> int -> uioh
173 method zoom : float -> int -> int -> unit
174 end;;
176 module type TextEnumType =
178 type t
179 val name : string
180 val names : string array
181 end;;
183 module TextEnumMake (Ten : TextEnumType) =
184 struct
185 let names = Ten.names;;
186 let to_int (t : Ten.t) = Obj.magic t;;
187 let to_string t = names.(to_int t);;
188 let of_int n : Ten.t = Obj.magic n;;
189 let of_string s =
190 let rec find i =
191 if i = Array.length names
192 then failwith ("invalid " ^ Ten.name ^ ": " ^ s)
193 else (
194 if Ten.names.(i) = s
195 then of_int i
196 else find (i+1)
198 in find 0;;
199 end;;
201 module CSTE = TextEnumMake (struct
202 type t = colorspace;;
203 let name = "colorspace";;
204 let names = [|"rgb"; "bgr"; "gray"|];;
205 end);;
207 module MTE = TextEnumMake (struct
208 type t = mark;;
209 let name = "mark";;
210 let names = [|"page"; "block"; "line"; "word"|];;
211 end);;
213 module FMTE = TextEnumMake (struct
214 type t = fitmodel;;
215 let name = "fitmodel";;
216 let names = [|"width"; "proportional"; "page"|];;
217 end);;
219 type conf =
220 { mutable scrollbw : int
221 ; mutable scrollh : int
222 ; mutable scrollb : scrollb
223 ; mutable icase : bool
224 ; mutable preload : bool
225 ; mutable pagebias : int
226 ; mutable verbose : bool
227 ; mutable debug : bool
228 ; mutable scrollstep : int
229 ; mutable hscrollstep : int
230 ; mutable maxhfit : bool
231 ; mutable crophack : bool
232 ; mutable autoscrollstep : int
233 ; mutable maxwait : float option
234 ; mutable hlinks : bool
235 ; mutable underinfo : bool
236 ; mutable interpagespace : interpagespace
237 ; mutable zoom : float
238 ; mutable presentation : bool
239 ; mutable angle : angle
240 ; mutable cwinw : int
241 ; mutable cwinh : int
242 ; mutable savebmarks : bool
243 ; mutable fitmodel : fitmodel
244 ; mutable trimmargins : trimmargins
245 ; mutable trimfuzz : irect
246 ; mutable memlimit : memsize
247 ; mutable texcount : texcount
248 ; mutable sliceheight : sliceheight
249 ; mutable thumbw : width
250 ; mutable jumpback : bool
251 ; mutable bgcolor : (float * float * float)
252 ; mutable bedefault : bool
253 ; mutable tilew : int
254 ; mutable tileh : int
255 ; mutable mustoresize : memsize
256 ; mutable checkers : bool
257 ; mutable aalevel : int
258 ; mutable urilauncher : string
259 ; mutable pathlauncher : string
260 ; mutable colorspace : colorspace
261 ; mutable invert : bool
262 ; mutable colorscale : float
263 ; mutable ghyllscroll : (int * int * int) option
264 ; mutable columns : columns
265 ; mutable beyecolumns : columncount option
266 ; mutable selcmd : string
267 ; mutable paxcmd : string
268 ; mutable passcmd : string
269 ; mutable savecmd : string
270 ; mutable updatecurs : bool
271 ; mutable keyhashes : (string * keyhash) list
272 ; mutable hfsize : int
273 ; mutable pgscale : float
274 ; mutable usepbo : bool
275 ; mutable wheelbypage : bool
276 ; mutable stcmd : string
277 ; mutable riani : bool
278 ; mutable pax : (float * int * int) ref option
279 ; mutable paxmark : mark
280 ; mutable leftscroll : bool
281 ; mutable title : string
282 ; mutable lastvisit : float
283 ; mutable annotinline : bool
284 ; mutable coarseprespos : bool
285 ; mutable css : css
286 ; mutable usedoccss : usedoccss
288 and columns =
289 | Csingle of singlecolumn
290 | Cmulti of multicolumns
291 | Csplit of splitcolumns
292 and outlinekind =
293 | Onone
294 | Oanchor of anchor
295 | Ouri of uri
296 | Olaunch of launchcommand
297 | Oremote of (filename * pageno)
298 | Oremotedest of (filename * destname)
299 | Ohistory of (filename * conf * outline list * x * anchor * filename)
300 and outline = (caption * outlinelevel * outlinekind)
301 and outlinelevel = int
304 type page =
305 { pageno : int
306 ; pagedimno : int
307 ; pagew : int
308 ; pageh : int
309 ; pagex : int
310 ; pagey : int
311 ; pagevw : int
312 ; pagevh : int
313 ; pagedispx : int
314 ; pagedispy : int
315 ; pagecol : int
319 type tile = opaque * pixmapsize * elapsed
320 and elapsed = float;;
321 type pagemapkey = pageno * gen;;
322 type tilemapkey = pageno * gen * colorspace * angle * width * height * col * row
323 and row = int
324 and col = int
325 and currently =
326 | Idle
327 | Loading of (page * gen)
328 | Tiling of (
329 page * opaque * colorspace * angle * gen * col * row * width * height
331 | Outlining of outline list
334 type mpos = int * int
335 and mstate =
336 | Msel of (mpos * mpos)
337 | Mpan of mpos
338 | Mscrolly | Mscrollx
339 | Mzoom of (buttonno * step * mpos)
340 | Mzoomrect of (mpos * mpos)
341 | Mnone
342 and buttonno = int
343 and step = int
346 type mode =
347 | Birdseye of (conf * leftx * pageno * pageno * anchor)
348 | Textentry of (textentry * onleave)
349 | View
350 | LinkNav of linktarget
351 and onleave = leavetextentrystatus -> unit
352 and leavetextentrystatus = | Cancel | Confirm
353 and helpitem = string * int * action
354 and action =
355 | Noaction
356 | Action of (uioh -> uioh)
357 and linktarget =
358 | Ltexact of (pageno * direction)
359 | Ltgendir of direction
360 | Ltnotready of (pageno * direction)
361 and direction = int (* -1, 0, 1 *)
362 and textentry = string * string * onhist option
363 * onkey * ondone * cancelonempty
364 and onkey = string -> Keys.t -> te
365 and ondone = string -> unit
366 and histcancel = unit -> unit
367 and onhist = ((histcmd -> string) * histcancel)
368 and histcmd = HCnext | HCprev | HCfirst | HClast
369 and cancelonempty = bool
370 and te =
371 | TEstop
372 | TEdone of string
373 | TEcont of string
374 | TEswitch of textentry
377 type 'a circbuf =
378 { store : 'a array
379 ; mutable rc : int
380 ; mutable wc : int
381 ; mutable len : int
385 type state =
386 { mutable ss : Unix.file_descr
387 ; mutable wsfd : Unix.file_descr
388 ; mutable stderr : Unix.file_descr
389 ; mutable errmsgs : Buffer.t
390 ; mutable newerrmsgs : bool
391 ; mutable w : int
392 ; mutable x : x
393 ; mutable y : y
394 ; mutable anchor : anchor
395 ; mutable ranchors : (string * string * anchor * string) list
396 ; mutable maxy : int
397 ; mutable layout : page list
398 ; pagemap : (pagemapkey, opaque) Hashtbl.t
399 ; tilemap : (tilemapkey, tile) Hashtbl.t
400 ; tilelru : (tilemapkey * opaque * pixmapsize) Queue.t
401 ; mutable pdims : (pageno * width * height * leftx) list
402 ; mutable pagecount : int
403 ; mutable currently : currently
404 ; mutable mstate : mstate
405 ; mutable searchpattern : string
406 ; mutable rects : (pageno * rectcolor * rect) list
407 ; mutable rects1 : (pageno * rectcolor * rect) list
408 ; prects : (pageno, float array) Hashtbl.t
409 ; mutable text : string
410 ; mutable winstate : Wsi.winstate list
411 ; mutable mode : mode
412 ; mutable uioh : uioh
413 ; mutable outlines : outline array
414 ; mutable bookmarks : outline list
415 ; mutable path : string
416 ; mutable password : string
417 ; mutable nameddest : string
418 ; mutable geomcmds : (string * ((string * (unit -> unit)) list))
419 ; mutable memused : memsize
420 ; mutable gen : gen
421 ; mutable throttle : (page list * int * float) option
422 ; mutable autoscroll : int option
423 ; mutable ghyll : (int option -> unit)
424 ; mutable help : helpitem array
425 ; mutable docinfo : (int * string) list
426 ; mutable checkerstexid : GlTex.texture_id option
427 ; hists : hists
428 ; mutable prevzoom : (float * int)
429 ; mutable progress : float
430 ; mutable redisplay : bool
431 ; mutable mpos : mpos
432 ; mutable keystate : keystate
433 ; mutable glinks : bool
434 ; mutable prevcolumns : (columns * float) option
435 ; mutable winw : int
436 ; mutable winh : int
437 ; mutable reprf : (unit -> unit)
438 ; mutable origin : string
439 ; mutable roam : (unit -> unit)
440 ; mutable bzoom : bool
441 ; mutable traw : [`float] Raw.t
442 ; mutable vraw : [`float] Raw.t
443 ; mutable lnava : (pageno * linkno) option
444 ; mutable slideshow : int
446 and hists =
447 { pat : string circbuf
448 ; pag : string circbuf
449 ; nav : anchor circbuf
450 ; sel : string circbuf
454 let emptyanchor = (0, 0.0, 0.0);;
455 let emptykeyhash = Hashtbl.create 0;;
456 let noghyll _ = ();;
457 let noreprf () = ();;
458 let noroam () = ();;
460 let nouioh : uioh = object (self)
461 method display = ()
462 method key _ _ = self
463 method multiclick _ _ _ _ = self
464 method button _ _ _ _ _ = self
465 method motion _ _ = self
466 method pmotion _ _ = self
467 method infochanged _ = ()
468 method scrollpw = (0, nan, nan)
469 method scrollph = (0, nan, nan)
470 method modehash = emptykeyhash
471 method eformsgs = false
472 method alwaysscrolly = false
473 method scroll _ _ = self
474 method zoom _ _ _ = ()
475 end;;
477 let platform_to_string = function
478 | Punknown -> "unknown"
479 | Plinux -> "Linux"
480 | Posx -> "OSX"
481 | Psun -> "Sun"
482 | Pbsd -> "BSD"
483 | Pcygwin -> "Cygwin"
486 let version () =
487 Printf.sprintf "llpp version %s, fitz %s, ocaml %s/%d bit"
488 Help.version (fz_version ()) Sys.ocaml_version Sys.word_size
491 let defconf =
492 { scrollbw = 7
493 ; scrollh = 12
494 ; scrollb = scrollbhv lor scrollbvv
495 ; icase = true
496 ; preload = true
497 ; pagebias = 0
498 ; verbose = false
499 ; debug = false
500 ; scrollstep = 24
501 ; hscrollstep = 24
502 ; maxhfit = true
503 ; crophack = false
504 ; autoscrollstep = 2
505 ; maxwait = None
506 ; hlinks = false
507 ; underinfo = false
508 ; interpagespace = 2
509 ; zoom = 1.0
510 ; presentation = false
511 ; angle = 0
512 ; cwinw = 1200
513 ; cwinh = 1000
514 ; savebmarks = true
515 ; fitmodel = FitProportional
516 ; trimmargins = false
517 ; trimfuzz = (0,0,0,0)
518 ; memlimit = 32 lsl 20
519 ; texcount = 256
520 ; sliceheight = 24
521 ; thumbw = 76
522 ; jumpback = true
523 ; bgcolor = (0.5, 0.5, 0.5)
524 ; bedefault = false
525 ; tilew = 2048
526 ; tileh = 2048
527 ; mustoresize = 256 lsl 20
528 ; checkers = true
529 ; aalevel = 8
530 ; urilauncher =
531 (match platform with
532 | Plinux | Psun | Pbsd -> "xdg-open \"%s\""
533 | Posx -> "open \"%s\""
534 | Pcygwin -> "cygstart \"%s\""
535 | Punknown -> "echo %s")
536 ; pathlauncher = "lp \"%s\""
537 ; selcmd =
538 (match platform with
539 | Plinux | Pbsd | Psun -> "xsel -i"
540 | Posx -> "pbcopy"
541 | Pcygwin -> "wsel"
542 | Punknown -> "cat")
543 ; paxcmd = "cat"
544 ; passcmd = E.s
545 ; savecmd = E.s
546 ; colorspace = Rgb
547 ; invert = false
548 ; colorscale = 1.0
549 ; ghyllscroll = None
550 ; columns = Csingle [||]
551 ; beyecolumns = None
552 ; updatecurs = true
553 ; hfsize = 12 * Wsi.fontsizefactor ()
554 ; pgscale = 1.0
555 ; usepbo = false
556 ; wheelbypage = false
557 ; stcmd = "echo SyncTex"
558 ; riani = false
559 ; pax = None
560 ; paxmark = Mark_word
561 ; leftscroll = false
562 ; title = E.s
563 ; lastvisit = 0.0
564 ; annotinline = true
565 ; coarseprespos = false
566 ; css = E.s
567 ; usedoccss = true
568 ; keyhashes =
569 let mk n = (n, Hashtbl.create 1) in
570 [ mk "global"
571 ; mk "info"
572 ; mk "help"
573 ; mk "outline"
574 ; mk "listview"
575 ; mk "birdseye"
576 ; mk "textentry"
577 ; mk "links"
578 ; mk "view"
583 let conf = { defconf with angle = defconf.angle };;
585 let gotourl url =
586 let command = Str.global_replace percentsre url conf.urilauncher in
587 try ignore @@ spawn command []
588 with exn -> dolog "failed to execute `%s': %s" command @@ exntos exn
591 let gotouri uri =
592 if emptystr conf.urilauncher
593 then dolog "%s" uri
594 else
595 match geturl uri with
596 | "" -> dolog "obtained empty url from uri %S" uri
597 | url -> gotourl url
600 let makehelp () =
601 let strings =
602 version ()
603 :: "(searching in this text works just by typing (i.e. no initial '/'))"
604 :: E.s :: Help.keys
606 List.map (fun s ->
607 match geturl s with
608 | "" -> (s, 0, Noaction)
609 | url -> (s, 0, Action (fun uioh -> gotourl url; uioh))
610 ) strings;
613 let cbnew n v =
614 { store = Array.make n v
615 ; rc = 0
616 ; wc = 0
617 ; len = 0
621 let cbcap b = Array.length b.store;;
623 let cbput b v =
624 let cap = cbcap b in
625 b.store.(b.wc) <- v;
626 b.wc <- (b.wc + 1) mod cap;
627 b.rc <- b.wc;
628 b.len <- min (b.len + 1) cap;
631 let cbempty b = b.len = 0;;
633 let cbgetg b circular dir =
634 if cbempty b
635 then b.store.(0)
636 else
637 let rc = b.rc + dir in
638 let rc =
639 if circular
640 then (
641 if rc = -1
642 then b.len-1
643 else (
644 if rc >= b.len
645 then 0
646 else rc
649 else bound rc 0 (b.len-1)
651 b.rc <- rc;
652 b.store.(rc);
655 let cbget b = cbgetg b false;;
656 let cbgetc b = cbgetg b true;;
658 let state =
659 { ss = Unix.stdin
660 ; wsfd = Unix.stdin
661 ; stderr = Unix.stderr
662 ; errmsgs = Buffer.create 0
663 ; newerrmsgs = false
664 ; x = 0
665 ; y = 0
666 ; w = 0
667 ; anchor = emptyanchor
668 ; ranchors = []
669 ; layout = []
670 ; maxy = max_int
671 ; tilelru = Queue.create ()
672 ; pagemap = Hashtbl.create 10
673 ; tilemap = Hashtbl.create 10
674 ; pdims = []
675 ; pagecount = 0
676 ; currently = Idle
677 ; mstate = Mnone
678 ; rects = []
679 ; rects1 = []
680 ; prects = Hashtbl.create 1
681 ; text = E.s
682 ; mode = View
683 ; winstate = []
684 ; searchpattern = E.s
685 ; outlines = E.a
686 ; bookmarks = []
687 ; path = E.s
688 ; password = E.s
689 ; nameddest = E.s
690 ; geomcmds = E.s, []
691 ; hists =
692 { nav = cbnew 10 emptyanchor
693 ; pat = cbnew 10 E.s
694 ; pag = cbnew 10 E.s
695 ; sel = cbnew 10 E.s
697 ; memused = 0
698 ; gen = 0
699 ; throttle = None
700 ; autoscroll = None
701 ; ghyll = noghyll
702 ; help = E.a
703 ; docinfo = []
704 ; checkerstexid = None
705 ; prevzoom = (1.0, 0)
706 ; progress = -1.0
707 ; uioh = nouioh
708 ; redisplay = true
709 ; mpos = (-1, -1)
710 ; keystate = KSnone
711 ; glinks = false
712 ; prevcolumns = None
713 ; winw = -1
714 ; winh = -1
715 ; reprf = noreprf
716 ; origin = E.s
717 ; roam = noroam
718 ; bzoom = false
719 ; traw = Raw.create_static `float ~len:8
720 ; vraw = Raw.create_static `float ~len:8
721 ; lnava = None
722 ; slideshow = 0
726 let copykeyhashes c =
727 List.map (fun (k, v) -> k, Hashtbl.copy v) c.keyhashes;
730 let calcips h =
731 let d = state.winh - h in
732 max conf.interpagespace ((d + 1) / 2)
735 let rowyh (c, coverA, coverB) b n =
736 if c = 1 || (n < coverA || n >= state.pagecount - coverB)
737 then
738 let _, _, vy, (_, _, h, _) = b.(n) in
739 (vy, h)
740 else
741 let n' = n - coverA in
742 let d = n' mod c in
743 let s = n - d in
744 let e = min state.pagecount (s + c) in
745 let rec find m miny maxh = if m = e then miny, maxh else
746 let _, _, y, (_, _, h, _) = b.(m) in
747 let miny = min miny y in
748 let maxh = max maxh h in
749 find (m+1) miny maxh
750 in find s max_int 0
753 let page_of_y y =
754 let ((c, coverA, coverB) as cl), b =
755 match conf.columns with
756 | Csingle b -> (1, 0, 0), b
757 | Cmulti (c, b) -> c, b
758 | Csplit (_, b) -> (1, 0, 0), b
760 if Array.length b = 0
761 then -1
762 else
763 let rec bsearch nmin nmax =
764 if nmin > nmax
765 then bound nmin 0 (state.pagecount-1)
766 else
767 let n = (nmax + nmin) / 2 in
768 let vy, h = rowyh cl b n in
769 let y0, y1 =
770 if conf.presentation
771 then
772 let ips = calcips h in
773 let y0 = vy - ips in
774 let y1 = vy + h + ips in
775 y0, y1
776 else (
777 if n = 0
778 then 0, vy + h + conf.interpagespace
779 else
780 let y0 = vy - conf.interpagespace in
781 y0, y0 + h + conf.interpagespace
784 if y >= y0 && y < y1
785 then (
786 if c = 1
787 then n
788 else (
789 if n > coverA
790 then
791 if n < state.pagecount - coverB
792 then ((n-coverA)/c)*c + coverA
793 else n
794 else n
797 else (
798 if y > y0
799 then bsearch (n+1) nmax
800 else bsearch nmin (n-1)
803 bsearch 0 (state.pagecount-1);
806 let calcheight () =
807 match conf.columns with
808 | Cmulti ((_, _, _) as cl, b) ->
809 if Array.length b > 0
810 then
811 let y, h = rowyh cl b (Array.length b - 1) in
812 y + h + (if conf.presentation then calcips h else 0)
813 else 0
814 | Csingle b ->
815 if Array.length b > 0
816 then
817 let (_, _, y, (_, _, h, _)) = b.(Array.length b - 1) in
818 y + h + (if conf.presentation then calcips h else 0)
819 else 0
820 | Csplit (_, b) ->
821 if Array.length b > 0
822 then
823 let (_, _, y, (_, _, h, _)) = b.(Array.length b - 1) in
824 y + h
825 else 0
828 let getpageywh pageno =
829 let pageno = bound pageno 0 (state.pagecount-1) in
830 match conf.columns with
831 | Csingle b ->
832 if Array.length b = 0
833 then 0, 0, 0
834 else
835 let (_, _, y, (_, w, h, _)) = b.(pageno) in
836 let y =
837 if conf.presentation
838 then y - calcips h
839 else y
841 y, w, h
842 | Cmulti (cl, b) ->
843 if Array.length b = 0
844 then 0, 0, 0
845 else
846 let y, h = rowyh cl b pageno in
847 let (_, _, _, (_, w, _, _)) = b.(pageno) in
848 let y =
849 if conf.presentation
850 then y - calcips h
851 else y
853 y, w, h
854 | Csplit (c, b) ->
855 if Array.length b = 0
856 then 0, 0, 0
857 else
858 let n = pageno*c in
859 let (_, _, y, (_, w, h, _)) = b.(n) in
860 y, w / c, h
863 let getpageyh pageno =
864 let y,_,h = getpageywh pageno in
865 y, h;
868 let getpagedim pageno =
869 let rec f ppdim l =
870 match l with
871 | (n, _, _, _) as pdim :: rest ->
872 if n >= pageno
873 then (if n = pageno then pdim else ppdim)
874 else f pdim rest
876 | [] -> ppdim
878 f (-1, -1, -1, -1) state.pdims
881 let getpdimno pageno =
882 let rec f p l =
883 let np = succ p in
884 match l with
885 | (n, _, _, _) :: rest ->
886 if n >= pageno
887 then (if n = pageno then np else p)
888 else f np rest
890 | [] -> p
892 f ~-1 state.pdims
895 let getpagey pageno = fst (getpageyh pageno);;
897 let getanchor1 l =
898 let top =
899 let coloff = l.pagecol * l.pageh in
900 float (l.pagey + coloff) /. float l.pageh
902 let dtop =
903 if l.pagedispy = 0
904 then
906 else (
907 if conf.presentation
908 then float l.pagedispy /. float (calcips l.pageh)
909 else float l.pagedispy /. float conf.interpagespace
912 (l.pageno, top, dtop)
915 let getanchor () =
916 match state.layout with
917 | l :: _ -> getanchor1 l
918 | [] ->
919 let n = page_of_y state.y in
920 if n = -1
921 then state.anchor
922 else
923 let y, h = getpageyh n in
924 let dy = y - state.y in
925 let dtop =
926 if conf.presentation
927 then
928 let ips = calcips h in
929 float (dy + ips) /. float ips
930 else
931 float dy /. float conf.interpagespace
933 (n, 0.0, dtop)
936 let fontpath = ref E.s;;
938 type historder = [ `lastvisit | `title | `path | `file ];;
940 module KeyMap =
941 Map.Make (struct type t = (int * int) let compare = compare end);;
943 let unentS s =
944 let l = String.length s in
945 let b = Buffer.create l in
946 Parser.unent b s 0 l;
947 Buffer.contents b;
950 let home =
951 try Sys.getenv "HOME"
952 with exn ->
953 dolog "cannot determine home directory location: %s" @@ exntos exn;
957 let modifier_of_string = function
958 | "alt" -> Wsi.altmask
959 | "shift" -> Wsi.shiftmask
960 | "ctrl" | "control" -> Wsi.ctrlmask
961 | "meta" -> Wsi.metamask
962 | _ -> 0
965 let keys_of_string s =
966 let key_of_string r s =
967 let elems = Str.full_split r s in
968 let f n k m =
969 let g s =
970 let m1 = modifier_of_string s in
971 if m1 = 0
972 then (Wsi.namekey s, m)
973 else (k, m lor m1)
974 in function
975 | Str.Delim s when n land 1 = 0 -> g s
976 | Str.Text s -> g s
977 | Str.Delim _ -> (k, m)
979 let rec loop n k m = function
980 | [] -> (k, m)
981 | x :: xs ->
982 let k, m = f n k m x in
983 loop (n+1) k m xs
985 loop 0 0 0 elems
987 let elems = Str.split whitere s in
988 List.map (key_of_string (Str.regexp "-")) elems
991 let config_of c attrs =
992 let apply c k v =
994 match k with
995 | "scroll-bar-width" -> { c with scrollbw = max 0 (int_of_string v) }
996 | "scroll-handle-height" -> { c with scrollh = max 0 (int_of_string v) }
997 | "case-insensitive-search" -> { c with icase = bool_of_string v }
998 | "preload" -> { c with preload = bool_of_string v }
999 | "page-bias" -> { c with pagebias = int_of_string v }
1000 | "scroll-step" -> { c with scrollstep = max 1 (int_of_string v) }
1001 | "horizontal-scroll-step" ->
1002 { c with hscrollstep = max (int_of_string v) 1 }
1003 | "auto-scroll-step" ->
1004 { c with autoscrollstep = max 0 (int_of_string v) }
1005 | "max-height-fit" -> { c with maxhfit = bool_of_string v }
1006 | "crop-hack" -> { c with crophack = bool_of_string v }
1007 | "throttle" ->
1008 let mw =
1009 match String.map asciilower v with
1010 | "true" -> Some infinity
1011 | "false" -> None
1012 | f -> Some (float_of_string f)
1014 { c with maxwait = mw }
1015 | "highlight-links" -> { c with hlinks = bool_of_string v }
1016 | "under-cursor-info" -> { c with underinfo = bool_of_string v }
1017 | "vertical-margin" ->
1018 { c with interpagespace = max 0 (int_of_string v) }
1019 | "zoom" ->
1020 let zoom = float_of_string v /. 100. in
1021 let zoom = max zoom 0.0 in
1022 { c with zoom = zoom }
1023 | "presentation" -> { c with presentation = bool_of_string v }
1024 | "rotation-angle" -> { c with angle = int_of_string v }
1025 | "width" -> { c with cwinw = max 20 (int_of_string v) }
1026 | "height" -> { c with cwinh = max 20 (int_of_string v) }
1027 | "persistent-bookmarks" -> { c with savebmarks = bool_of_string v }
1028 | "proportional-display" ->
1029 let fm =
1030 if bool_of_string v
1031 then FitProportional
1032 else FitWidth
1034 { c with fitmodel = fm }
1035 | "fit-model" -> { c with fitmodel = FMTE.of_string v }
1036 | "pixmap-cache-size" ->
1037 { c with memlimit = max 2 (int_of_string_with_suffix v) }
1038 | "tex-count" -> { c with texcount = max 1 (int_of_string v) }
1039 | "slice-height" -> { c with sliceheight = max 2 (int_of_string v) }
1040 | "thumbnail-width" -> { c with thumbw = max 2 (int_of_string v) }
1041 | "persistent-location" -> { c with jumpback = bool_of_string v }
1042 | "background-color" -> { c with bgcolor = color_of_string v }
1043 | "tile-width" -> { c with tilew = max 2 (int_of_string v) }
1044 | "tile-height" -> { c with tileh = max 2 (int_of_string v) }
1045 | "mupdf-store-size" ->
1046 { c with mustoresize = max 1024 (int_of_string_with_suffix v) }
1047 | "checkers" -> { c with checkers = bool_of_string v }
1048 | "aalevel" -> { c with aalevel = max 0 (int_of_string v) }
1049 | "trim-margins" -> { c with trimmargins = bool_of_string v }
1050 | "trim-fuzz" -> { c with trimfuzz = irect_of_string v }
1051 | "uri-launcher" -> { c with urilauncher = unentS v }
1052 | "path-launcher" -> { c with pathlauncher = unentS v }
1053 | "color-space" -> { c with colorspace = CSTE.of_string v }
1054 | "invert-colors" -> { c with invert = bool_of_string v }
1055 | "brightness" -> { c with colorscale = float_of_string v }
1056 | "ghyllscroll" -> { c with ghyllscroll = ghyllscroll_of_string v }
1057 | "columns" ->
1058 let (n, _, _) as nab = multicolumns_of_string v in
1059 if n < 0
1060 then { c with columns = Csplit (-n, E.a) }
1061 else { c with columns = Cmulti (nab, E.a) }
1062 | "birds-eye-columns" ->
1063 { c with beyecolumns = Some (max (int_of_string v) 2) }
1064 | "selection-command" -> { c with selcmd = unentS v }
1065 | "synctex-command" -> { c with stcmd = unentS v }
1066 | "pax-command" -> { c with paxcmd = unentS v }
1067 | "askpass-command" -> { c with passcmd = unentS v }
1068 | "savepath-command" -> { c with savecmd = unentS v }
1069 | "update-cursor" -> { c with updatecurs = bool_of_string v }
1070 | "hint-font-size" -> { c with hfsize = bound (int_of_string v) 5 100 }
1071 | "page-scroll-scale" -> { c with pgscale = float_of_string v }
1072 | "use-pbo" -> { c with usepbo = bool_of_string v }
1073 | "wheel-scrolls-pages" -> { c with wheelbypage = bool_of_string v }
1074 | "horizontal-scrollbar-visible" ->
1075 let b =
1076 if bool_of_string v
1077 then c.scrollb lor scrollbhv
1078 else c.scrollb land (lnot scrollbhv)
1080 { c with scrollb = b }
1081 | "vertical-scrollbar-visible" ->
1082 let b =
1083 if bool_of_string v
1084 then c.scrollb lor scrollbvv
1085 else c.scrollb land (lnot scrollbvv)
1087 { c with scrollb = b }
1088 | "remote-in-a-new-instance" -> { c with riani = bool_of_string v }
1089 | "point-and-x" ->
1090 { c with pax =
1091 if bool_of_string v
1092 then Some (ref (0.0, 0, 0))
1093 else None }
1094 | "point-and-x-mark" -> { c with paxmark = MTE.of_string v }
1095 | "scroll-bar-on-the-left" -> { c with leftscroll = bool_of_string v }
1096 | "title" -> { c with title = unentS v }
1097 | "last-visit" -> { c with lastvisit = float_of_string v }
1098 | "edit-annotations-inline" -> { c with annotinline = bool_of_string v }
1099 | "coarse-presentation-positioning" ->
1100 { c with coarseprespos = bool_of_string v }
1101 | "use-document-css" -> { c with usedoccss = bool_of_string v }
1102 | _ -> c
1103 with exn ->
1104 dolog "error processing attribute (`%S' = `%S'): %s" k v @@ exntos exn;
1107 let rec fold c = function
1108 | [] -> c
1109 | (k, v) :: rest ->
1110 let c = apply c k v in
1111 fold c rest
1113 fold { c with keyhashes = copykeyhashes c } attrs;
1116 let fromstring f pos n v d =
1117 try f v
1118 with exn ->
1119 dolog "error processing attribute (%S=%S) at %d\n%s" n v pos @@ exntos exn;
1123 let bookmark_of attrs =
1124 let rec fold title page rely visy = function
1125 | ("title", v) :: rest -> fold v page rely visy rest
1126 | ("page", v) :: rest -> fold title v rely visy rest
1127 | ("rely", v) :: rest -> fold title page v visy rest
1128 | ("visy", v) :: rest -> fold title page rely v rest
1129 | _ :: rest -> fold title page rely visy rest
1130 | [] -> title, page, rely, visy
1132 fold "invalid" "0" "0" "0" attrs
1135 let doc_of attrs =
1136 let rec fold path page rely pan visy origin = function
1137 | ("path", v) :: rest -> fold v page rely pan visy origin rest
1138 | ("page", v) :: rest -> fold path v rely pan visy origin rest
1139 | ("rely", v) :: rest -> fold path page v pan visy origin rest
1140 | ("pan", v) :: rest -> fold path page rely v visy origin rest
1141 | ("visy", v) :: rest -> fold path page rely pan v origin rest
1142 | ("origin", v) :: rest -> fold path page rely pan visy v rest
1143 | _ :: rest -> fold path page rely pan visy origin rest
1144 | [] -> path, page, rely, pan, visy, origin
1146 fold E.s "0" "0" "0" "0" E.s attrs
1149 let map_of attrs =
1150 let rec fold rs ls = function
1151 | ("out", v) :: rest -> fold v ls rest
1152 | ("in", v) :: rest -> fold rs v rest
1153 | _ :: rest -> fold ls rs rest
1154 | [] -> ls, rs
1156 fold E.s E.s attrs
1159 let setconf dst src =
1160 dst.scrollbw <- src.scrollbw;
1161 dst.scrollh <- src.scrollh;
1162 dst.icase <- src.icase;
1163 dst.preload <- src.preload;
1164 dst.pagebias <- src.pagebias;
1165 dst.verbose <- src.verbose;
1166 dst.scrollstep <- src.scrollstep;
1167 dst.maxhfit <- src.maxhfit;
1168 dst.crophack <- src.crophack;
1169 dst.autoscrollstep <- src.autoscrollstep;
1170 dst.maxwait <- src.maxwait;
1171 dst.hlinks <- src.hlinks;
1172 dst.underinfo <- src.underinfo;
1173 dst.interpagespace <- src.interpagespace;
1174 dst.zoom <- src.zoom;
1175 dst.presentation <- src.presentation;
1176 dst.angle <- src.angle;
1177 dst.cwinw <- src.cwinw;
1178 dst.cwinh <- src.cwinh;
1179 dst.savebmarks <- src.savebmarks;
1180 dst.memlimit <- src.memlimit;
1181 dst.fitmodel <- src.fitmodel;
1182 dst.texcount <- src.texcount;
1183 dst.sliceheight <- src.sliceheight;
1184 dst.thumbw <- src.thumbw;
1185 dst.jumpback <- src.jumpback;
1186 dst.bgcolor <- src.bgcolor;
1187 dst.tilew <- src.tilew;
1188 dst.tileh <- src.tileh;
1189 dst.mustoresize <- src.mustoresize;
1190 dst.checkers <- src.checkers;
1191 dst.aalevel <- src.aalevel;
1192 dst.trimmargins <- src.trimmargins;
1193 dst.trimfuzz <- src.trimfuzz;
1194 dst.urilauncher <- src.urilauncher;
1195 dst.colorspace <- src.colorspace;
1196 dst.invert <- src.invert;
1197 dst.colorscale <- src.colorscale;
1198 dst.ghyllscroll <- src.ghyllscroll;
1199 dst.columns <- src.columns;
1200 dst.beyecolumns <- src.beyecolumns;
1201 dst.selcmd <- src.selcmd;
1202 dst.updatecurs <- src.updatecurs;
1203 dst.pathlauncher <- src.pathlauncher;
1204 dst.keyhashes <- copykeyhashes src;
1205 dst.hfsize <- src.hfsize;
1206 dst.hscrollstep <- src.hscrollstep;
1207 dst.pgscale <- src.pgscale;
1208 dst.usepbo <- src.usepbo;
1209 dst.wheelbypage <- src.wheelbypage;
1210 dst.stcmd <- src.stcmd;
1211 dst.paxcmd <- src.paxcmd;
1212 dst.passcmd <- src.passcmd;
1213 dst.savecmd <- src.savecmd;
1214 dst.scrollb <- src.scrollb;
1215 dst.riani <- src.riani;
1216 dst.paxmark <- src.paxmark;
1217 dst.leftscroll <- src.leftscroll;
1218 dst.title <- src.title;
1219 dst.annotinline <- src.annotinline;
1220 dst.coarseprespos <- src.coarseprespos;
1221 dst.css <- src.css;
1222 dst.usedoccss <- src.usedoccss;
1223 dst.pax <-
1224 if src.pax = None
1225 then None
1226 else Some ((ref (0.0, 0, 0)));
1229 let findkeyhash c name =
1230 try List.assoc name c.keyhashes
1231 with Not_found -> failwith ("invalid mode name `" ^ name ^ "'")
1234 let get s =
1235 let open Parser in
1236 let h = Hashtbl.create 10 in
1237 let dc = { defconf with angle = defconf.angle } in
1238 let rec toplevel v t spos _ =
1239 match t with
1240 | Vdata | Vcdata | Vend -> v
1241 | Vopen ("llppconfig", _, closed) ->
1242 if closed
1243 then v
1244 else { v with f = llppconfig }
1245 | Vopen _ -> parse_error "unexpected subelement at top level" s spos
1246 | Vclose _ -> parse_error "unexpected close at top level" s spos
1248 and llppconfig v t spos _ =
1249 match t with
1250 | Vdata | Vcdata -> v
1251 | Vend -> parse_error "unexpected end of input in llppconfig" s spos
1252 | Vopen ("defaults", attrs, closed) ->
1253 let c = config_of dc attrs in
1254 setconf dc c;
1255 if closed
1256 then v
1257 else { v with f = defaults }
1259 | Vopen ("ui-font", attrs, closed) ->
1260 let rec getsize size = function
1261 | [] -> size
1262 | ("size", v) :: rest ->
1263 let size =
1264 fromstring int_of_string spos "size" v fstate.fontsize in
1265 getsize size rest
1266 | l -> getsize size l
1268 fstate.fontsize <- getsize fstate.fontsize attrs;
1269 if closed
1270 then v
1271 else { v with f = uifont (Buffer.create 10) }
1273 | Vopen ("doc", attrs, closed) ->
1274 let pathent, spage, srely, span, svisy, origin = doc_of attrs in
1275 let path = unentS pathent
1276 and origin = unentS origin
1277 and pageno = fromstring int_of_string spos "page" spage 0
1278 and rely = fromstring float_of_string spos "rely" srely 0.0
1279 and pan = fromstring int_of_string spos "pan" span 0
1280 and visy = fromstring float_of_string spos "visy" svisy 0.0 in
1281 let c = config_of dc attrs in
1282 let anchor = (pageno, rely, visy) in
1283 if closed
1284 then (Hashtbl.add h path (c, [], pan, anchor, origin); v)
1285 else { v with f = doc path origin pan anchor c [] }
1287 | Vopen _ ->
1288 parse_error "unexpected subelement in llppconfig" s spos
1290 | Vclose "llppconfig" -> { v with f = toplevel }
1291 | Vclose _ -> parse_error "unexpected close in llppconfig" s spos
1293 and defaults v t spos _ =
1294 match t with
1295 | Vdata | Vcdata -> v
1296 | Vend -> parse_error "unexpected end of input in defaults" s spos
1297 | Vopen ("keymap", attrs, closed) ->
1298 let modename =
1299 try List.assoc "mode" attrs
1300 with Not_found -> "global" in
1301 if closed
1302 then v
1303 else
1304 let ret keymap =
1305 let h = findkeyhash dc modename in
1306 KeyMap.iter (Hashtbl.replace h) keymap;
1307 defaults
1309 { v with f = pkeymap ret KeyMap.empty }
1311 | Vopen (_, _, _) ->
1312 parse_error "unexpected subelement in defaults" s spos
1314 | Vclose "defaults" ->
1315 { v with f = llppconfig }
1317 | Vclose _ -> parse_error "unexpected close in defaults" s spos
1319 and uifont b v t spos epos =
1320 match t with
1321 | Vdata | Vcdata ->
1322 Buffer.add_substring b s spos (epos - spos);
1324 | Vopen (_, _, _) ->
1325 parse_error "unexpected subelement in ui-font" s spos
1326 | Vclose "ui-font" ->
1327 if emptystr !fontpath
1328 then fontpath := Buffer.contents b;
1329 { v with f = llppconfig }
1330 | Vclose _ -> parse_error "unexpected close in ui-font" s spos
1331 | Vend -> parse_error "unexpected end of input in ui-font" s spos
1333 and doc path origin pan anchor c bookmarks v t spos _ =
1334 match t with
1335 | Vdata | Vcdata -> v
1336 | Vend -> parse_error "unexpected end of input in doc" s spos
1337 | Vopen ("bookmarks", _, closed) ->
1338 if closed
1339 then v
1340 else { v with f = pbookmarks path origin pan anchor c bookmarks }
1342 | Vopen ("keymap", attrs, closed) ->
1343 let modename =
1344 try List.assoc "mode" attrs
1345 with Not_found -> "global"
1347 if closed
1348 then v
1349 else
1350 let ret keymap =
1351 let h = findkeyhash c modename in
1352 KeyMap.iter (Hashtbl.replace h) keymap;
1353 doc path origin pan anchor c bookmarks
1355 { v with f = pkeymap ret KeyMap.empty }
1357 | Vopen ("css", [], false) ->
1358 { v with f = pcss path origin pan anchor c bookmarks }
1360 | Vopen (_, _, _) ->
1361 parse_error "unexpected subelement in doc" s spos
1363 | Vclose "doc" ->
1364 Hashtbl.add h path (c, List.rev bookmarks, pan, anchor, origin);
1365 { v with f = llppconfig }
1367 | Vclose _ -> parse_error "unexpected close in doc" s spos
1369 and pcss path origin pan anchor c bookmarks v t spos epos =
1370 match t with
1371 | Vdata | Vcdata ->
1372 let b = Buffer.create 10 in
1373 Buffer.add_substring b s spos (epos - spos);
1374 { v with f = pcss path origin pan anchor
1375 { c with css = Buffer.contents b }
1376 bookmarks }
1377 | Vend -> parse_error "unexpected end of input in css" s spos
1378 | Vopen _ -> parse_error "unexpected subelement in css" s spos
1379 | Vclose "css" -> { v with f = doc path origin pan anchor c bookmarks }
1380 | Vclose _ -> parse_error "unexpected close in css" s spos
1382 and pkeymap ret keymap v t spos _ =
1383 match t with
1384 | Vdata | Vcdata -> v
1385 | Vend -> parse_error "unexpected end of input in keymap" s spos
1386 | Vopen ("map", attrs, closed) ->
1387 let r, l = map_of attrs in
1388 let kss = fromstring keys_of_string spos "in" r [] in
1389 let lss = fromstring keys_of_string spos "out" l [] in
1390 let keymap =
1391 match kss with
1392 | [] -> keymap
1393 | ks :: [] -> KeyMap.add ks (KMinsrl lss) keymap
1394 | ks :: rest -> KeyMap.add ks (KMmulti (rest, lss)) keymap
1396 if closed
1397 then { v with f = pkeymap ret keymap }
1398 else
1399 let f () = v in
1400 { v with f = skip "map" f }
1402 | Vopen _ ->
1403 parse_error "unexpected subelement in keymap" s spos
1405 | Vclose "keymap" ->
1406 { v with f = ret keymap }
1408 | Vclose _ -> parse_error "unexpected close in keymap" s spos
1410 and pbookmarks path origin pan anchor c bookmarks v t spos _ =
1411 match t with
1412 | Vdata | Vcdata -> v
1413 | Vend -> parse_error "unexpected end of input in bookmarks" s spos
1414 | Vopen ("item", attrs, closed) ->
1415 let titleent, spage, srely, svisy = bookmark_of attrs in
1416 let page = fromstring int_of_string spos "page" spage 0
1417 and rely = fromstring float_of_string spos "rely" srely 0.0
1418 and visy = fromstring float_of_string spos "visy" svisy 0.0 in
1419 let bookmarks =
1420 (unentS titleent, 0, Oanchor (page, rely, visy)) :: bookmarks
1422 if closed
1423 then { v with f = pbookmarks path origin pan anchor c bookmarks }
1424 else
1425 let f () = v in
1426 { v with f = skip "item" f }
1428 | Vopen _ ->
1429 parse_error "unexpected subelement in bookmarks" s spos
1431 | Vclose "bookmarks" ->
1432 { v with f = doc path origin pan anchor c bookmarks }
1434 | Vclose _ -> parse_error "unexpected close in bookmarks" s spos
1436 and skip tag f v t spos _ =
1437 match t with
1438 | Vdata | Vcdata -> v
1439 | Vend ->
1440 parse_error ("unexpected end of input in skipped " ^ tag) s spos
1441 | Vopen (tag', _, closed) ->
1442 if closed
1443 then v
1444 else
1445 let f' () = { v with f = skip tag f } in
1446 { v with f = skip tag' f' }
1447 | Vclose ctag ->
1448 if tag = ctag
1449 then f ()
1450 else parse_error ("unexpected close in skipped " ^ tag) s spos
1453 parse { f = toplevel; accu = () } s;
1454 h, dc;
1457 let do_load f contents =
1458 try f contents
1459 with
1460 | Parser.Parse_error (msg, s, pos) ->
1461 let subs = Parser.subs s pos in
1462 Utils.error "parse error: %s: at %d [..%S..]" msg pos subs
1464 | exn -> Utils.error "parse error: %s" @@ exntos exn
1467 let defconfpath =
1468 let dir =
1469 let xdgconfdir = Utils.getenvwithdef "XDG_CONFIG_HOME" E.s in
1470 if emptystr xdgconfdir
1471 then
1473 let dir = Filename.concat home ".config" in
1474 if Sys.is_directory dir then dir else home
1475 with _ -> home
1476 else xdgconfdir
1478 Filename.concat dir "llpp.conf"
1481 let confpath = ref defconfpath;;
1483 let load2 f default =
1484 match filecontents !confpath with
1485 | contents -> f @@ do_load get contents
1486 | exception Unix.Unix_error (Unix.ENOENT, "open", _) ->
1487 f (Hashtbl.create 0, defconf)
1488 | exception exn ->
1489 dolog "error loading configuration from `%S': %s" !confpath @@ exntos exn;
1490 default
1493 let load1 f = load2 f false;;
1495 let load openlast =
1496 let f (h, dc) =
1497 if openlast
1498 then (
1499 let path, _ =
1500 Hashtbl.fold
1501 (fun path (conf, _, _, _, _) ((_, besttime) as best) ->
1502 if conf.lastvisit > besttime
1503 then (path, conf.lastvisit)
1504 else best)
1506 (state.path, -.infinity)
1508 state.path <- path;
1510 let pc, pb, px, pa, po =
1512 let absname = abspath state.path in
1513 Hashtbl.find h absname
1514 with Not_found -> dc, [], 0, emptyanchor, state.origin
1516 setconf defconf dc;
1517 setconf conf pc;
1518 state.bookmarks <- pb;
1519 state.x <- px;
1520 state.origin <- po;
1521 if conf.jumpback
1522 then state.anchor <- pa;
1523 cbput state.hists.nav pa;
1524 true
1526 load1 f
1529 let gethist () =
1530 let f (h, _) =
1531 Hashtbl.fold (fun path (pc, pb, px, pa, po) accu ->
1532 (path, pc, pb, px, pa, po) :: accu)
1533 h [];
1535 load2 f []
1538 let add_attrs bb always dc c time =
1539 let o' fmt s =
1540 Buffer.add_string bb "\n ";
1541 Printf.bprintf bb fmt s
1543 let o c fmt s = if c then o' fmt s else ignore in
1544 let ob s a b = o (always || a != b) "%s='%b'" s a
1545 and op s a b = o (always || a <> b) "%s='%b'" s (a != None)
1546 and oi s a b = o (always || a != b) "%s='%d'" s a
1547 and oI s a b = o (always || a != b) "%s='%s'" s (string_with_suffix_of_int a)
1548 and oz s a b = o (always || a <> b) "%s='%g'" s (a*.100.)
1549 and oF s a b = o (always || a <> b) "%s='%f'" s a
1550 and oL s a b = o (always || a <> b) "%s='%Ld'" s a
1551 and oc s a b = o (always || a <> b) "%s='%s'" s (color_to_string a)
1552 and oC s a b = o (always || a <> b) "%s='%s'" s (CSTE.to_string a)
1553 and oR s a b = o (always || a <> b) "%s='%s'" s (irect_to_string a)
1554 and oFm s a b = o (always || a <> b) "%s='%s'" s (FMTE.to_string a)
1555 and oSv s a b m =
1556 o (always || a land m <> b land m) "%s='%b'" s (a land m != 0)
1557 and oPm s a b = o (always || a <> b) "%s='%s'" s (MTE.to_string a)
1558 and os s a b =
1559 o (always || a <> b) "%s='%s'" s @@ Parser.enent a 0 (String.length a)
1560 and og s a b =
1561 if always || a <> b
1562 then
1563 match a with
1564 | Some (_N, _A, _B) -> o' "%s='%u,%u,%u'" s _N _A _B
1565 | None ->
1566 match b with
1567 | None -> ()
1568 | _ -> o' "%s='none'" s
1569 and oW s a b =
1570 if always || a <> b
1571 then
1572 let v =
1573 match a with
1574 | None -> "false"
1575 | Some f ->
1576 if f = infinity
1577 then "true"
1578 else string_of_float f
1580 o' "%s='%s'" s v
1581 and oco s a b =
1582 if always || a <> b
1583 then
1584 match a with
1585 | Cmulti ((n, a, b), _) when n > 1 -> o' "%s='%d,%d,%d'" s n a b
1586 | Csplit (n, _) when n > 1 -> o' "%s='%d'" s ~-n
1587 | Cmulti _ | Csplit _ | Csingle _ -> ()
1588 and obeco s a b =
1589 if always || a <> b
1590 then
1591 match a with
1592 | Some c when c > 1 -> o' "%s='%d'" s c
1593 | _ -> ()
1595 oi "width" c.cwinw dc.cwinw;
1596 oi "height" c.cwinh dc.cwinh;
1597 oi "scroll-bar-width" c.scrollbw dc.scrollbw;
1598 oi "scroll-handle-height" c.scrollh dc.scrollh;
1599 oSv "horizontal-scrollbar-visible" c.scrollb dc.scrollb scrollbhv;
1600 oSv "vertical-scrollbar-visible" c.scrollb dc.scrollb scrollbvv;
1601 ob "case-insensitive-search" c.icase dc.icase;
1602 ob "preload" c.preload dc.preload;
1603 oi "page-bias" c.pagebias dc.pagebias;
1604 oi "scroll-step" c.scrollstep dc.scrollstep;
1605 oi "auto-scroll-step" c.autoscrollstep dc.autoscrollstep;
1606 ob "max-height-fit" c.maxhfit dc.maxhfit;
1607 ob "crop-hack" c.crophack dc.crophack;
1608 oW "throttle" c.maxwait dc.maxwait;
1609 ob "highlight-links" c.hlinks dc.hlinks;
1610 ob "under-cursor-info" c.underinfo dc.underinfo;
1611 oi "vertical-margin" c.interpagespace dc.interpagespace;
1612 oz "zoom" c.zoom dc.zoom;
1613 ob "presentation" c.presentation dc.presentation;
1614 oi "rotation-angle" c.angle dc.angle;
1615 ob "persistent-bookmarks" c.savebmarks dc.savebmarks;
1616 oFm "fit-model" c.fitmodel dc.fitmodel;
1617 oI "pixmap-cache-size" c.memlimit dc.memlimit;
1618 oi "tex-count" c.texcount dc.texcount;
1619 oi "slice-height" c.sliceheight dc.sliceheight;
1620 oi "thumbnail-width" c.thumbw dc.thumbw;
1621 ob "persistent-location" c.jumpback dc.jumpback;
1622 oc "background-color" c.bgcolor dc.bgcolor;
1623 oi "tile-width" c.tilew dc.tilew;
1624 oi "tile-height" c.tileh dc.tileh;
1625 oI "mupdf-store-size" c.mustoresize dc.mustoresize;
1626 ob "checkers" c.checkers dc.checkers;
1627 oi "aalevel" c.aalevel dc.aalevel;
1628 ob "trim-margins" c.trimmargins dc.trimmargins;
1629 oR "trim-fuzz" c.trimfuzz dc.trimfuzz;
1630 os "uri-launcher" c.urilauncher dc.urilauncher;
1631 os "path-launcher" c.pathlauncher dc.pathlauncher;
1632 oC "color-space" c.colorspace dc.colorspace;
1633 ob "invert-colors" c.invert dc.invert;
1634 oF "brightness" c.colorscale dc.colorscale;
1635 og "ghyllscroll" c.ghyllscroll dc.ghyllscroll;
1636 oco "columns" c.columns dc.columns;
1637 obeco "birds-eye-columns" c.beyecolumns dc.beyecolumns;
1638 os "selection-command" c.selcmd dc.selcmd;
1639 os "synctex-command" c.stcmd dc.stcmd;
1640 os "pax-command" c.paxcmd dc.paxcmd;
1641 os "askpass-command" c.passcmd dc.passcmd;
1642 os "savepath-command" c.savecmd dc.savecmd;
1643 ob "update-cursor" c.updatecurs dc.updatecurs;
1644 oi "hint-font-size" c.hfsize dc.hfsize;
1645 oi "horizontal-scroll-step" c.hscrollstep dc.hscrollstep;
1646 oF "page-scroll-scale" c.pgscale dc.pgscale;
1647 ob "use-pbo" c.usepbo dc.usepbo;
1648 ob "wheel-scrolls-pages" c.wheelbypage dc.wheelbypage;
1649 ob "remote-in-a-new-instance" c.riani dc.riani;
1650 op "point-and-x" c.pax dc.pax;
1651 oPm "point-and-x-mark" c.paxmark dc.paxmark;
1652 ob "scroll-bar-on-the-left" c.leftscroll dc.leftscroll;
1653 if not always
1654 then os "title" c.title dc.title;
1655 oL "last-visit" (Int64.of_float time) 0L;
1656 ob "edit-annotations-inline" c.annotinline dc.annotinline;
1657 ob "coarse-presentation-positioning" c.coarseprespos dc.coarseprespos;
1658 ob "use-document-css" c.usedoccss dc.usedoccss;
1661 let keymapsbuf always dc c =
1662 let open Buffer in
1663 let bb = create 16 in
1664 let rec loop = function
1665 | [] -> ()
1666 | (modename, h) :: rest ->
1667 let dh = findkeyhash dc modename in
1668 if always || h <> dh
1669 then (
1670 if Hashtbl.length h > 0
1671 then (
1672 if length bb > 0 then add_char bb '\n';
1673 Printf.bprintf bb "<keymap mode='%s'>\n" modename;
1674 Hashtbl.iter (fun i o ->
1675 if always || match Hashtbl.find dh i
1676 with | dO -> dO <> o | exception Not_found -> false
1677 then
1678 let addkm (k, m) =
1679 if Wsi.withctrl m then add_string bb "ctrl-";
1680 if Wsi.withalt m then add_string bb "alt-";
1681 if Wsi.withshift m then add_string bb "shift-";
1682 if Wsi.withmeta m then add_string bb "meta-";
1683 add_string bb (Wsi.keyname k);
1685 let addkms l =
1686 let rec loop = function
1687 | [] -> ()
1688 | km :: [] -> addkm km
1689 | km :: rest -> addkm km; add_char bb ' '; loop rest
1691 loop l
1693 add_string bb "<map in='";
1694 addkm i;
1695 match o with
1696 | KMinsrt km ->
1697 add_string bb "' out='"; addkm km; add_string bb "'/>\n"
1699 | KMinsrl kms ->
1700 add_string bb "' out='"; addkms kms; add_string bb "'/>\n"
1702 | KMmulti (ins, kms) ->
1703 add_char bb ' '; addkms ins; add_string bb "' out='";
1704 addkms kms; add_string bb "'/>\n"
1705 ) h;
1706 add_string bb "</keymap>";
1709 loop rest
1711 loop c.keyhashes;
1715 let keystostrlist c =
1716 let rec loop accu = function
1717 | [] -> accu
1718 | (modename, h) :: rest ->
1719 let accu =
1720 if Hashtbl.length h > 0
1721 then (
1722 let accu = Printf.sprintf "\xc2\xb7Keys for %s" modename :: accu in
1723 Hashtbl.fold (fun i o a ->
1724 let bb = Buffer.create 10 in
1725 let addkm (k, m) =
1726 if Wsi.withctrl m then Buffer.add_string bb "ctrl-";
1727 if Wsi.withalt m then Buffer.add_string bb "alt-";
1728 if Wsi.withshift m then Buffer.add_string bb "shift-";
1729 if Wsi.withmeta m then Buffer.add_string bb "meta-";
1730 Buffer.add_string bb (Wsi.keyname k);
1732 let addkms l =
1733 let rec loop = function
1734 | [] -> ()
1735 | km :: [] -> addkm km
1736 | km :: rest ->
1737 addkm km; Buffer.add_char bb ' ';
1738 loop rest
1740 loop l
1742 addkm i;
1743 Buffer.add_char bb '\t';
1744 begin match o with
1745 | KMinsrt km ->
1746 addkm km
1748 | KMinsrl kms ->
1749 addkms kms
1751 | KMmulti (ins, kms) ->
1752 Buffer.add_char bb ' ';
1753 addkms ins;
1754 Buffer.add_string bb "\t";
1755 addkms kms
1756 end;
1757 Buffer.contents bb :: a
1758 ) h accu
1760 else accu
1762 loop accu rest
1764 loop [] c.keyhashes
1767 let save1 bb leavebirdseye x h dc =
1768 let uifontsize = fstate.fontsize in
1769 let dc = if conf.bedefault then conf else dc in
1770 Buffer.add_string bb "<llppconfig>\n";
1772 if nonemptystr !fontpath
1773 then
1774 Printf.bprintf bb "<ui-font size='%d'><![CDATA[%s]]></ui-font>\n"
1775 uifontsize
1776 !fontpath
1777 else (
1778 if uifontsize <> 14
1779 then
1780 Printf.bprintf bb "<ui-font size='%d'/>\n" uifontsize
1783 Buffer.add_string bb "<defaults";
1784 add_attrs bb true dc dc nan;
1785 let kb = keymapsbuf true dc dc in
1786 if Buffer.length kb > 0
1787 then (
1788 Buffer.add_string bb ">\n";
1789 Buffer.add_buffer bb kb;
1790 Buffer.add_string bb "\n</defaults>\n";
1792 else Buffer.add_string bb "/>\n";
1794 let adddoc path pan anchor c bookmarks time origin =
1795 if bookmarks == [] && c = dc && anchor = emptyanchor
1796 then ()
1797 else (
1798 Printf.bprintf bb "<doc path='%s'"
1799 (Parser.enent path 0 (String.length path));
1801 if nonemptystr origin
1802 then Printf.bprintf bb "\n origin='%s'"
1803 (Parser.enent origin 0 (String.length origin));
1805 if anchor <> emptyanchor
1806 then (
1807 let n, rely, visy = anchor in
1808 Printf.bprintf bb "\n page='%d'" n;
1810 if rely > 1e-6
1811 then Printf.bprintf bb " rely='%f'" rely;
1813 if abs_float visy > 1e-6
1814 then Printf.bprintf bb " visy='%f'" visy;
1817 if pan != 0
1818 then Printf.bprintf bb " pan='%d'" pan;
1820 add_attrs bb false dc c time;
1821 if nonemptystr c.css
1822 then Printf.bprintf bb ">\n <css><![CDATA[%s]]></css>" c.css;
1823 let kb = keymapsbuf false dc c in
1825 begin match bookmarks with
1826 | [] ->
1827 if Buffer.length kb > 0
1828 then (
1829 Buffer.add_string bb ">\n";
1830 Buffer.add_buffer bb kb;
1831 Buffer.add_string bb "\n</doc>\n";
1833 else
1834 if nonemptystr c.css
1835 then Buffer.add_string bb "\n</doc>\n"
1836 else Buffer.add_string bb "/>\n"
1837 | _ ->
1838 Buffer.add_string bb ">\n<bookmarks>\n";
1839 List.iter (fun (title, _, kind) ->
1840 begin match kind with
1841 | Oanchor (page, rely, visy) ->
1842 Printf.bprintf bb
1843 "<item title='%s' page='%d'"
1844 (Parser.enent title 0 (String.length title))
1845 page
1847 if rely > 1e-6
1848 then
1849 Printf.bprintf bb " rely='%f'" rely
1851 if abs_float visy > 1e-6
1852 then
1853 Printf.bprintf bb " visy='%f'" visy
1855 | Ohistory _ | Onone | Ouri _ | Oremote _
1856 | Oremotedest _ | Olaunch _ ->
1857 failwith "unexpected link in bookmarks"
1858 end;
1859 Buffer.add_string bb "/>\n";
1860 ) bookmarks;
1861 Buffer.add_string bb "</bookmarks>";
1862 if Buffer.length kb > 0
1863 then (
1864 Buffer.add_string bb "\n";
1865 Buffer.add_buffer bb kb;
1867 Buffer.add_string bb "\n</doc>\n";
1868 end;
1872 let pan, conf =
1873 match state.mode with
1874 | Birdseye (c, pan, _, _, _) ->
1875 let beyecolumns =
1876 match conf.columns with
1877 | Cmulti ((c, _, _), _) -> Some c
1878 | Csingle _ -> None
1879 | Csplit _ -> None
1880 and columns =
1881 match c.columns with
1882 | Cmulti (c, _) -> Cmulti (c, E.a)
1883 | Csingle _ -> Csingle E.a
1884 | Csplit _ -> failwith "quit from bird's eye while split"
1886 pan, { c with beyecolumns = beyecolumns; columns = columns }
1887 | Textentry _
1888 | View
1889 | LinkNav _ -> x, conf
1891 let docpath = if nonemptystr state.path then abspath state.path else E.s in
1892 if nonemptystr docpath
1893 then (
1894 adddoc docpath pan (getanchor ())
1896 let autoscrollstep =
1897 match state.autoscroll with
1898 | Some step -> step
1899 | None -> conf.autoscrollstep
1901 begin match state.mode with
1902 | Birdseye beye -> leavebirdseye beye true
1903 | Textentry _
1904 | View
1905 | LinkNav _ -> ()
1906 end;
1907 { conf with autoscrollstep = autoscrollstep }
1909 (if conf.savebmarks then state.bookmarks else [])
1910 (now ())
1911 state.origin
1913 Hashtbl.iter (fun path (c, bookmarks, x, anchor, origin) ->
1914 if docpath <> abspath path
1915 then adddoc path x anchor c bookmarks c.lastvisit origin
1916 ) h;
1917 Buffer.add_string bb "</llppconfig>\n";
1918 true;
1921 let save leavebirdseye =
1922 let relx = float state.x /. float state.winw in
1923 let w, h, x =
1924 let cx w = truncate (relx *. float w) in
1925 List.fold_left
1926 (fun (w, h, x) ws ->
1927 match ws with
1928 | Wsi.Fullscreen -> (conf.cwinw, conf.cwinh, cx conf.cwinw)
1929 | Wsi.MaxVert -> (w, conf.cwinh, x)
1930 | Wsi.MaxHorz -> (conf.cwinw, h, cx conf.cwinw)
1932 (state.winw, state.winh, state.x) state.winstate
1934 conf.cwinw <- w;
1935 conf.cwinh <- h;
1936 let bb = Buffer.create 32768 in
1937 let save2 (h, dc) =
1938 save1 bb leavebirdseye x h dc
1940 if load1 save2 && Buffer.length bb > 0
1941 then
1943 let tmp = !confpath ^ ".tmp" in
1944 let oc = open_out_bin tmp in
1945 Buffer.output_buffer oc bb;
1946 close_out oc;
1947 Unix.rename tmp !confpath;
1948 with exn ->
1949 dolog "error saving configuration: %s" @@ exntos exn
1952 let gc () =
1953 let href = ref @@ Hashtbl.create 0 in
1954 let cref = ref defconf in
1955 let push (h, dc) =
1956 let f path v =
1957 if Sys.file_exists path
1958 then Some v
1959 else (dolog "removing %s" path; None) in
1960 Hashtbl.filter_map_inplace f h;
1961 href := h;
1962 cref := dc;
1963 true
1965 ignore (load1 push);
1966 let bb = Buffer.create 32768 in
1967 let save2 (_h, dc) = save1 bb (fun _ _ -> ()) 0 !href dc in
1968 if load1 save2 && Buffer.length bb > 0
1969 then (
1971 let tmp = !confpath ^ ".tmp" in
1972 let oc = open_out_bin tmp in
1973 Buffer.output_buffer oc bb;
1974 close_out oc;
1975 Unix.rename tmp !confpath;
1976 with exn ->
1977 dolog "error saving configuration: %s" @@ exntos exn
1981 let logcurrently = function
1982 | Idle -> dolog "Idle"
1983 | Loading (l, gen) ->
1984 dolog "Loading %d gen=%d curgen=%d" l.pageno gen state.gen
1985 | Tiling (l, pageopaque, colorspace, angle, gen, col, row, tilew, tileh) ->
1986 dolog
1987 "Tiling %d[%d,%d] page=%s cs=%s angle=%d"
1988 l.pageno col row (~> pageopaque)
1989 (CSTE.to_string colorspace) angle;
1990 dolog "gen=(%d,%d) (%d,%d) tile=(%d,%d) (%d,%d)"
1991 angle gen conf.angle state.gen
1992 tilew tileh
1993 conf.tilew conf.tileh;
1994 | Outlining _ ->
1995 dolog "outlining"