Sync with upstream
[llpp.git] / config.ml
blob800919616027ff7bdbd02a3b3f803b53eb90df8d
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 = 14
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 params = (angle * fitmodel * trimparams
94 * texcount * sliceheight * memsize
95 * colorspace * fontpath * trimcachepath
96 * haspbo * usefontconfig)
97 and width = int
98 and height = int
99 and leftx = int
100 and opaque = Opaque.t
101 and rectcolor = (float * float * float * float)
102 and pixmapsize = int
103 and gen = int
104 and top = float
105 and dtop = float
106 and fontpath = string
107 and trimcachepath = 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 uri = string
114 and caption = string
115 and x = int
116 and y = int
117 and tilex = int
118 and tiley = int
119 and tileparams = (x * y * width * height * tilex * tiley)
120 and under =
121 | Unone
122 | Ulinkuri of string
123 | Ulinkgoto of (int * int)
124 | Utext of facename
125 | Uunexpected of string
126 | Ulaunch of launchcommand
127 | Unamed of destname
128 | Uremote of (filename * pageno)
129 | Uremotedest of (filename * destname)
130 | Uannotation of (opaque * slinkindex)
131 and slinkindex = int
132 and facename = string
133 and launchcommand = string
134 and filename = string
135 and pageno = int
136 and destname = string
137 and mark =
138 | Mark_page
139 | Mark_block
140 | Mark_line
141 | Mark_word
142 and link =
143 | Lnotfound
144 | Lfound of int
145 and linkdir =
146 | LDfirst
147 | LDlast
148 | LDfirstvisible of (int * int * int)
149 | LDleft of int
150 | LDright of int
151 | LDdown of int
152 | LDup of int
153 and pagewithlinks =
154 | Pwlnotfound
155 | Pwl of int
156 and scrollb = int
157 and anchor = pageno * top * dtop
158 and rect = float * float * float * float * float * float * float * float
159 and infochange = | Memused | Docinfo | Pdim
162 class type uioh = object
163 method display : unit
164 method key : int -> int -> uioh
165 method button : int -> bool -> int -> int -> int -> uioh
166 method multiclick : int -> int -> int -> int -> uioh
167 method motion : int -> int -> uioh
168 method pmotion : int -> int -> uioh
169 method infochanged : infochange -> unit
170 method scrollpw : (int * float * float)
171 method scrollph : (int * float * float)
172 method modehash : keyhash
173 method eformsgs : bool
174 method alwaysscrolly : bool
175 end;;
177 module type TextEnumType =
179 type t
180 val name : string
181 val names : string array
182 end;;
184 module TextEnumMake (Ten : TextEnumType) =
185 struct
186 let names = Ten.names;;
187 let to_int (t : Ten.t) = Obj.magic t;;
188 let to_string t = names.(to_int t);;
189 let of_int n : Ten.t = Obj.magic n;;
190 let of_string s =
191 let rec find i =
192 if i = Array.length names
193 then failwith ("invalid " ^ Ten.name ^ ": " ^ s)
194 else (
195 if Ten.names.(i) = s
196 then of_int i
197 else find (i+1)
199 in find 0;;
200 end;;
202 module CSTE = TextEnumMake (struct
203 type t = colorspace;;
204 let name = "colorspace";;
205 let names = [|"rgb"; "bgr"; "gray"|];;
206 end);;
208 module MTE = TextEnumMake (struct
209 type t = mark;;
210 let name = "mark";;
211 let names = [|"page"; "block"; "line"; "word"|];;
212 end);;
214 module FMTE = TextEnumMake (struct
215 type t = fitmodel;;
216 let name = "fitmodel";;
217 let names = [|"width"; "proportional"; "page"|];;
218 end);;
220 type conf =
221 { mutable scrollbw : int
222 ; mutable scrollh : int
223 ; mutable scrollb : scrollb
224 ; mutable icase : bool
225 ; mutable preload : bool
226 ; mutable pagebias : int
227 ; mutable verbose : bool
228 ; mutable debug : bool
229 ; mutable scrollstep : int
230 ; mutable hscrollstep : int
231 ; mutable maxhfit : bool
232 ; mutable crophack : bool
233 ; mutable autoscrollstep : int
234 ; mutable maxwait : float option
235 ; mutable hlinks : bool
236 ; mutable underinfo : bool
237 ; mutable interpagespace : interpagespace
238 ; mutable zoom : float
239 ; mutable presentation : bool
240 ; mutable angle : angle
241 ; mutable cwinw : int
242 ; mutable cwinh : int
243 ; mutable savebmarks : bool
244 ; mutable fitmodel : fitmodel
245 ; mutable trimmargins : trimmargins
246 ; mutable trimfuzz : irect
247 ; mutable memlimit : memsize
248 ; mutable texcount : texcount
249 ; mutable sliceheight : sliceheight
250 ; mutable thumbw : width
251 ; mutable jumpback : bool
252 ; mutable bgcolor : (float * float * float)
253 ; mutable bedefault : bool
254 ; mutable tilew : int
255 ; mutable tileh : int
256 ; mutable mustoresize : memsize
257 ; mutable checkers : bool
258 ; mutable aalevel : int
259 ; mutable urilauncher : string
260 ; mutable pathlauncher : string
261 ; mutable colorspace : colorspace
262 ; mutable invert : bool
263 ; mutable colorscale : float
264 ; mutable ghyllscroll : (int * int * int) option
265 ; mutable columns : columns
266 ; mutable beyecolumns : columncount option
267 ; mutable selcmd : string
268 ; mutable paxcmd : string
269 ; mutable passcmd : string
270 ; mutable savecmd : string
271 ; mutable updatecurs : bool
272 ; mutable keyhashes : (string * keyhash) list
273 ; mutable hfsize : int
274 ; mutable pgscale : float
275 ; mutable usepbo : bool
276 ; mutable wheelbypage : bool
277 ; mutable stcmd : string
278 ; mutable riani : bool
279 ; mutable pax : (float * int * int) ref option
280 ; mutable paxmark : mark
281 ; mutable leftscroll : bool
282 ; mutable title : string
283 ; mutable lastvisit : float
284 ; mutable annotinline : bool
286 and columns =
287 | Csingle of singlecolumn
288 | Cmulti of multicolumns
289 | Csplit of splitcolumns
290 and outlinekind =
291 | Onone
292 | Oanchor of anchor
293 | Ouri of uri
294 | Olaunch of launchcommand
295 | Oremote of (filename * pageno)
296 | Oremotedest of (filename * destname)
297 | Ohistory of (filename * conf * outline list * x * anchor * filename)
298 and outline = (caption * outlinelevel * outlinekind)
299 and outlinelevel = int
302 type page =
303 { pageno : int
304 ; pagedimno : int
305 ; pagew : int
306 ; pageh : int
307 ; pagex : int
308 ; pagey : int
309 ; pagevw : int
310 ; pagevh : int
311 ; pagedispx : int
312 ; pagedispy : int
313 ; pagecol : int
317 type tile = opaque * pixmapsize * elapsed
318 and elapsed = float;;
319 type pagemapkey = pageno * gen;;
320 type tilemapkey = pageno * gen * colorspace * angle * width * height * col * row
321 and row = int
322 and col = int
323 and currently =
324 | Idle
325 | Loading of (page * gen)
326 | Tiling of (
327 page * opaque * colorspace * angle * gen * col * row * width * height
329 | Outlining of outline list
332 type mpos = int * int
333 and mstate =
334 | Msel of (mpos * mpos)
335 | Mpan of mpos
336 | Mscrolly | Mscrollx
337 | Mzoom of (buttonno * step)
338 | Mzoomrect of (mpos * mpos)
339 | Mnone
340 and buttonno = int
341 and step = int
344 type mode =
345 | Birdseye of (conf * leftx * pageno * pageno * anchor)
346 | Textentry of (textentry * onleave)
347 | View
348 | LinkNav of linktarget
349 and onleave = leavetextentrystatus -> unit
350 and leavetextentrystatus = | Cancel | Confirm
351 and helpitem = string * int * action
352 and action =
353 | Noaction
354 | Action of (uioh -> uioh)
355 and linktarget =
356 | Ltexact of (pageno * direction)
357 | Ltgendir of direction
358 | Ltnotready of (pageno * direction)
359 and direction = int (* -1, 0, 1 *)
360 and textentry = string * string * onhist option * onkey * ondone * cancelonempty
361 and onkey = string -> int -> te
362 and ondone = string -> unit
363 and histcancel = unit -> unit
364 and onhist = ((histcmd -> string) * histcancel)
365 and histcmd = HCnext | HCprev | HCfirst | HClast
366 and cancelonempty = bool
367 and te =
368 | TEstop
369 | TEdone of string
370 | TEcont of string
371 | TEswitch of textentry
374 type 'a circbuf =
375 { store : 'a array
376 ; mutable rc : int
377 ; mutable wc : int
378 ; mutable len : int
382 type state =
383 { mutable ss : Unix.file_descr
384 ; mutable wsfd : Unix.file_descr
385 ; mutable stderr : Unix.file_descr
386 ; mutable errmsgs : Buffer.t
387 ; mutable newerrmsgs : bool
388 ; mutable w : int
389 ; mutable x : int
390 ; mutable y : int
391 ; mutable anchor : anchor
392 ; mutable ranchors : (string * string * anchor * string) list
393 ; mutable maxy : int
394 ; mutable layout : page list
395 ; pagemap : (pagemapkey, opaque) Hashtbl.t
396 ; tilemap : (tilemapkey, tile) Hashtbl.t
397 ; tilelru : (tilemapkey * opaque * pixmapsize) Queue.t
398 ; mutable pdims : (pageno * width * height * leftx) list
399 ; mutable pagecount : int
400 ; mutable currently : currently
401 ; mutable mstate : mstate
402 ; mutable searchpattern : string
403 ; mutable rects : (pageno * rectcolor * rect) list
404 ; mutable rects1 : (pageno * rectcolor * rect) list
405 ; prects : (pageno, float array) Hashtbl.t
406 ; mutable text : string
407 ; mutable winstate : Wsi.winstate list
408 ; mutable mode : mode
409 ; mutable uioh : uioh
410 ; mutable outlines : outline array
411 ; mutable bookmarks : outline list
412 ; mutable path : string
413 ; mutable password : string
414 ; mutable nameddest : string
415 ; mutable geomcmds : (string * ((string * (unit -> unit)) list))
416 ; mutable memused : memsize
417 ; mutable gen : gen
418 ; mutable throttle : (page list * int * float) option
419 ; mutable autoscroll : int option
420 ; mutable ghyll : (int option -> unit)
421 ; mutable help : helpitem array
422 ; mutable docinfo : (int * string) list
423 ; mutable checkerstexid : GlTex.texture_id option
424 ; hists : hists
425 ; mutable prevzoom : (float * int)
426 ; mutable progress : float
427 ; mutable redisplay : bool
428 ; mutable mpos : mpos
429 ; mutable keystate : keystate
430 ; mutable glinks : bool
431 ; mutable prevcolumns : (columns * float) option
432 ; mutable winw : int
433 ; mutable winh : int
434 ; mutable reprf : (unit -> unit)
435 ; mutable origin : string
436 ; mutable roam : (unit -> unit)
437 ; mutable bzoom : bool
438 ; mutable traw : [`float] Raw.t
439 ; mutable vraw : [`float] Raw.t
441 and hists =
442 { pat : string circbuf
443 ; pag : string circbuf
444 ; nav : anchor circbuf
445 ; sel : string circbuf
449 let emptyanchor = (0, 0.0, 0.0);;
450 let emptykeyhash = Hashtbl.create 0;;
451 let noghyll _ = ();;
452 let noreprf () = ();;
453 let noroam () = ();;
455 let nouioh : uioh = object (self)
456 method display = ()
457 method key _ _ = self
458 method multiclick _ _ _ _ = self
459 method button _ _ _ _ _ = self
460 method motion _ _ = self
461 method pmotion _ _ = self
462 method infochanged _ = ()
463 method scrollpw = (0, nan, nan)
464 method scrollph = (0, nan, nan)
465 method modehash = emptykeyhash
466 method eformsgs = false
467 method alwaysscrolly = false
468 end;;
470 let platform_to_string = function
471 | Punknown -> "unknown"
472 | Plinux -> "Linux"
473 | Posx -> "OSX"
474 | Psun -> "Sun"
475 | Pbsd -> "BSD"
476 | Pcygwin -> "Cygwin"
479 let version () =
480 Printf.sprintf "llpp version %s, fitz %s, ocaml %s/%d bit"
481 Help.version (fz_version ()) Sys.ocaml_version Sys.word_size
484 let defconf =
485 { scrollbw = 7
486 ; scrollh = 12
487 ; scrollb = scrollbhv lor scrollbvv
488 ; icase = true
489 ; preload = true
490 ; pagebias = 0
491 ; verbose = false
492 ; debug = false
493 ; scrollstep = 24
494 ; hscrollstep = 24
495 ; maxhfit = true
496 ; crophack = false
497 ; autoscrollstep = 2
498 ; maxwait = None
499 ; hlinks = false
500 ; underinfo = false
501 ; interpagespace = 2
502 ; zoom = 1.0
503 ; presentation = false
504 ; angle = 0
505 ; cwinw = 900
506 ; cwinh = 900
507 ; savebmarks = true
508 ; fitmodel = FitProportional
509 ; trimmargins = false
510 ; trimfuzz = (0,0,0,0)
511 ; memlimit = 32 lsl 20
512 ; texcount = 256
513 ; sliceheight = 24
514 ; thumbw = 76
515 ; jumpback = true
516 ; bgcolor = (0.5, 0.5, 0.5)
517 ; bedefault = false
518 ; tilew = 2048
519 ; tileh = 2048
520 ; mustoresize = 256 lsl 20
521 ; checkers = true
522 ; aalevel = 8
523 ; urilauncher =
524 (match platform with
525 | Plinux | Psun | Pbsd -> "xdg-open \"%s\""
526 | Posx -> "open \"%s\""
527 | Pcygwin -> "cygstart \"%s\""
528 | Punknown -> "echo %s")
529 ; pathlauncher = "lp \"%s\""
530 ; selcmd =
531 (match platform with
532 | Plinux | Pbsd | Psun -> "xsel -i"
533 | Posx -> "pbcopy"
534 | Pcygwin -> "wsel"
535 | Punknown -> "cat")
536 ; paxcmd = "cat"
537 ; passcmd = E.s
538 ; savecmd = E.s
539 ; colorspace = Rgb
540 ; invert = false
541 ; colorscale = 1.0
542 ; ghyllscroll = None
543 ; columns = Csingle [||]
544 ; beyecolumns = None
545 ; updatecurs = false
546 ; hfsize = 12
547 ; pgscale = 1.0
548 ; usepbo = false
549 ; wheelbypage = false
550 ; stcmd = "echo SyncTex"
551 ; riani = false
552 ; pax = None
553 ; paxmark = Mark_word
554 ; leftscroll = false
555 ; title = E.s
556 ; lastvisit = 0.0
557 ; annotinline = true
558 ; keyhashes =
559 let mk n = (n, Hashtbl.create 1) in
560 [ mk "global"
561 ; mk "info"
562 ; mk "help"
563 ; mk "outline"
564 ; mk "listview"
565 ; mk "birdseye"
566 ; mk "textentry"
567 ; mk "links"
568 ; mk "view"
573 let conf = { defconf with angle = defconf.angle };;
575 let gotourl url =
576 let command = Str.global_replace percentsre url conf.urilauncher in
577 try ignore @@ spawn command []
578 with exn -> dolog "failed to execute `%s': %s" command @@ exntos exn
581 let gotouri uri =
582 if emptystr conf.urilauncher
583 then dolog "%s" uri
584 else (
585 let url = geturl uri in
586 if emptystr url
587 then dolog "obtained empty url from uri %S" uri
588 else gotourl url
592 let makehelp () =
593 let strings =
594 version ()
595 :: "(searching in this text works just by typing (i.e. no initial '/'))"
596 :: E.s :: Help.keys
598 Array.of_list (
599 List.map (fun s ->
600 let url = geturl s in
601 if nonemptystr url
602 then (s, 0, Action (fun uioh -> gotourl url; uioh))
603 else (s, 0, Noaction)
604 ) strings);
607 let cbnew n v =
608 { store = Array.make n v
609 ; rc = 0
610 ; wc = 0
611 ; len = 0
615 let cbcap b = Array.length b.store;;
617 let cbput b v =
618 let cap = cbcap b in
619 b.store.(b.wc) <- v;
620 b.wc <- (b.wc + 1) mod cap;
621 b.rc <- b.wc;
622 b.len <- min (b.len + 1) cap;
625 let cbempty b = b.len = 0;;
627 let cbgetg b circular dir =
628 if cbempty b
629 then b.store.(0)
630 else
631 let rc = b.rc + dir in
632 let rc =
633 if circular
634 then (
635 if rc = -1
636 then b.len-1
637 else (
638 if rc >= b.len
639 then 0
640 else rc
643 else bound rc 0 (b.len-1)
645 b.rc <- rc;
646 b.store.(rc);
649 let cbget b = cbgetg b false;;
650 let cbgetc b = cbgetg b true;;
652 let state =
653 { ss = Unix.stdin
654 ; wsfd = Unix.stdin
655 ; stderr = Unix.stderr
656 ; errmsgs = Buffer.create 0
657 ; newerrmsgs = false
658 ; x = 0
659 ; y = 0
660 ; w = 0
661 ; anchor = emptyanchor
662 ; ranchors = []
663 ; layout = []
664 ; maxy = max_int
665 ; tilelru = Queue.create ()
666 ; pagemap = Hashtbl.create 10
667 ; tilemap = Hashtbl.create 10
668 ; pdims = []
669 ; pagecount = 0
670 ; currently = Idle
671 ; mstate = Mnone
672 ; rects = []
673 ; rects1 = []
674 ; prects = Hashtbl.create 1
675 ; text = E.s
676 ; mode = View
677 ; winstate = []
678 ; searchpattern = E.s
679 ; outlines = E.a
680 ; bookmarks = []
681 ; path = E.s
682 ; password = E.s
683 ; nameddest = E.s
684 ; geomcmds = E.s, []
685 ; hists =
686 { nav = cbnew 10 emptyanchor
687 ; pat = cbnew 10 E.s
688 ; pag = cbnew 10 E.s
689 ; sel = cbnew 10 E.s
691 ; memused = 0
692 ; gen = 0
693 ; throttle = None
694 ; autoscroll = None
695 ; ghyll = noghyll
696 ; help = makehelp ()
697 ; docinfo = []
698 ; checkerstexid = None
699 ; prevzoom = (1.0, 0)
700 ; progress = -1.0
701 ; uioh = nouioh
702 ; redisplay = true
703 ; mpos = (-1, -1)
704 ; keystate = KSnone
705 ; glinks = false
706 ; prevcolumns = None
707 ; winw = -1
708 ; winh = -1
709 ; reprf = noreprf
710 ; origin = E.s
711 ; roam = noroam
712 ; bzoom = false
713 ; traw = Raw.create_static `float ~len:8
714 ; vraw = Raw.create_static `float ~len:8
718 let copykeyhashes c =
719 List.map (fun (k, v) -> k, Hashtbl.copy v) c.keyhashes;
722 let calcips h =
723 let d = state.winh - h in
724 max conf.interpagespace ((d + 1) / 2)
727 let rowyh (c, coverA, coverB) b n =
728 if c = 1 || (n < coverA || n >= state.pagecount - coverB)
729 then
730 let _, _, vy, (_, _, h, _) = b.(n) in
731 (vy, h)
732 else
733 let n' = n - coverA in
734 let d = n' mod c in
735 let s = n - d in
736 let e = min state.pagecount (s + c) in
737 let rec find m miny maxh = if m = e then miny, maxh else
738 let _, _, y, (_, _, h, _) = b.(m) in
739 let miny = min miny y in
740 let maxh = max maxh h in
741 find (m+1) miny maxh
742 in find s max_int 0
745 let page_of_y y =
746 let ((c, coverA, coverB) as cl), b =
747 match conf.columns with
748 | Csingle b -> (1, 0, 0), b
749 | Cmulti (c, b) -> c, b
750 | Csplit (_, b) -> (1, 0, 0), b
752 if Array.length b = 0
753 then -1
754 else
755 let rec bsearch nmin nmax =
756 if nmin > nmax
757 then bound nmin 0 (state.pagecount-1)
758 else
759 let n = (nmax + nmin) / 2 in
760 let vy, h = rowyh cl b n in
761 let y0, y1 =
762 if conf.presentation
763 then
764 let ips = calcips h in
765 let y0 = vy - ips in
766 let y1 = vy + h + ips in
767 y0, y1
768 else (
769 if n = 0
770 then 0, vy + h + conf.interpagespace
771 else
772 let y0 = vy - conf.interpagespace in
773 y0, y0 + h + conf.interpagespace
776 if y >= y0 && y < y1
777 then (
778 if c = 1
779 then n
780 else (
781 if n > coverA
782 then
783 if n < state.pagecount - coverB
784 then ((n-coverA)/c)*c + coverA
785 else n
786 else n
789 else (
790 if y > y0
791 then bsearch (n+1) nmax
792 else bsearch nmin (n-1)
795 bsearch 0 (state.pagecount-1);
798 let calcheight () =
799 match conf.columns with
800 | Cmulti ((_, _, _) as cl, b) ->
801 if Array.length b > 0
802 then
803 let y, h = rowyh cl b (Array.length b - 1) in
804 y + h + (if conf.presentation then calcips h else 0)
805 else 0
806 | Csingle b ->
807 if Array.length b > 0
808 then
809 let (_, _, y, (_, _, h, _)) = b.(Array.length b - 1) in
810 y + h + (if conf.presentation then calcips h else 0)
811 else 0
812 | Csplit (_, b) ->
813 if Array.length b > 0
814 then
815 let (_, _, y, (_, _, h, _)) = b.(Array.length b - 1) in
816 y + h
817 else 0
820 let getpageywh pageno =
821 let pageno = bound pageno 0 (state.pagecount-1) in
822 match conf.columns with
823 | Csingle b ->
824 if Array.length b = 0
825 then 0, 0, 0
826 else
827 let (_, _, y, (_, w, h, _)) = b.(pageno) in
828 let y =
829 if conf.presentation
830 then y - calcips h
831 else y
833 y, w, h
834 | Cmulti (cl, b) ->
835 if Array.length b = 0
836 then 0, 0, 0
837 else
838 let y, h = rowyh cl b pageno in
839 let (_, _, _, (_, w, _, _)) = b.(pageno) in
840 let y =
841 if conf.presentation
842 then y - calcips h
843 else y
845 y, w, h
846 | Csplit (c, b) ->
847 if Array.length b = 0
848 then 0, 0, 0
849 else
850 let n = pageno*c in
851 let (_, _, y, (_, w, h, _)) = b.(n) in
852 y, w / c, h
855 let getpageyh pageno =
856 let y,_,h = getpageywh pageno in
857 y, h;
860 let getpagedim pageno =
861 let rec f ppdim l =
862 match l with
863 | (n, _, _, _) as pdim :: rest ->
864 if n >= pageno
865 then (if n = pageno then pdim else ppdim)
866 else f pdim rest
868 | [] -> ppdim
870 f (-1, -1, -1, -1) state.pdims
873 let getpdimno pageno =
874 let rec f p l =
875 let np = succ p in
876 match l with
877 | (n, _, _, _) :: rest ->
878 if n >= pageno
879 then (if n = pageno then np else p)
880 else f np rest
882 | [] -> p
884 f ~-1 state.pdims
887 let getpagey pageno = fst (getpageyh pageno);;
889 let getanchor1 l =
890 let top =
891 let coloff = l.pagecol * l.pageh in
892 float (l.pagey + coloff) /. float l.pageh
894 let dtop =
895 if l.pagedispy = 0
896 then
898 else (
899 if conf.presentation
900 then float l.pagedispy /. float (calcips l.pageh)
901 else float l.pagedispy /. float conf.interpagespace
904 (l.pageno, top, dtop)
907 let getanchor () =
908 match state.layout with
909 | l :: _ -> getanchor1 l
910 | [] ->
911 let n = page_of_y state.y in
912 if n = -1
913 then state.anchor
914 else
915 let y, h = getpageyh n in
916 let dy = y - state.y in
917 let dtop =
918 if conf.presentation
919 then
920 let ips = calcips h in
921 float (dy + ips) /. float ips
922 else
923 float dy /. float conf.interpagespace
925 (n, 0.0, dtop)
928 let fontpath = ref E.s;;
930 type historder = [ `lastvisit | `title | `path | `file ];;
932 module KeyMap =
933 Map.Make (struct type t = (int * int) let compare = compare end);;
935 let unentS s =
936 let l = String.length s in
937 let b = Buffer.create l in
938 Parser.unent b s 0 l;
939 Buffer.contents b;
942 let home =
943 try Sys.getenv "HOME"
944 with exn ->
945 dolog "cannot determine home directory location: %s" @@ exntos exn;
949 let modifier_of_string = function
950 | "alt" -> Wsi.altmask
951 | "shift" -> Wsi.shiftmask
952 | "ctrl" | "control" -> Wsi.ctrlmask
953 | "meta" -> Wsi.metamask
954 | _ -> 0
957 let keys_of_string s =
958 let key_of_string r s =
959 let elems = Str.full_split r s in
960 let f n k m =
961 let g s =
962 let m1 = modifier_of_string s in
963 if m1 = 0
964 then (Wsi.namekey s, m)
965 else (k, m lor m1)
966 in function
967 | Str.Delim s when n land 1 = 0 -> g s
968 | Str.Text s -> g s
969 | Str.Delim _ -> (k, m)
971 let rec loop n k m = function
972 | [] -> (k, m)
973 | x :: xs ->
974 let k, m = f n k m x in
975 loop (n+1) k m xs
977 loop 0 0 0 elems
979 let elems = Str.split whitere s in
980 List.map (key_of_string (Str.regexp "-")) elems
983 let config_of c attrs =
984 let apply c k v =
986 match k with
987 | "scroll-bar-width" -> { c with scrollbw = max 0 (int_of_string v) }
988 | "scroll-handle-height" -> { c with scrollh = max 0 (int_of_string v) }
989 | "case-insensitive-search" -> { c with icase = bool_of_string v }
990 | "preload" -> { c with preload = bool_of_string v }
991 | "page-bias" -> { c with pagebias = int_of_string v }
992 | "scroll-step" -> { c with scrollstep = max 1 (int_of_string v) }
993 | "horizontal-scroll-step" ->
994 { c with hscrollstep = max (int_of_string v) 1 }
995 | "auto-scroll-step" ->
996 { c with autoscrollstep = max 0 (int_of_string v) }
997 | "max-height-fit" -> { c with maxhfit = bool_of_string v }
998 | "crop-hack" -> { c with crophack = bool_of_string v }
999 | "throttle" ->
1000 let mw =
1001 match String.lowercase v with
1002 | "true" -> Some infinity
1003 | "false" -> None
1004 | f -> Some (float_of_string f)
1006 { c with maxwait = mw }
1007 | "highlight-links" -> { c with hlinks = bool_of_string v }
1008 | "under-cursor-info" -> { c with underinfo = bool_of_string v }
1009 | "vertical-margin" ->
1010 { c with interpagespace = max 0 (int_of_string v) }
1011 | "zoom" ->
1012 let zoom = float_of_string v /. 100. in
1013 let zoom = max zoom 0.0 in
1014 { c with zoom = zoom }
1015 | "presentation" -> { c with presentation = bool_of_string v }
1016 | "rotation-angle" -> { c with angle = int_of_string v }
1017 | "width" -> { c with cwinw = max 20 (int_of_string v) }
1018 | "height" -> { c with cwinh = max 20 (int_of_string v) }
1019 | "persistent-bookmarks" -> { c with savebmarks = bool_of_string v }
1020 | "proportional-display" ->
1021 let fm =
1022 if bool_of_string v
1023 then FitProportional
1024 else FitWidth
1026 { c with fitmodel = fm }
1027 | "fit-model" -> { c with fitmodel = FMTE.of_string v }
1028 | "pixmap-cache-size" ->
1029 { c with memlimit = max 2 (int_of_string_with_suffix v) }
1030 | "tex-count" -> { c with texcount = max 1 (int_of_string v) }
1031 | "slice-height" -> { c with sliceheight = max 2 (int_of_string v) }
1032 | "thumbnail-width" -> { c with thumbw = max 2 (int_of_string v) }
1033 | "persistent-location" -> { c with jumpback = bool_of_string v }
1034 | "background-color" -> { c with bgcolor = color_of_string v }
1035 | "tile-width" -> { c with tilew = max 2 (int_of_string v) }
1036 | "tile-height" -> { c with tileh = max 2 (int_of_string v) }
1037 | "mupdf-store-size" ->
1038 { c with mustoresize = max 1024 (int_of_string_with_suffix v) }
1039 | "checkers" -> { c with checkers = bool_of_string v }
1040 | "aalevel" -> { c with aalevel = max 0 (int_of_string v) }
1041 | "trim-margins" -> { c with trimmargins = bool_of_string v }
1042 | "trim-fuzz" -> { c with trimfuzz = irect_of_string v }
1043 | "uri-launcher" -> { c with urilauncher = unentS v }
1044 | "path-launcher" -> { c with pathlauncher = unentS v }
1045 | "color-space" -> { c with colorspace = CSTE.of_string v }
1046 | "invert-colors" -> { c with invert = bool_of_string v }
1047 | "brightness" -> { c with colorscale = float_of_string v }
1048 | "ghyllscroll" -> { c with ghyllscroll = ghyllscroll_of_string v }
1049 | "columns" ->
1050 let (n, _, _) as nab = multicolumns_of_string v in
1051 if n < 0
1052 then { c with columns = Csplit (-n, E.a) }
1053 else { c with columns = Cmulti (nab, E.a) }
1054 | "birds-eye-columns" ->
1055 { c with beyecolumns = Some (max (int_of_string v) 2) }
1056 | "selection-command" -> { c with selcmd = unentS v }
1057 | "synctex-command" -> { c with stcmd = unentS v }
1058 | "pax-command" -> { c with paxcmd = unentS v }
1059 | "askpass-command" -> { c with passcmd = unentS v }
1060 | "savepath-command" -> { c with savecmd = unentS v }
1061 | "update-cursor" -> { c with updatecurs = bool_of_string v }
1062 | "hint-font-size" -> { c with hfsize = bound (int_of_string v) 5 100 }
1063 | "page-scroll-scale" -> { c with pgscale = float_of_string v }
1064 | "use-pbo" -> { c with usepbo = bool_of_string v }
1065 | "wheel-scrolls-pages" -> { c with wheelbypage = bool_of_string v }
1066 | "horizontal-scrollbar-visible" ->
1067 let b =
1068 if bool_of_string v
1069 then c.scrollb lor scrollbhv
1070 else c.scrollb land (lnot scrollbhv)
1072 { c with scrollb = b }
1073 | "vertical-scrollbar-visible" ->
1074 let b =
1075 if bool_of_string v
1076 then c.scrollb lor scrollbvv
1077 else c.scrollb land (lnot scrollbvv)
1079 { c with scrollb = b }
1080 | "remote-in-a-new-instance" -> { c with riani = bool_of_string v }
1081 | "point-and-x" ->
1082 { c with pax =
1083 if bool_of_string v
1084 then Some (ref (0.0, 0, 0))
1085 else None }
1086 | "point-and-x-mark" -> { c with paxmark = MTE.of_string v }
1087 | "scroll-bar-on-the-left" -> { c with leftscroll = bool_of_string v }
1088 | "title" -> { c with title = unentS v }
1089 | "last-visit" -> { c with lastvisit = float_of_string v }
1090 | "edit-annotations-inline" -> { c with annotinline = bool_of_string v }
1091 | _ -> c
1092 with exn ->
1093 dolog "error processing attribute (`%S' = `%S'): %s" k v @@ exntos exn;
1096 let rec fold c = function
1097 | [] -> c
1098 | (k, v) :: rest ->
1099 let c = apply c k v in
1100 fold c rest
1102 fold { c with keyhashes = copykeyhashes c } attrs;
1105 let fromstring f pos n v d =
1106 try f v
1107 with exn ->
1108 dolog "error processing attribute (%S=%S) at %d\n%s" n v pos @@ exntos exn;
1112 let bookmark_of attrs =
1113 let rec fold title page rely visy = function
1114 | ("title", v) :: rest -> fold v page rely visy rest
1115 | ("page", v) :: rest -> fold title v rely visy rest
1116 | ("rely", v) :: rest -> fold title page v visy rest
1117 | ("visy", v) :: rest -> fold title page rely v rest
1118 | _ :: rest -> fold title page rely visy rest
1119 | [] -> title, page, rely, visy
1121 fold "invalid" "0" "0" "0" attrs
1124 let doc_of attrs =
1125 let rec fold path page rely pan visy origin = function
1126 | ("path", v) :: rest -> fold v page rely pan visy origin rest
1127 | ("page", v) :: rest -> fold path v rely pan visy origin rest
1128 | ("rely", v) :: rest -> fold path page v pan visy origin rest
1129 | ("pan", v) :: rest -> fold path page rely v visy origin rest
1130 | ("visy", v) :: rest -> fold path page rely pan v origin rest
1131 | ("origin", v) :: rest -> fold path page rely pan visy v rest
1132 | _ :: rest -> fold path page rely pan visy origin rest
1133 | [] -> path, page, rely, pan, visy, origin
1135 fold E.s "0" "0" "0" "0" E.s attrs
1138 let map_of attrs =
1139 let rec fold rs ls = function
1140 | ("out", v) :: rest -> fold v ls rest
1141 | ("in", v) :: rest -> fold rs v rest
1142 | _ :: rest -> fold ls rs rest
1143 | [] -> ls, rs
1145 fold E.s E.s attrs
1148 let setconf dst src =
1149 dst.scrollbw <- src.scrollbw;
1150 dst.scrollh <- src.scrollh;
1151 dst.icase <- src.icase;
1152 dst.preload <- src.preload;
1153 dst.pagebias <- src.pagebias;
1154 dst.verbose <- src.verbose;
1155 dst.scrollstep <- src.scrollstep;
1156 dst.maxhfit <- src.maxhfit;
1157 dst.crophack <- src.crophack;
1158 dst.autoscrollstep <- src.autoscrollstep;
1159 dst.maxwait <- src.maxwait;
1160 dst.hlinks <- src.hlinks;
1161 dst.underinfo <- src.underinfo;
1162 dst.interpagespace <- src.interpagespace;
1163 dst.zoom <- src.zoom;
1164 dst.presentation <- src.presentation;
1165 dst.angle <- src.angle;
1166 dst.cwinw <- src.cwinw;
1167 dst.cwinh <- src.cwinh;
1168 dst.savebmarks <- src.savebmarks;
1169 dst.memlimit <- src.memlimit;
1170 dst.fitmodel <- src.fitmodel;
1171 dst.texcount <- src.texcount;
1172 dst.sliceheight <- src.sliceheight;
1173 dst.thumbw <- src.thumbw;
1174 dst.jumpback <- src.jumpback;
1175 dst.bgcolor <- src.bgcolor;
1176 dst.tilew <- src.tilew;
1177 dst.tileh <- src.tileh;
1178 dst.mustoresize <- src.mustoresize;
1179 dst.checkers <- src.checkers;
1180 dst.aalevel <- src.aalevel;
1181 dst.trimmargins <- src.trimmargins;
1182 dst.trimfuzz <- src.trimfuzz;
1183 dst.urilauncher <- src.urilauncher;
1184 dst.colorspace <- src.colorspace;
1185 dst.invert <- src.invert;
1186 dst.colorscale <- src.colorscale;
1187 dst.ghyllscroll <- src.ghyllscroll;
1188 dst.columns <- src.columns;
1189 dst.beyecolumns <- src.beyecolumns;
1190 dst.selcmd <- src.selcmd;
1191 dst.updatecurs <- src.updatecurs;
1192 dst.pathlauncher <- src.pathlauncher;
1193 dst.keyhashes <- copykeyhashes src;
1194 dst.hfsize <- src.hfsize;
1195 dst.hscrollstep <- src.hscrollstep;
1196 dst.pgscale <- src.pgscale;
1197 dst.usepbo <- src.usepbo;
1198 dst.wheelbypage <- src.wheelbypage;
1199 dst.stcmd <- src.stcmd;
1200 dst.paxcmd <- src.paxcmd;
1201 dst.passcmd <- src.passcmd;
1202 dst.savecmd <- src.savecmd;
1203 dst.scrollb <- src.scrollb;
1204 dst.riani <- src.riani;
1205 dst.paxmark <- src.paxmark;
1206 dst.leftscroll <- src.leftscroll;
1207 dst.title <- src.title;
1208 dst.annotinline <- src.annotinline;
1209 dst.pax <-
1210 if src.pax = None
1211 then None
1212 else Some ((ref (0.0, 0, 0)));
1215 let findkeyhash c name =
1216 try List.assoc name c.keyhashes
1217 with Not_found -> failwith ("invalid mode name `" ^ name ^ "'")
1220 let get s =
1221 let open Parser in
1222 let h = Hashtbl.create 10 in
1223 let dc = { defconf with angle = defconf.angle } in
1224 let rec toplevel v t spos _ =
1225 match t with
1226 | Vdata | Vcdata | Vend -> v
1227 | Vopen ("llppconfig", _, closed) ->
1228 if closed
1229 then v
1230 else { v with f = llppconfig }
1231 | Vopen _ ->
1232 error "unexpected subelement at top level" s spos
1233 | Vclose _ -> error "unexpected close at top level" s spos
1235 and llppconfig v t spos _ =
1236 match t with
1237 | Vdata | Vcdata -> v
1238 | Vend -> error "unexpected end of input in llppconfig" s spos
1239 | Vopen ("defaults", attrs, closed) ->
1240 let c = config_of dc attrs in
1241 setconf dc c;
1242 if closed
1243 then v
1244 else { v with f = defaults }
1246 | Vopen ("ui-font", attrs, closed) ->
1247 let rec getsize size = function
1248 | [] -> size
1249 | ("size", v) :: rest ->
1250 let size =
1251 fromstring int_of_string spos "size" v fstate.fontsize in
1252 getsize size rest
1253 | l -> getsize size l
1255 fstate.fontsize <- getsize fstate.fontsize attrs;
1256 if closed
1257 then v
1258 else { v with f = uifont (Buffer.create 10) }
1260 | Vopen ("doc", attrs, closed) ->
1261 let pathent, spage, srely, span, svisy, origin = doc_of attrs in
1262 let path = unentS pathent
1263 and origin = unentS origin
1264 and pageno = fromstring int_of_string spos "page" spage 0
1265 and rely = fromstring float_of_string spos "rely" srely 0.0
1266 and pan = fromstring int_of_string spos "pan" span 0
1267 and visy = fromstring float_of_string spos "visy" svisy 0.0 in
1268 let c = config_of dc attrs in
1269 let anchor = (pageno, rely, visy) in
1270 if closed
1271 then (Hashtbl.add h path (c, [], pan, anchor, origin); v)
1272 else { v with f = doc path origin pan anchor c [] }
1274 | Vopen _ ->
1275 error "unexpected subelement in llppconfig" s spos
1277 | Vclose "llppconfig" -> { v with f = toplevel }
1278 | Vclose _ -> error "unexpected close in llppconfig" s spos
1280 and defaults v t spos _ =
1281 match t with
1282 | Vdata | Vcdata -> v
1283 | Vend -> error "unexpected end of input in defaults" s spos
1284 | Vopen ("keymap", attrs, closed) ->
1285 let modename =
1286 try List.assoc "mode" attrs
1287 with Not_found -> "global" in
1288 if closed
1289 then v
1290 else
1291 let ret keymap =
1292 let h = findkeyhash dc modename in
1293 KeyMap.iter (Hashtbl.replace h) keymap;
1294 defaults
1296 { v with f = pkeymap ret KeyMap.empty }
1298 | Vopen (_, _, _) ->
1299 error "unexpected subelement in defaults" s spos
1301 | Vclose "defaults" ->
1302 { v with f = llppconfig }
1304 | Vclose _ -> error "unexpected close in defaults" s spos
1306 and uifont b v t spos epos =
1307 match t with
1308 | Vdata | Vcdata ->
1309 Buffer.add_substring b s spos (epos - spos);
1311 | Vopen (_, _, _) ->
1312 error "unexpected subelement in ui-font" s spos
1313 | Vclose "ui-font" ->
1314 if emptystr !fontpath
1315 then fontpath := Buffer.contents b;
1316 { v with f = llppconfig }
1317 | Vclose _ -> error "unexpected close in ui-font" s spos
1318 | Vend -> error "unexpected end of input in ui-font" s spos
1320 and doc path origin pan anchor c bookmarks v t spos _ =
1321 match t with
1322 | Vdata | Vcdata -> v
1323 | Vend -> error "unexpected end of input in doc" s spos
1324 | Vopen ("bookmarks", _, closed) ->
1325 if closed
1326 then v
1327 else { v with f = pbookmarks path origin pan anchor c bookmarks }
1329 | Vopen ("keymap", attrs, closed) ->
1330 let modename =
1331 try List.assoc "mode" attrs
1332 with Not_found -> "global"
1334 if closed
1335 then v
1336 else
1337 let ret keymap =
1338 let h = findkeyhash c modename in
1339 KeyMap.iter (Hashtbl.replace h) keymap;
1340 doc path origin pan anchor c bookmarks
1342 { v with f = pkeymap ret KeyMap.empty }
1344 | Vopen (_, _, _) ->
1345 error "unexpected subelement in doc" s spos
1347 | Vclose "doc" ->
1348 Hashtbl.add h path (c, List.rev bookmarks, pan, anchor, origin);
1349 { v with f = llppconfig }
1351 | Vclose _ -> error "unexpected close in doc" s spos
1353 and pkeymap ret keymap v t spos _ =
1354 match t with
1355 | Vdata | Vcdata -> v
1356 | Vend -> error "unexpected end of input in keymap" s spos
1357 | Vopen ("map", attrs, closed) ->
1358 let r, l = map_of attrs in
1359 let kss = fromstring keys_of_string spos "in" r [] in
1360 let lss = fromstring keys_of_string spos "out" l [] in
1361 let keymap =
1362 match kss with
1363 | [] -> keymap
1364 | ks :: [] -> KeyMap.add ks (KMinsrl lss) keymap
1365 | ks :: rest -> KeyMap.add ks (KMmulti (rest, lss)) keymap
1367 if closed
1368 then { v with f = pkeymap ret keymap }
1369 else
1370 let f () = v in
1371 { v with f = skip "map" f }
1373 | Vopen _ ->
1374 error "unexpected subelement in keymap" s spos
1376 | Vclose "keymap" ->
1377 { v with f = ret keymap }
1379 | Vclose _ -> error "unexpected close in keymap" s spos
1381 and pbookmarks path origin pan anchor c bookmarks v t spos _ =
1382 match t with
1383 | Vdata | Vcdata -> v
1384 | Vend -> error "unexpected end of input in bookmarks" s spos
1385 | Vopen ("item", attrs, closed) ->
1386 let titleent, spage, srely, svisy = bookmark_of attrs in
1387 let page = fromstring int_of_string spos "page" spage 0
1388 and rely = fromstring float_of_string spos "rely" srely 0.0
1389 and visy = fromstring float_of_string spos "visy" svisy 0.0 in
1390 let bookmarks =
1391 (unentS titleent, 0, Oanchor (page, rely, visy)) :: bookmarks
1393 if closed
1394 then { v with f = pbookmarks path origin pan anchor c bookmarks }
1395 else
1396 let f () = v in
1397 { v with f = skip "item" f }
1399 | Vopen _ ->
1400 error "unexpected subelement in bookmarks" s spos
1402 | Vclose "bookmarks" ->
1403 { v with f = doc path origin pan anchor c bookmarks }
1405 | Vclose _ -> Parser.parse_error "unexpected close in bookmarks" s spos
1407 and skip tag f v t spos _ =
1408 match t with
1409 | Vdata | Vcdata -> v
1410 | Vend ->
1411 Parser.parse_error ("unexpected end of input in skipped " ^ tag) s spos
1412 | Vopen (tag', _, closed) ->
1413 if closed
1414 then v
1415 else
1416 let f' () = { v with f = skip tag f } in
1417 { v with f = skip tag' f' }
1418 | Vclose ctag ->
1419 if tag = ctag
1420 then f ()
1421 else Parser.parse_error ("unexpected close in skipped " ^ tag) s spos
1424 parse { f = toplevel; accu = () } s;
1425 h, dc;
1428 let do_load f contents =
1429 try f contents
1430 with
1431 | Parser.Parse_error (msg, s, pos) ->
1432 let subs = Parser.subs s pos in
1433 Utils.error "parse error: %s: at %d [..%S..]" msg pos subs
1435 | exn -> Utils.error "parse error: %s" @@ exntos exn
1438 let defconfpath =
1439 let dir =
1440 let xdgconfdir = Utils.getenvwithdef "XDG_CONFIG_HOME" E.s in
1441 if emptystr xdgconfdir
1442 then
1444 let dir = Filename.concat home ".config" in
1445 if Sys.is_directory dir then dir else home
1446 with _ -> home
1447 else xdgconfdir
1449 Filename.concat dir "llpp.conf"
1452 let confpath = ref defconfpath;;
1454 let load2 f default =
1455 match filecontents !confpath with
1456 | contents -> f @@ do_load get contents
1457 | exception Unix.Unix_error (Unix.ENOENT, "open", _) ->
1458 f (Hashtbl.create 0, defconf)
1459 | exception exn ->
1460 dolog "error loading configuration from `%S': %s" !confpath @@ exntos exn;
1461 default
1464 let load1 f = load2 f false;;
1466 let load openlast =
1467 let f (h, dc) =
1468 if openlast
1469 then (
1470 let path, _ =
1471 Hashtbl.fold
1472 (fun path (conf, _, _, _, _) ((_, besttime) as best) ->
1473 if conf.lastvisit > besttime
1474 then (path, conf.lastvisit)
1475 else best)
1477 (state.path, -.infinity)
1479 state.path <- path;
1481 let pc, pb, px, pa, po =
1483 let absname = abspath state.path in
1484 Hashtbl.find h absname
1485 with Not_found -> dc, [], 0, emptyanchor, state.origin
1487 setconf defconf dc;
1488 setconf conf pc;
1489 state.bookmarks <- pb;
1490 state.x <- px;
1491 state.origin <- po;
1492 if conf.jumpback
1493 then state.anchor <- pa;
1494 cbput state.hists.nav pa;
1495 true
1497 load1 f
1500 let gethist () =
1501 let f (h, _) =
1502 Hashtbl.fold (fun path (pc, pb, px, pa, po) accu ->
1503 (path, pc, pb, px, pa, po) :: accu)
1504 h [];
1506 load2 f []
1509 let add_attrs bb always dc c time =
1510 let o' fmt s =
1511 Buffer.add_string bb "\n ";
1512 Printf.bprintf bb fmt s
1514 let o c fmt s = if c then o' fmt s else ignore in
1515 let ob s a b = o (always || a != b) "%s='%b'" s a
1516 and op s a b = o (always || a <> b) "%s='%b'" s (a != None)
1517 and oi s a b = o (always || a != b) "%s='%d'" s a
1518 and oI s a b = o (always || a != b) "%s='%s'" s (string_with_suffix_of_int a)
1519 and oz s a b = o (always || a <> b) "%s='%g'" s (a*.100.)
1520 and oF s a b = o (always || a <> b) "%s='%f'" s a
1521 and oL s a b = o (always || a <> b) "%s='%Ld'" s a
1522 and oc s a b = o (always || a <> b) "%s='%s'" s (color_to_string a)
1523 and oC s a b = o (always || a <> b) "%s='%s'" s (CSTE.to_string a)
1524 and oR s a b = o (always || a <> b) "%s='%s'" s (irect_to_string a)
1525 and oFm s a b = o (always || a <> b) "%s='%s'" s (FMTE.to_string a)
1526 and oSv s a b m = o (always || a <> b) "%s='%b'" s (a land m != 0)
1527 and oPm s a b = o (always || a <> b) "%s='%s'" s (MTE.to_string a)
1528 and os s a b =
1529 o (always || a <> b) "%s='%s'" s @@ Parser.enent a 0 (String.length a)
1530 and og s a b =
1531 if always || a <> b
1532 then
1533 match a with
1534 | Some (_N, _A, _B) -> o' "%s='%u,%u,%u'" s _N _A _B
1535 | None ->
1536 match b with
1537 | None -> ()
1538 | _ -> o' "%s='none'" s
1539 and oW s a b =
1540 if always || a <> b
1541 then
1542 let v =
1543 match a with
1544 | None -> "false"
1545 | Some f ->
1546 if f = infinity
1547 then "true"
1548 else string_of_float f
1550 o' "%s='%s'" s v
1551 and oco s a b =
1552 if always || a <> b
1553 then
1554 match a with
1555 | Cmulti ((n, a, b), _) when n > 1 -> o' "%s='%d,%d,%d'" s n a b
1556 | Csplit (n, _) when n > 1 -> o' "%s='%d'" s ~-n
1557 | Cmulti _ | Csplit _ | Csingle _ -> ()
1558 and obeco s a b =
1559 if always || a <> b
1560 then
1561 match a with
1562 | Some c when c > 1 -> o' "%s='%d'" s c
1563 | _ -> ()
1565 oi "width" c.cwinw dc.cwinw;
1566 oi "height" c.cwinh dc.cwinh;
1567 oi "scroll-bar-width" c.scrollbw dc.scrollbw;
1568 oi "scroll-handle-height" c.scrollh dc.scrollh;
1569 oSv "horizontal-scrollbar-visible" c.scrollb dc.scrollb scrollbhv;
1570 oSv "vertical-scrollbar-visible" c.scrollb dc.scrollb scrollbvv;
1571 ob "case-insensitive-search" c.icase dc.icase;
1572 ob "preload" c.preload dc.preload;
1573 oi "page-bias" c.pagebias dc.pagebias;
1574 oi "scroll-step" c.scrollstep dc.scrollstep;
1575 oi "auto-scroll-step" c.autoscrollstep dc.autoscrollstep;
1576 ob "max-height-fit" c.maxhfit dc.maxhfit;
1577 ob "crop-hack" c.crophack dc.crophack;
1578 oW "throttle" c.maxwait dc.maxwait;
1579 ob "highlight-links" c.hlinks dc.hlinks;
1580 ob "under-cursor-info" c.underinfo dc.underinfo;
1581 oi "vertical-margin" c.interpagespace dc.interpagespace;
1582 oz "zoom" c.zoom dc.zoom;
1583 ob "presentation" c.presentation dc.presentation;
1584 oi "rotation-angle" c.angle dc.angle;
1585 ob "persistent-bookmarks" c.savebmarks dc.savebmarks;
1586 oFm "fit-model" c.fitmodel dc.fitmodel;
1587 oI "pixmap-cache-size" c.memlimit dc.memlimit;
1588 oi "tex-count" c.texcount dc.texcount;
1589 oi "slice-height" c.sliceheight dc.sliceheight;
1590 oi "thumbnail-width" c.thumbw dc.thumbw;
1591 ob "persistent-location" c.jumpback dc.jumpback;
1592 oc "background-color" c.bgcolor dc.bgcolor;
1593 oi "tile-width" c.tilew dc.tilew;
1594 oi "tile-height" c.tileh dc.tileh;
1595 oI "mupdf-store-size" c.mustoresize dc.mustoresize;
1596 ob "checkers" c.checkers dc.checkers;
1597 oi "aalevel" c.aalevel dc.aalevel;
1598 ob "trim-margins" c.trimmargins dc.trimmargins;
1599 oR "trim-fuzz" c.trimfuzz dc.trimfuzz;
1600 os "uri-launcher" c.urilauncher dc.urilauncher;
1601 os "path-launcher" c.pathlauncher dc.pathlauncher;
1602 oC "color-space" c.colorspace dc.colorspace;
1603 ob "invert-colors" c.invert dc.invert;
1604 oF "brightness" c.colorscale dc.colorscale;
1605 og "ghyllscroll" c.ghyllscroll dc.ghyllscroll;
1606 oco "columns" c.columns dc.columns;
1607 obeco "birds-eye-columns" c.beyecolumns dc.beyecolumns;
1608 os "selection-command" c.selcmd dc.selcmd;
1609 os "synctex-command" c.stcmd dc.stcmd;
1610 os "pax-command" c.paxcmd dc.paxcmd;
1611 os "askpass-command" c.passcmd dc.passcmd;
1612 os "savepath-command" c.savecmd dc.savecmd;
1613 ob "update-cursor" c.updatecurs dc.updatecurs;
1614 oi "hint-font-size" c.hfsize dc.hfsize;
1615 oi "horizontal-scroll-step" c.hscrollstep dc.hscrollstep;
1616 oF "page-scroll-scale" c.pgscale dc.pgscale;
1617 ob "use-pbo" c.usepbo dc.usepbo;
1618 ob "wheel-scrolls-pages" c.wheelbypage dc.wheelbypage;
1619 ob "remote-in-a-new-instance" c.riani dc.riani;
1620 op "point-and-x" c.pax dc.pax;
1621 oPm "point-and-x-mark" c.paxmark dc.paxmark;
1622 ob "scroll-bar-on-the-left" c.leftscroll dc.leftscroll;
1623 if not always
1624 then os "title" c.title dc.title;
1625 oL "last-visit" (Int64.of_float time) 0L;
1626 ob "edit-annotations-inline" c.annotinline dc.annotinline;
1629 let keymapsbuf always dc c =
1630 let bb = Buffer.create 16 in
1631 let rec loop = function
1632 | [] -> ()
1633 | (modename, h) :: rest ->
1634 let dh = findkeyhash dc modename in
1635 if always || h <> dh
1636 then (
1637 if Hashtbl.length h > 0
1638 then (
1639 if Buffer.length bb > 0
1640 then Buffer.add_char bb '\n';
1641 Printf.bprintf bb "<keymap mode='%s'>\n" modename;
1642 Hashtbl.iter (fun i o ->
1643 let isdifferent = always ||
1645 let dO = Hashtbl.find dh i in
1646 dO <> o
1647 with Not_found -> true
1649 if isdifferent
1650 then
1651 let addkm (k, m) =
1652 if Wsi.withctrl m then Buffer.add_string bb "ctrl-";
1653 if Wsi.withalt m then Buffer.add_string bb "alt-";
1654 if Wsi.withshift m then Buffer.add_string bb "shift-";
1655 if Wsi.withmeta m then Buffer.add_string bb "meta-";
1656 Buffer.add_string bb (Wsi.keyname k);
1658 let addkms l =
1659 let rec loop = function
1660 | [] -> ()
1661 | km :: [] -> addkm km
1662 | km :: rest -> addkm km; Buffer.add_char bb ' '; loop rest
1664 loop l
1666 Buffer.add_string bb "<map in='";
1667 addkm i;
1668 match o with
1669 | KMinsrt km ->
1670 Buffer.add_string bb "' out='";
1671 addkm km;
1672 Buffer.add_string bb "'/>\n"
1674 | KMinsrl kms ->
1675 Buffer.add_string bb "' out='";
1676 addkms kms;
1677 Buffer.add_string bb "'/>\n"
1679 | KMmulti (ins, kms) ->
1680 Buffer.add_char bb ' ';
1681 addkms ins;
1682 Buffer.add_string bb "' out='";
1683 addkms kms;
1684 Buffer.add_string bb "'/>\n"
1685 ) h;
1686 Buffer.add_string bb "</keymap>";
1689 loop rest
1691 loop c.keyhashes;
1695 let save1 bb leavebirdseye x h dc =
1696 let uifontsize = fstate.fontsize in
1697 let dc = if conf.bedefault then conf else dc in
1698 Buffer.add_string bb "<llppconfig>\n";
1700 if nonemptystr !fontpath
1701 then
1702 Printf.bprintf bb "<ui-font size='%d'><![CDATA[%s]]></ui-font>\n"
1703 uifontsize
1704 !fontpath
1705 else (
1706 if uifontsize <> 14
1707 then
1708 Printf.bprintf bb "<ui-font size='%d'/>\n" uifontsize
1711 Buffer.add_string bb "<defaults";
1712 add_attrs bb true dc dc nan;
1713 let kb = keymapsbuf true dc dc in
1714 if Buffer.length kb > 0
1715 then (
1716 Buffer.add_string bb ">\n";
1717 Buffer.add_buffer bb kb;
1718 Buffer.add_string bb "\n</defaults>\n";
1720 else Buffer.add_string bb "/>\n";
1722 let adddoc path pan anchor c bookmarks time origin =
1723 if bookmarks == [] && c = dc && anchor = emptyanchor
1724 then ()
1725 else (
1726 Printf.bprintf bb "<doc path='%s'"
1727 (Parser.enent path 0 (String.length path));
1729 if nonemptystr origin
1730 then
1731 Printf.bprintf bb "\n origin='%s'"
1732 (Parser.enent origin 0 (String.length origin));
1734 if anchor <> emptyanchor
1735 then (
1736 let n, rely, visy = anchor in
1737 Printf.bprintf bb "\n page='%d'" n;
1738 if rely > 1e-6
1739 then
1740 Printf.bprintf bb " rely='%f'" rely
1742 if abs_float visy > 1e-6
1743 then
1744 Printf.bprintf bb " visy='%f'" visy
1748 if pan != 0
1749 then Printf.bprintf bb " pan='%d'" pan;
1751 add_attrs bb false dc c time;
1752 let kb = keymapsbuf false dc c in
1754 begin match bookmarks with
1755 | [] ->
1756 if Buffer.length kb > 0
1757 then (
1758 Buffer.add_string bb ">\n";
1759 Buffer.add_buffer bb kb;
1760 Buffer.add_string bb "\n</doc>\n";
1762 else Buffer.add_string bb "/>\n"
1763 | _ ->
1764 Buffer.add_string bb ">\n<bookmarks>\n";
1765 List.iter (fun (title, _, kind) ->
1766 begin match kind with
1767 | Oanchor (page, rely, visy) ->
1768 Printf.bprintf bb
1769 "<item title='%s' page='%d'"
1770 (Parser.enent title 0 (String.length title))
1771 page
1773 if rely > 1e-6
1774 then
1775 Printf.bprintf bb " rely='%f'" rely
1777 if abs_float visy > 1e-6
1778 then
1779 Printf.bprintf bb " visy='%f'" visy
1781 | Ohistory _ | Onone | Ouri _ | Oremote _
1782 | Oremotedest _ | Olaunch _ ->
1783 failwith "unexpected link in bookmarks"
1784 end;
1785 Buffer.add_string bb "/>\n";
1786 ) bookmarks;
1787 Buffer.add_string bb "</bookmarks>";
1788 if Buffer.length kb > 0
1789 then (
1790 Buffer.add_string bb "\n";
1791 Buffer.add_buffer bb kb;
1793 Buffer.add_string bb "\n</doc>\n";
1794 end;
1798 let pan, conf =
1799 match state.mode with
1800 | Birdseye (c, pan, _, _, _) ->
1801 let beyecolumns =
1802 match conf.columns with
1803 | Cmulti ((c, _, _), _) -> Some c
1804 | Csingle _ -> None
1805 | Csplit _ -> None
1806 and columns =
1807 match c.columns with
1808 | Cmulti (c, _) -> Cmulti (c, E.a)
1809 | Csingle _ -> Csingle E.a
1810 | Csplit _ -> failwith "quit from bird's eye while split"
1812 pan, { c with beyecolumns = beyecolumns; columns = columns }
1813 | Textentry _
1814 | View
1815 | LinkNav _ -> x, conf
1817 let docpath = if nonemptystr state.path then abspath state.path else E.s in
1818 if nonemptystr docpath
1819 then (
1820 adddoc docpath pan (getanchor ())
1822 let autoscrollstep =
1823 match state.autoscroll with
1824 | Some step -> step
1825 | None -> conf.autoscrollstep
1827 begin match state.mode with
1828 | Birdseye beye -> leavebirdseye beye true
1829 | Textentry _
1830 | View
1831 | LinkNav _ -> ()
1832 end;
1833 { conf with autoscrollstep = autoscrollstep }
1835 (if conf.savebmarks then state.bookmarks else [])
1836 (now ())
1837 state.origin
1839 Hashtbl.iter (fun path (c, bookmarks, x, anchor, origin) ->
1840 if docpath <> abspath path
1841 then adddoc path x anchor c bookmarks c.lastvisit origin
1842 ) h;
1843 Buffer.add_string bb "</llppconfig>\n";
1844 true;
1847 let save leavebirdseye =
1848 let relx = float state.x /. float state.winw in
1849 let w, h, x =
1850 let cx w = truncate (relx *. float w) in
1851 List.fold_left
1852 (fun (w, h, x) ws ->
1853 match ws with
1854 | Wsi.Fullscreen -> (conf.cwinw, conf.cwinh, cx conf.cwinw)
1855 | Wsi.MaxVert -> (w, conf.cwinh, x)
1856 | Wsi.MaxHorz -> (conf.cwinw, h, cx conf.cwinw)
1858 (state.winw, state.winh, state.x) state.winstate
1860 conf.cwinw <- w;
1861 conf.cwinh <- h;
1862 let bb = Buffer.create 32768 in
1863 let save2 (h, dc) =
1864 save1 bb leavebirdseye x h dc
1866 if load1 save2 && Buffer.length bb > 0
1867 then
1869 let tmp = !confpath ^ ".tmp" in
1870 let oc = open_out_bin tmp in
1871 Buffer.output_buffer oc bb;
1872 close_out oc;
1873 Unix.rename tmp !confpath;
1874 with exn ->
1875 dolog "error saving configuration: %s" @@ exntos exn
1878 let gc fd =
1879 let wr s n =
1880 (* This here has a potential of rising SIGPIPE, silently and
1881 seemingly harmlessly (when -gc was supplied an invalid
1882 executable for instance) probably needs revisiting *)
1883 let n' = Unix.write fd (Bytes.of_string s) 0 n in
1884 if n != n'
1885 then Utils.error "Unix.write %d = %d" n n'
1887 let href = ref (Hashtbl.create 0) in
1888 let cref = ref defconf in
1889 let push (h, dc) =
1890 let f path (pc, _pb, _px, _pa, _po) =
1891 let s =
1892 Printf.sprintf "%s\000%ld\000" path (Int32.of_float pc.lastvisit)
1894 wr s (String.length s)
1896 Hashtbl.iter f h;
1897 href := h;
1898 cref := dc;
1899 true
1901 ignore (load1 push);
1902 Unix.shutdown fd Unix.SHUTDOWN_SEND;
1903 let s = fdcontents fd in
1904 let rec f ppos =
1905 match String.index_from s ppos '\000' with
1906 | exception Not_found -> ()
1907 | zpos1 ->
1908 match String.index_from s (zpos1+1) '\000' with
1909 | exception Not_found -> error "invalid gc input in (%S) at %d" s zpos1
1910 | zpos2 ->
1911 let okey = StringLabels.sub s ~pos:ppos ~len:(zpos1-ppos) in
1912 let nkey = StringLabels.sub s ~pos:(zpos1+1) ~len:(zpos2-zpos1-1) in
1913 if emptystr nkey
1914 then (Hashtbl.remove !href okey; f (zpos2+1))
1915 else
1916 match Hashtbl.find !href okey with
1917 | exception Not_found -> Utils.error "gc: cannot find %S" okey
1918 | v ->
1919 Hashtbl.remove !href okey;
1920 Hashtbl.replace !href nkey v;
1921 f (zpos2+1)
1923 f 0;
1924 let bb = Buffer.create 32768 in
1925 let save2 (_h, dc) = save1 bb (fun _ _ -> ()) 0 !href dc in
1926 if load1 save2 && Buffer.length bb > 0
1927 then (
1929 let tmp = !confpath ^ ".tmp" in
1930 let oc = open_out_bin tmp in
1931 Buffer.output_buffer oc bb;
1932 close_out oc;
1933 Unix.rename tmp !confpath;
1934 with exn ->
1935 dolog "error saving configuration: %s" @@ exntos exn
1939 let logcurrently = function
1940 | Idle -> dolog "Idle"
1941 | Loading (l, gen) ->
1942 dolog "Loading %d gen=%d curgen=%d" l.pageno gen state.gen
1943 | Tiling (l, pageopaque, colorspace, angle, gen, col, row, tilew, tileh) ->
1944 dolog
1945 "Tiling %d[%d,%d] page=%s cs=%s angle"
1946 l.pageno col row (~> pageopaque)
1947 (CSTE.to_string colorspace)
1949 dolog "gen=(%d,%d) (%d,%d) tile=(%d,%d) (%d,%d)"
1950 angle gen conf.angle state.gen
1951 tilew tileh
1952 conf.tilew conf.tileh
1954 | Outlining _ ->
1955 dolog "outlining"