Stop open coding emptystr this time around
[llpp.git] / config.ml
blob395ac5a352695a58d7c37a124951415d88b3e892
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);;
23 let addpid = ignore;;
25 let irect_of_string s =
26 Scanf.sscanf s "%d/%d/%d/%d" (fun x0 y0 x1 y1 -> (x0,y0,x1,y1))
29 let irect_to_string (x0,y0,x1,y1) =
30 Printf.sprintf "%d/%d/%d/%d" x0 y0 x1 y1
33 let ghyllscroll_of_string s =
34 match s with
35 | "fast" -> Some fastghyllscroll
36 | "neat" -> Some (10,1,9)
37 | "" | "none" -> None
38 | _ ->
39 let (n,a,b) as nab =
40 Scanf.sscanf s "%u,%u,%u" (fun n a b -> n, a, b) in
41 if n <= a || n <= b || a >= b
42 then error "invalid ghyll N(%d),A(%d),B(%d) (N <= A, A < B, N <= B)"
43 n a b;
44 Some nab
47 let ghyllscroll_to_string ((n, a, b) as nab) =
48 (**) if nab = fastghyllscroll then "fast"
49 else if nab = neatghyllscroll then "neat"
50 else Printf.sprintf "%d,%d,%d" n a b;
53 let multicolumns_to_string (n, a, b) =
54 if a = 0 && b = 0
55 then Printf.sprintf "%d" n
56 else Printf.sprintf "%d,%d,%d" n a b;
59 let multicolumns_of_string s =
60 try
61 (int_of_string s, 0, 0)
62 with _ ->
63 Scanf.sscanf s "%u,%u,%u" (fun n a b ->
64 if a > 1 || b > 1
65 then failwith "subtly broken"; (n, a, b)
69 type keymap =
70 | KMinsrt of key
71 | KMinsrl of key list
72 | KMmulti of key list * key list
73 and key = int * int
74 and keyhash = (key, keymap) Hashtbl.t
75 and keystate =
76 | KSnone
77 | KSinto of (key list * key list)
78 and interpagespace = int
79 and multicolumns = multicol * pagegeom
80 and singlecolumn = pagegeom
81 and splitcolumns = columncount * pagegeom
82 and pagegeom = (pdimno * x * y * (pageno * width * height * leftx)) array
83 and multicol = columncount * covercount * covercount
84 and pdimno = int
85 and columncount = int
86 and covercount = int
87 and fitmodel = | FitWidth | FitProportional | FitPage
88 and trimmargins = bool
89 and irect = (int * int * int * int)
90 and memsize = int
91 and texcount = int
92 and sliceheight = int
93 and angle = int
94 and params = (angle * fitmodel * trimparams
95 * texcount * sliceheight * memsize
96 * colorspace * fontpath * trimcachepath
97 * haspbo * usefontconfig)
98 and width = int
99 and height = int
100 and leftx = int
101 and opaque = Opaque.t
102 and recttype = int
103 and pixmapsize = int
104 and gen = int
105 and top = float
106 and dtop = float
107 and fontpath = string
108 and trimcachepath = string
109 and aalevel = int
110 and trimparams = (trimmargins * irect)
111 and colorspace = | Rgb | Bgr | Gray
112 and haspbo = bool
113 and usefontconfig = 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 | Ulinkgoto of (int * int)
125 | Utext of facename
126 | Uunexpected of string
127 | Ulaunch of launchcommand
128 | Unamed of destname
129 | Uremote of (filename * pageno)
130 | Uremotedest of (filename * destname)
131 | Uannotation of (opaque * slinkindex)
132 and slinkindex = int
133 and facename = string
134 and launchcommand = string
135 and filename = string
136 and pageno = int
137 and destname = string
138 and mark =
139 | Mark_page
140 | Mark_block
141 | Mark_line
142 | Mark_word
143 and link =
144 | Lnotfound
145 | Lfound of int
146 and linkdir =
147 | LDfirst
148 | LDlast
149 | LDfirstvisible of (int * int * int)
150 | LDleft of int
151 | LDright of int
152 | LDdown of int
153 | LDup of int
154 and pagewithlinks =
155 | Pwlnotfound
156 | Pwl of int
157 and scrollb = int
158 and anchor = pageno * top * dtop
159 and rect = float * float * float * float * float * float * float * float
160 and infochange = | Memused | Docinfo | Pdim
163 class type uioh = object
164 method display : unit
165 method key : int -> int -> uioh
166 method button : int -> bool -> int -> int -> int -> uioh
167 method multiclick : int -> int -> int -> int -> uioh
168 method motion : int -> int -> uioh
169 method pmotion : int -> int -> uioh
170 method infochanged : infochange -> unit
171 method scrollpw : (int * float * float)
172 method scrollph : (int * float * float)
173 method modehash : keyhash
174 method eformsgs : bool
175 method alwaysscrolly : bool
176 end;;
178 module type TextEnumType =
180 type t
181 val name : string
182 val names : string array
183 end;;
185 module TextEnumMake (Ten : TextEnumType) =
186 struct
187 let names = Ten.names;;
188 let to_int (t : Ten.t) = Obj.magic t;;
189 let to_string t = names.(to_int t);;
190 let of_int n : Ten.t = Obj.magic n;;
191 let of_string s =
192 let rec find i =
193 if i = Array.length names
194 then failwith ("invalid " ^ Ten.name ^ ": " ^ s)
195 else (
196 if Ten.names.(i) = s
197 then of_int i
198 else find (i+1)
200 in find 0;;
201 end;;
203 module CSTE = TextEnumMake (struct
204 type t = colorspace;;
205 let name = "colorspace";;
206 let names = [|"rgb"; "bgr"; "gray"|];;
207 end);;
209 module MTE = TextEnumMake (struct
210 type t = mark;;
211 let name = "mark";;
212 let names = [|"page"; "block"; "line"; "word"|];;
213 end);;
215 module FMTE = TextEnumMake (struct
216 type t = fitmodel;;
217 let name = "fitmodel";;
218 let names = [|"width"; "proportional"; "page"|];;
219 end);;
221 type conf =
222 { mutable scrollbw : int
223 ; mutable scrollh : int
224 ; mutable scrollb : scrollb
225 ; mutable icase : bool
226 ; mutable preload : bool
227 ; mutable pagebias : int
228 ; mutable verbose : bool
229 ; mutable debug : bool
230 ; mutable scrollstep : int
231 ; mutable hscrollstep : int
232 ; mutable maxhfit : bool
233 ; mutable crophack : bool
234 ; mutable autoscrollstep : int
235 ; mutable maxwait : float option
236 ; mutable hlinks : bool
237 ; mutable underinfo : bool
238 ; mutable interpagespace : interpagespace
239 ; mutable zoom : float
240 ; mutable presentation : bool
241 ; mutable angle : angle
242 ; mutable cwinw : int
243 ; mutable cwinh : int
244 ; mutable savebmarks : bool
245 ; mutable fitmodel : fitmodel
246 ; mutable trimmargins : trimmargins
247 ; mutable trimfuzz : irect
248 ; mutable memlimit : memsize
249 ; mutable texcount : texcount
250 ; mutable sliceheight : sliceheight
251 ; mutable thumbw : width
252 ; mutable jumpback : bool
253 ; mutable bgcolor : (float * float * float)
254 ; mutable bedefault : bool
255 ; mutable tilew : int
256 ; mutable tileh : int
257 ; mutable mustoresize : memsize
258 ; mutable checkers : bool
259 ; mutable aalevel : int
260 ; mutable urilauncher : string
261 ; mutable pathlauncher : string
262 ; mutable colorspace : colorspace
263 ; mutable invert : bool
264 ; mutable colorscale : float
265 ; mutable redirectstderr : bool
266 ; mutable ghyllscroll : (int * int * int) option
267 ; mutable columns : columns
268 ; mutable beyecolumns : columncount option
269 ; mutable selcmd : string
270 ; mutable paxcmd : string
271 ; mutable passcmd : string
272 ; mutable savecmd : string
273 ; mutable updatecurs : bool
274 ; mutable keyhashes : (string * keyhash) list
275 ; mutable hfsize : int
276 ; mutable pgscale : float
277 ; mutable usepbo : bool
278 ; mutable wheelbypage : bool
279 ; mutable stcmd : string
280 ; mutable riani : bool
281 ; mutable pax : (float * int * int) ref option
282 ; mutable paxmark : mark
283 ; mutable leftscroll : bool
284 ; mutable title : string
285 ; mutable lastvisit : float
286 ; mutable annotinline : bool
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 | Oaction of (unit -> unit)
301 | Oreaction of (unit -> outline array)
302 and outline = (caption * outlinelevel * outlinekind)
303 and outlinelevel = int
306 type page =
307 { pageno : int
308 ; pagedimno : int
309 ; pagew : int
310 ; pageh : int
311 ; pagex : int
312 ; pagey : int
313 ; pagevw : int
314 ; pagevh : int
315 ; pagedispx : int
316 ; pagedispy : int
317 ; pagecol : int
321 type tile = opaque * pixmapsize * elapsed
322 and elapsed = float;;
323 type pagemapkey = pageno * gen;;
324 type tilemapkey = pageno * gen * colorspace * angle * width * height * col * row
325 and row = int
326 and col = int
327 and currently =
328 | Idle
329 | Loading of (page * gen)
330 | Tiling of (
331 page * opaque * colorspace * angle * gen * col * row * width * height
333 | Outlining of outline list
336 type mpos = int * int
337 and mstate =
338 | Msel of (mpos * mpos)
339 | Mpan of mpos
340 | Mscrolly | Mscrollx
341 | Mzoom of (buttonno * step)
342 | Mzoomrect of (mpos * mpos)
343 | Mnone
344 and buttonno = int
345 and step = int
348 type mode =
349 | Birdseye of (conf * leftx * pageno * pageno * anchor)
350 | Textentry of (textentry * onleave)
351 | View
352 | LinkNav of linktarget
353 and onleave = leavetextentrystatus -> unit
354 and leavetextentrystatus = | Cancel | Confirm
355 and helpitem = string * int * action
356 and action =
357 | Noaction
358 | Action of (uioh -> uioh)
359 and linktarget =
360 | Ltexact of (pageno * direction)
361 | Ltgendir of direction
362 | Ltnotready of (pageno * direction)
363 and direction = int (* -1, 0, 1 *)
364 and textentry = string * string * onhist option * onkey * ondone * cancelonempty
365 and onkey = string -> int -> te
366 and ondone = string -> unit
367 and histcancel = unit -> unit
368 and onhist = ((histcmd -> string) * histcancel)
369 and histcmd = HCnext | HCprev | HCfirst | HClast
370 and cancelonempty = bool
371 and te =
372 | TEstop
373 | TEdone of string
374 | TEcont of string
375 | TEswitch of textentry
378 type 'a circbuf =
379 { store : 'a array
380 ; mutable rc : int
381 ; mutable wc : int
382 ; mutable len : int
386 type state =
387 { mutable ss : Unix.file_descr
388 ; mutable wsfd : Unix.file_descr
389 ; mutable errfd : Unix.file_descr option
390 ; mutable stderr : Unix.file_descr
391 ; mutable errmsgs : Buffer.t
392 ; mutable newerrmsgs : bool
393 ; mutable w : int
394 ; mutable x : int
395 ; mutable y : int
396 ; mutable anchor : anchor
397 ; mutable ranchors : (string * string * anchor * string) list
398 ; mutable maxy : int
399 ; mutable layout : page list
400 ; pagemap : (pagemapkey, opaque) Hashtbl.t
401 ; tilemap : (tilemapkey, tile) Hashtbl.t
402 ; tilelru : (tilemapkey * opaque * pixmapsize) Queue.t
403 ; mutable pdims : (pageno * width * height * leftx) list
404 ; mutable pagecount : int
405 ; mutable currently : currently
406 ; mutable mstate : mstate
407 ; mutable searchpattern : string
408 ; mutable rects : (pageno * recttype * rect) list
409 ; mutable rects1 : (pageno * recttype * rect) list
410 ; mutable text : string
411 ; mutable winstate : Wsi.winstate list
412 ; mutable mode : mode
413 ; mutable uioh : uioh
414 ; mutable outlines : outline array
415 ; mutable bookmarks : outline list
416 ; mutable path : string
417 ; mutable password : string
418 ; mutable nameddest : string
419 ; mutable geomcmds : (string * ((string * (unit -> unit)) list))
420 ; mutable memused : memsize
421 ; mutable gen : gen
422 ; mutable throttle : (page list * int * float) option
423 ; mutable autoscroll : int option
424 ; mutable ghyll : (int option -> unit)
425 ; mutable help : helpitem array
426 ; mutable docinfo : (int * string) list
427 ; mutable checkerstexid : GlTex.texture_id option
428 ; hists : hists
429 ; mutable prevzoom : (float * int)
430 ; mutable progress : float
431 ; mutable redisplay : bool
432 ; mutable mpos : mpos
433 ; mutable keystate : keystate
434 ; mutable glinks : bool
435 ; mutable prevcolumns : (columns * float) option
436 ; mutable winw : int
437 ; mutable winh : int
438 ; mutable reprf : (unit -> unit)
439 ; mutable origin : string
440 ; mutable roam : (unit -> unit)
441 ; mutable bzoom : bool
442 ; mutable traw : [`float] Raw.t
443 ; mutable vraw : [`float] Raw.t
445 and hists =
446 { pat : string circbuf
447 ; pag : string circbuf
448 ; nav : anchor circbuf
449 ; sel : string circbuf
453 let emptyanchor = (0, 0.0, 0.0);;
454 let emptykeyhash = Hashtbl.create 0;;
455 let noghyll _ = ();;
456 let noreprf () = ();;
457 let noroam () = ();;
459 let nouioh : uioh = object (self)
460 method display = ()
461 method key _ _ = self
462 method multiclick _ _ _ _ = self
463 method button _ _ _ _ _ = self
464 method motion _ _ = self
465 method pmotion _ _ = self
466 method infochanged _ = ()
467 method scrollpw = (0, nan, nan)
468 method scrollph = (0, nan, nan)
469 method modehash = emptykeyhash
470 method eformsgs = false
471 method alwaysscrolly = false
472 end;;
474 let platform_to_string = function
475 | Punknown -> "unknown"
476 | Plinux -> "Linux"
477 | Posx -> "OSX"
478 | Psun -> "Sun"
479 | Pbsd -> "BSD"
480 | Pcygwin -> "Cygwin"
483 let version () =
484 Printf.sprintf "llpp version %s, fitz %s, ocaml %s/%d bit"
485 Help.version (fz_version ()) Sys.ocaml_version Sys.word_size
488 let defconf =
489 { scrollbw = 7
490 ; scrollh = 12
491 ; scrollb = scrollbhv lor scrollbvv
492 ; icase = true
493 ; preload = true
494 ; pagebias = 0
495 ; verbose = false
496 ; debug = false
497 ; scrollstep = 24
498 ; hscrollstep = 24
499 ; maxhfit = true
500 ; crophack = false
501 ; autoscrollstep = 2
502 ; maxwait = None
503 ; hlinks = false
504 ; underinfo = false
505 ; interpagespace = 2
506 ; zoom = 1.0
507 ; presentation = false
508 ; angle = 0
509 ; cwinw = 900
510 ; cwinh = 900
511 ; savebmarks = true
512 ; fitmodel = FitProportional
513 ; trimmargins = false
514 ; trimfuzz = (0,0,0,0)
515 ; memlimit = 32 lsl 20
516 ; texcount = 256
517 ; sliceheight = 24
518 ; thumbw = 76
519 ; jumpback = true
520 ; bgcolor = (0.5, 0.5, 0.5)
521 ; bedefault = false
522 ; tilew = 2048
523 ; tileh = 2048
524 ; mustoresize = 256 lsl 20
525 ; checkers = true
526 ; aalevel = 8
527 ; urilauncher =
528 (match platform with
529 | Plinux | Psun | Pbsd -> "xdg-open \"%s\""
530 | Posx -> "open \"%s\""
531 | Pcygwin -> "cygstart \"%s\""
532 | Punknown -> "echo %s")
533 ; pathlauncher = "lp \"%s\""
534 ; selcmd =
535 (match platform with
536 | Plinux | Pbsd | Psun -> "xsel -i"
537 | Posx -> "pbcopy"
538 | Pcygwin -> "wsel"
539 | Punknown -> "cat")
540 ; paxcmd = "cat"
541 ; passcmd = E.s
542 ; savecmd = E.s
543 ; colorspace = Rgb
544 ; invert = false
545 ; colorscale = 1.0
546 ; redirectstderr = false
547 ; ghyllscroll = None
548 ; columns = Csingle [||]
549 ; beyecolumns = None
550 ; updatecurs = false
551 ; hfsize = 12
552 ; pgscale = 1.0
553 ; usepbo = false
554 ; wheelbypage = false
555 ; stcmd = "echo SyncTex"
556 ; riani = false
557 ; pax = None
558 ; paxmark = Mark_word
559 ; leftscroll = false
560 ; title = E.s
561 ; lastvisit = 0.0
562 ; annotinline = true
563 ; keyhashes =
564 let mk n = (n, Hashtbl.create 1) in
565 [ mk "global"
566 ; mk "info"
567 ; mk "help"
568 ; mk "outline"
569 ; mk "listview"
570 ; mk "birdseye"
571 ; mk "textentry"
572 ; mk "links"
573 ; mk "view"
578 let conf = { defconf with angle = defconf.angle };;
580 let gotouri uri =
581 if emptystr conf.urilauncher
582 then print_endline uri
583 else (
584 let url = geturl uri in
585 if emptystr url
586 then (Printf.eprintf "obtained empty url from uri %S\n" uri)
587 else
588 let re = Str.regexp "%s" in
589 let command = Str.global_replace re url conf.urilauncher in
590 try ignore (popen command [])
591 with exn -> dolog "failed to execute `%s': %s" command (exntos exn)
595 let makehelp () =
596 let strings =
597 version ()
598 :: "(searching in this text works just by typing (i.e. no initial '/'))"
599 :: E.s :: Help.keys
601 Array.of_list (
602 List.map (fun s ->
603 let url = geturl s in
604 if nonemptystr url
605 then (s, 0, Action (fun u -> gotouri url; u))
606 else (s, 0, Noaction)
607 ) strings);
610 let cbnew n v =
611 { store = Array.make n v
612 ; rc = 0
613 ; wc = 0
614 ; len = 0
618 let cbcap b = Array.length b.store;;
620 let cbput b v =
621 let cap = cbcap b in
622 b.store.(b.wc) <- v;
623 b.wc <- (b.wc + 1) mod cap;
624 b.rc <- b.wc;
625 b.len <- min (b.len + 1) cap;
628 let cbempty b = b.len = 0;;
630 let cbgetg b circular dir =
631 if cbempty b
632 then b.store.(0)
633 else
634 let rc = b.rc + dir in
635 let rc =
636 if circular
637 then (
638 if rc = -1
639 then b.len-1
640 else (
641 if rc >= b.len
642 then 0
643 else rc
646 else bound rc 0 (b.len-1)
648 b.rc <- rc;
649 b.store.(rc);
652 let cbget b = cbgetg b false;;
653 let cbgetc b = cbgetg b true;;
655 let state =
656 { ss = Unix.stdin
657 ; wsfd = Unix.stdin
658 ; errfd = None
659 ; stderr = Unix.stderr
660 ; errmsgs = Buffer.create 0
661 ; newerrmsgs = false
662 ; x = 0
663 ; y = 0
664 ; w = 0
665 ; anchor = emptyanchor
666 ; ranchors = []
667 ; layout = []
668 ; maxy = max_int
669 ; tilelru = Queue.create ()
670 ; pagemap = Hashtbl.create 10
671 ; tilemap = Hashtbl.create 10
672 ; pdims = []
673 ; pagecount = 0
674 ; currently = Idle
675 ; mstate = Mnone
676 ; rects = []
677 ; rects1 = []
678 ; text = E.s
679 ; mode = View
680 ; winstate = []
681 ; searchpattern = E.s
682 ; outlines = E.a
683 ; bookmarks = []
684 ; path = E.s
685 ; password = E.s
686 ; nameddest = E.s
687 ; geomcmds = E.s, []
688 ; hists =
689 { nav = cbnew 10 emptyanchor
690 ; pat = cbnew 10 E.s
691 ; pag = cbnew 10 E.s
692 ; sel = cbnew 10 E.s
694 ; memused = 0
695 ; gen = 0
696 ; throttle = None
697 ; autoscroll = None
698 ; ghyll = noghyll
699 ; help = makehelp ()
700 ; docinfo = []
701 ; checkerstexid = None
702 ; prevzoom = (1.0, 0)
703 ; progress = -1.0
704 ; uioh = nouioh
705 ; redisplay = true
706 ; mpos = (-1, -1)
707 ; keystate = KSnone
708 ; glinks = false
709 ; prevcolumns = None
710 ; winw = -1
711 ; winh = -1
712 ; reprf = noreprf
713 ; origin = E.s
714 ; roam = noroam
715 ; bzoom = false
716 ; traw = Raw.create_static `float ~len:8
717 ; vraw = Raw.create_static `float ~len:8
721 let copykeyhashes c =
722 List.map (fun (k, v) -> k, Hashtbl.copy v) c.keyhashes;
725 let calcips h =
726 let d = state.winh - h in
727 max conf.interpagespace ((d + 1) / 2)
730 let rowyh (c, coverA, coverB) b n =
731 if c = 1 || (n < coverA || n >= state.pagecount - coverB)
732 then
733 let _, _, vy, (_, _, h, _) = b.(n) in
734 (vy, h)
735 else
736 let n' = n - coverA in
737 let d = n' mod c in
738 let s = n - d in
739 let e = min state.pagecount (s + c) in
740 let rec find m miny maxh = if m = e then miny, maxh else
741 let _, _, y, (_, _, h, _) = b.(m) in
742 let miny = min miny y in
743 let maxh = max maxh h in
744 find (m+1) miny maxh
745 in find s max_int 0
748 let page_of_y y =
749 let ((c, coverA, coverB) as cl), b =
750 match conf.columns with
751 | Csingle b -> (1, 0, 0), b
752 | Cmulti (c, b) -> c, b
753 | Csplit (_, b) -> (1, 0, 0), b
755 if Array.length b = 0
756 then -1
757 else
758 let rec bsearch nmin nmax =
759 if nmin > nmax
760 then bound nmin 0 (state.pagecount-1)
761 else
762 let n = (nmax + nmin) / 2 in
763 let vy, h = rowyh cl b n in
764 let y0, y1 =
765 if conf.presentation
766 then
767 let ips = calcips h in
768 let y0 = vy - ips in
769 let y1 = vy + h + ips in
770 y0, y1
771 else (
772 if n = 0
773 then 0, vy + h + conf.interpagespace
774 else
775 let y0 = vy - conf.interpagespace in
776 y0, y0 + h + conf.interpagespace
779 if y >= y0 && y < y1
780 then (
781 if c = 1
782 then n
783 else (
784 if n > coverA
785 then
786 if n < state.pagecount - coverB
787 then ((n-coverA)/c)*c + coverA
788 else n
789 else n
792 else (
793 if y > y0
794 then bsearch (n+1) nmax
795 else bsearch nmin (n-1)
798 bsearch 0 (state.pagecount-1);
801 let calcheight () =
802 match conf.columns with
803 | Cmulti ((_, _, _) as cl, b) ->
804 if Array.length b > 0
805 then
806 let y, h = rowyh cl b (Array.length b - 1) in
807 y + h + (if conf.presentation then calcips h else 0)
808 else 0
809 | Csingle b ->
810 if Array.length b > 0
811 then
812 let (_, _, y, (_, _, h, _)) = b.(Array.length b - 1) in
813 y + h + (if conf.presentation then calcips h else 0)
814 else 0
815 | Csplit (_, b) ->
816 if Array.length b > 0
817 then
818 let (_, _, y, (_, _, h, _)) = b.(Array.length b - 1) in
819 y + h
820 else 0
823 let getpageywh pageno =
824 let pageno = bound pageno 0 (state.pagecount-1) in
825 match conf.columns with
826 | Csingle b ->
827 if Array.length b = 0
828 then 0, 0, 0
829 else
830 let (_, _, y, (_, w, h, _)) = b.(pageno) in
831 let y =
832 if conf.presentation
833 then y - calcips h
834 else y
836 y, w, h
837 | Cmulti (cl, b) ->
838 if Array.length b = 0
839 then 0, 0, 0
840 else
841 let y, h = rowyh cl b pageno in
842 let (_, _, _, (_, w, _, _)) = b.(pageno) in
843 let y =
844 if conf.presentation
845 then y - calcips h
846 else y
848 y, w, h
849 | Csplit (c, b) ->
850 if Array.length b = 0
851 then 0, 0, 0
852 else
853 let n = pageno*c in
854 let (_, _, y, (_, w, h, _)) = b.(n) in
855 y, w / c, h
858 let getpageyh pageno =
859 let y,_,h = getpageywh pageno in
860 y, h;
863 let getpagedim pageno =
864 let rec f ppdim l =
865 match l with
866 | (n, _, _, _) as pdim :: rest ->
867 if n >= pageno
868 then (if n = pageno then pdim else ppdim)
869 else f pdim rest
871 | [] -> ppdim
873 f (-1, -1, -1, -1) state.pdims
876 let getpagey pageno = fst (getpageyh pageno);;
878 let getanchor1 l =
879 let top =
880 let coloff = l.pagecol * l.pageh in
881 float (l.pagey + coloff) /. float l.pageh
883 let dtop =
884 if l.pagedispy = 0
885 then
887 else (
888 if conf.presentation
889 then float l.pagedispy /. float (calcips l.pageh)
890 else float l.pagedispy /. float conf.interpagespace
893 (l.pageno, top, dtop)
896 let getanchor () =
897 match state.layout with
898 | l :: _ -> getanchor1 l
899 | [] ->
900 let n = page_of_y state.y in
901 if n = -1
902 then state.anchor
903 else
904 let y, h = getpageyh n in
905 let dy = y - state.y in
906 let dtop =
907 if conf.presentation
908 then
909 let ips = calcips h in
910 float (dy + ips) /. float ips
911 else
912 float dy /. float conf.interpagespace
914 (n, 0.0, dtop)
917 let fontpath = ref E.s;;
919 type historder = [ `lastvisit | `title | `path | `file ];;
921 module KeyMap =
922 Map.Make (struct type t = (int * int) let compare = compare end);;
924 let unentS s =
925 let l = String.length s in
926 let b = Buffer.create l in
927 Parser.unent b s 0 l;
928 Buffer.contents b;
931 let home =
932 try Sys.getenv "HOME"
933 with exn ->
934 prerr_endline
935 ("Can not determine home directory location: " ^ exntos exn);
939 let modifier_of_string = function
940 | "alt" -> Wsi.altmask
941 | "shift" -> Wsi.shiftmask
942 | "ctrl" | "control" -> Wsi.ctrlmask
943 | "meta" -> Wsi.metamask
944 | _ -> 0
947 let key_of_string =
948 let r = Str.regexp "-" in
949 fun s ->
950 let elems = Str.full_split r s in
951 let f n k m =
952 let g s =
953 let m1 = modifier_of_string s in
954 if m1 = 0
955 then (Wsi.namekey s, m)
956 else (k, m lor m1)
957 in function
958 | Str.Delim s when n land 1 = 0 -> g s
959 | Str.Text s -> g s
960 | Str.Delim _ -> (k, m)
962 let rec loop n k m = function
963 | [] -> (k, m)
964 | x :: xs ->
965 let k, m = f n k m x in
966 loop (n+1) k m xs
968 loop 0 0 0 elems
971 let keys_of_string =
972 let r = Str.regexp "[ \t]" in
973 fun s ->
974 let elems = Str.split r s in
975 List.map key_of_string elems
978 let config_of c attrs =
979 let apply c k v =
981 match k with
982 | "scroll-bar-width" -> { c with scrollbw = max 0 (int_of_string v) }
983 | "scroll-handle-height" -> { c with scrollh = max 0 (int_of_string v) }
984 | "case-insensitive-search" -> { c with icase = bool_of_string v }
985 | "preload" -> { c with preload = bool_of_string v }
986 | "page-bias" -> { c with pagebias = int_of_string v }
987 | "scroll-step" -> { c with scrollstep = max 1 (int_of_string v) }
988 | "horizontal-scroll-step" ->
989 { c with hscrollstep = max (int_of_string v) 1 }
990 | "auto-scroll-step" ->
991 { c with autoscrollstep = max 0 (int_of_string v) }
992 | "max-height-fit" -> { c with maxhfit = bool_of_string v }
993 | "crop-hack" -> { c with crophack = bool_of_string v }
994 | "throttle" ->
995 let mw =
996 match String.lowercase v with
997 | "true" -> Some infinity
998 | "false" -> None
999 | f -> Some (float_of_string f)
1001 { c with maxwait = mw }
1002 | "highlight-links" -> { c with hlinks = bool_of_string v }
1003 | "under-cursor-info" -> { c with underinfo = bool_of_string v }
1004 | "vertical-margin" ->
1005 { c with interpagespace = max 0 (int_of_string v) }
1006 | "zoom" ->
1007 let zoom = float_of_string v /. 100. in
1008 let zoom = max zoom 0.0 in
1009 { c with zoom = zoom }
1010 | "presentation" -> { c with presentation = bool_of_string v }
1011 | "rotation-angle" -> { c with angle = int_of_string v }
1012 | "width" -> { c with cwinw = max 20 (int_of_string v) }
1013 | "height" -> { c with cwinh = max 20 (int_of_string v) }
1014 | "persistent-bookmarks" -> { c with savebmarks = bool_of_string v }
1015 | "proportional-display" ->
1016 let fm =
1017 if bool_of_string v
1018 then FitProportional
1019 else FitWidth
1021 { c with fitmodel = fm }
1022 | "fit-model" -> { c with fitmodel = FMTE.of_string v }
1023 | "pixmap-cache-size" ->
1024 { c with memlimit = max 2 (int_of_string_with_suffix v) }
1025 | "tex-count" -> { c with texcount = max 1 (int_of_string v) }
1026 | "slice-height" -> { c with sliceheight = max 2 (int_of_string v) }
1027 | "thumbnail-width" -> { c with thumbw = max 2 (int_of_string v) }
1028 | "persistent-location" -> { c with jumpback = bool_of_string v }
1029 | "background-color" -> { c with bgcolor = color_of_string v }
1030 | "tile-width" -> { c with tilew = max 2 (int_of_string v) }
1031 | "tile-height" -> { c with tileh = max 2 (int_of_string v) }
1032 | "mupdf-store-size" ->
1033 { c with mustoresize = max 1024 (int_of_string_with_suffix v) }
1034 | "checkers" -> { c with checkers = bool_of_string v }
1035 | "aalevel" -> { c with aalevel = max 0 (int_of_string v) }
1036 | "trim-margins" -> { c with trimmargins = bool_of_string v }
1037 | "trim-fuzz" -> { c with trimfuzz = irect_of_string v }
1038 | "uri-launcher" -> { c with urilauncher = unentS v }
1039 | "path-launcher" -> { c with pathlauncher = unentS v }
1040 | "color-space" -> { c with colorspace = CSTE.of_string v }
1041 | "invert-colors" -> { c with invert = bool_of_string v }
1042 | "brightness" -> { c with colorscale = float_of_string v }
1043 | "redirectstderr" -> { c with redirectstderr = bool_of_string v }
1044 | "ghyllscroll" -> { c with ghyllscroll = ghyllscroll_of_string v }
1045 | "columns" ->
1046 let (n, _, _) as nab = multicolumns_of_string v in
1047 if n < 0
1048 then { c with columns = Csplit (-n, E.a) }
1049 else { c with columns = Cmulti (nab, E.a) }
1050 | "birds-eye-columns" ->
1051 { c with beyecolumns = Some (max (int_of_string v) 2) }
1052 | "selection-command" -> { c with selcmd = unentS v }
1053 | "synctex-command" -> { c with stcmd = unentS v }
1054 | "pax-command" -> { c with paxcmd = unentS v }
1055 | "askpass-command" -> { c with passcmd = unentS v }
1056 | "savepath-command" -> { c with savecmd = unentS v }
1057 | "update-cursor" -> { c with updatecurs = bool_of_string v }
1058 | "hint-font-size" -> { c with hfsize = bound (int_of_string v) 5 100 }
1059 | "page-scroll-scale" -> { c with pgscale = float_of_string v }
1060 | "use-pbo" -> { c with usepbo = bool_of_string v }
1061 | "wheel-scrolls-pages" -> { c with wheelbypage = bool_of_string v }
1062 | "horizontal-scrollbar-visible" ->
1063 let b =
1064 if bool_of_string v
1065 then c.scrollb lor scrollbhv
1066 else c.scrollb land (lnot scrollbhv)
1068 { c with scrollb = b }
1069 | "vertical-scrollbar-visible" ->
1070 let b =
1071 if bool_of_string v
1072 then c.scrollb lor scrollbvv
1073 else c.scrollb land (lnot scrollbvv)
1075 { c with scrollb = b }
1076 | "remote-in-a-new-instance" -> { c with riani = bool_of_string v }
1077 | "point-and-x" ->
1078 { c with pax =
1079 if bool_of_string v
1080 then Some (ref (0.0, 0, 0))
1081 else None }
1082 | "point-and-x-mark" -> { c with paxmark = MTE.of_string v }
1083 | "scroll-bar-on-the-left" -> { c with leftscroll = bool_of_string v }
1084 | "title" -> { c with title = unentS v }
1085 | "last-visit" -> { c with lastvisit = float_of_string v }
1086 | "edit-annotations-inline" -> { c with annotinline = bool_of_string v }
1087 | _ -> c
1088 with exn ->
1089 prerr_endline ("Error processing attribute (`" ^
1090 k ^ "'=`" ^ v ^ "'): " ^ exntos exn);
1093 let rec fold c = function
1094 | [] -> c
1095 | (k, v) :: rest ->
1096 let c = apply c k v in
1097 fold c rest
1099 fold { c with keyhashes = copykeyhashes c } attrs;
1102 let fromstring f pos n v d =
1103 try f v
1104 with exn ->
1105 dolog "Error processing attribute (%S=%S) at %d\n%s"
1106 n v pos (exntos exn);
1110 let bookmark_of attrs =
1111 let rec fold title page rely visy = function
1112 | ("title", v) :: rest -> fold v page rely visy rest
1113 | ("page", v) :: rest -> fold title v rely visy rest
1114 | ("rely", v) :: rest -> fold title page v visy rest
1115 | ("visy", v) :: rest -> fold title page rely v rest
1116 | _ :: rest -> fold title page rely visy rest
1117 | [] -> title, page, rely, visy
1119 fold "invalid" "0" "0" "0" attrs
1122 let doc_of attrs =
1123 let rec fold path page rely pan visy origin = function
1124 | ("path", v) :: rest -> fold v page rely pan visy origin rest
1125 | ("page", v) :: rest -> fold path v rely pan visy origin rest
1126 | ("rely", v) :: rest -> fold path page v pan visy origin rest
1127 | ("pan", v) :: rest -> fold path page rely v visy origin rest
1128 | ("visy", v) :: rest -> fold path page rely pan v origin rest
1129 | ("origin", v) :: rest -> fold path page rely pan visy v rest
1130 | _ :: rest -> fold path page rely pan visy origin rest
1131 | [] -> path, page, rely, pan, visy, origin
1133 fold E.s "0" "0" "0" "0" E.s attrs
1136 let map_of attrs =
1137 let rec fold rs ls = function
1138 | ("out", v) :: rest -> fold v ls rest
1139 | ("in", v) :: rest -> fold rs v rest
1140 | _ :: rest -> fold ls rs rest
1141 | [] -> ls, rs
1143 fold E.s E.s attrs
1146 let setconf dst src =
1147 dst.scrollbw <- src.scrollbw;
1148 dst.scrollh <- src.scrollh;
1149 dst.icase <- src.icase;
1150 dst.preload <- src.preload;
1151 dst.pagebias <- src.pagebias;
1152 dst.verbose <- src.verbose;
1153 dst.scrollstep <- src.scrollstep;
1154 dst.maxhfit <- src.maxhfit;
1155 dst.crophack <- src.crophack;
1156 dst.autoscrollstep <- src.autoscrollstep;
1157 dst.maxwait <- src.maxwait;
1158 dst.hlinks <- src.hlinks;
1159 dst.underinfo <- src.underinfo;
1160 dst.interpagespace <- src.interpagespace;
1161 dst.zoom <- src.zoom;
1162 dst.presentation <- src.presentation;
1163 dst.angle <- src.angle;
1164 dst.cwinw <- src.cwinw;
1165 dst.cwinh <- src.cwinh;
1166 dst.savebmarks <- src.savebmarks;
1167 dst.memlimit <- src.memlimit;
1168 dst.fitmodel <- src.fitmodel;
1169 dst.texcount <- src.texcount;
1170 dst.sliceheight <- src.sliceheight;
1171 dst.thumbw <- src.thumbw;
1172 dst.jumpback <- src.jumpback;
1173 dst.bgcolor <- src.bgcolor;
1174 dst.tilew <- src.tilew;
1175 dst.tileh <- src.tileh;
1176 dst.mustoresize <- src.mustoresize;
1177 dst.checkers <- src.checkers;
1178 dst.aalevel <- src.aalevel;
1179 dst.trimmargins <- src.trimmargins;
1180 dst.trimfuzz <- src.trimfuzz;
1181 dst.urilauncher <- src.urilauncher;
1182 dst.colorspace <- src.colorspace;
1183 dst.invert <- src.invert;
1184 dst.colorscale <- src.colorscale;
1185 dst.redirectstderr <- src.redirectstderr;
1186 dst.ghyllscroll <- src.ghyllscroll;
1187 dst.columns <- src.columns;
1188 dst.beyecolumns <- src.beyecolumns;
1189 dst.selcmd <- src.selcmd;
1190 dst.updatecurs <- src.updatecurs;
1191 dst.pathlauncher <- src.pathlauncher;
1192 dst.keyhashes <- copykeyhashes src;
1193 dst.hfsize <- src.hfsize;
1194 dst.hscrollstep <- src.hscrollstep;
1195 dst.pgscale <- src.pgscale;
1196 dst.usepbo <- src.usepbo;
1197 dst.wheelbypage <- src.wheelbypage;
1198 dst.stcmd <- src.stcmd;
1199 dst.paxcmd <- src.paxcmd;
1200 dst.passcmd <- src.passcmd;
1201 dst.savecmd <- src.savecmd;
1202 dst.scrollb <- src.scrollb;
1203 dst.riani <- src.riani;
1204 dst.paxmark <- src.paxmark;
1205 dst.leftscroll <- src.leftscroll;
1206 dst.title <- src.title;
1207 dst.annotinline <- src.annotinline;
1208 dst.pax <-
1209 if src.pax = None
1210 then None
1211 else Some ((ref (0.0, 0, 0)));
1214 let findkeyhash c name =
1215 try List.assoc name c.keyhashes
1216 with Not_found -> failwith ("invalid mode name `" ^ name ^ "'")
1219 let get s =
1220 let open Parser in
1221 let h = Hashtbl.create 10 in
1222 let dc = { defconf with angle = defconf.angle } in
1223 let rec toplevel v t spos _ =
1224 match t with
1225 | Vdata | Vcdata | Vend -> v
1226 | Vopen ("llppconfig", _, closed) ->
1227 if closed
1228 then v
1229 else { v with f = llppconfig }
1230 | Vopen _ ->
1231 error "unexpected subelement at top level" s spos
1232 | Vclose _ -> error "unexpected close at top level" s spos
1234 and llppconfig v t spos _ =
1235 match t with
1236 | Vdata | Vcdata -> v
1237 | Vend -> error "unexpected end of input in llppconfig" s spos
1238 | Vopen ("defaults", attrs, closed) ->
1239 let c = config_of dc attrs in
1240 setconf dc c;
1241 if closed
1242 then v
1243 else { v with f = defaults }
1245 | Vopen ("ui-font", attrs, closed) ->
1246 let rec getsize size = function
1247 | [] -> size
1248 | ("size", v) :: rest ->
1249 let size =
1250 fromstring int_of_string spos "size" v fstate.fontsize in
1251 getsize size rest
1252 | l -> getsize size l
1254 fstate.fontsize <- getsize fstate.fontsize attrs;
1255 if closed
1256 then v
1257 else { v with f = uifont (Buffer.create 10) }
1259 | Vopen ("doc", attrs, closed) ->
1260 let pathent, spage, srely, span, svisy, origin = doc_of attrs in
1261 let path = unentS pathent
1262 and origin = unentS origin
1263 and pageno = fromstring int_of_string spos "page" spage 0
1264 and rely = fromstring float_of_string spos "rely" srely 0.0
1265 and pan = fromstring int_of_string spos "pan" span 0
1266 and visy = fromstring float_of_string spos "visy" svisy 0.0 in
1267 let c = config_of dc attrs in
1268 let anchor = (pageno, rely, visy) in
1269 if closed
1270 then (Hashtbl.add h path (c, [], pan, anchor, origin); v)
1271 else { v with f = doc path origin pan anchor c [] }
1273 | Vopen _ ->
1274 error "unexpected subelement in llppconfig" s spos
1276 | Vclose "llppconfig" -> { v with f = toplevel }
1277 | Vclose _ -> error "unexpected close in llppconfig" s spos
1279 and defaults v t spos _ =
1280 match t with
1281 | Vdata | Vcdata -> v
1282 | Vend -> error "unexpected end of input in defaults" s spos
1283 | Vopen ("keymap", attrs, closed) ->
1284 let modename =
1285 try List.assoc "mode" attrs
1286 with Not_found -> "global" in
1287 if closed
1288 then v
1289 else
1290 let ret keymap =
1291 let h = findkeyhash dc modename in
1292 KeyMap.iter (Hashtbl.replace h) keymap;
1293 defaults
1295 { v with f = pkeymap ret KeyMap.empty }
1297 | Vopen (_, _, _) ->
1298 error "unexpected subelement in defaults" s spos
1300 | Vclose "defaults" ->
1301 { v with f = llppconfig }
1303 | Vclose _ -> error "unexpected close in defaults" s spos
1305 and uifont b v t spos epos =
1306 match t with
1307 | Vdata | Vcdata ->
1308 Buffer.add_substring b s spos (epos - spos);
1310 | Vopen (_, _, _) ->
1311 error "unexpected subelement in ui-font" s spos
1312 | Vclose "ui-font" ->
1313 if emptystr !fontpath
1314 then fontpath := Buffer.contents b;
1315 { v with f = llppconfig }
1316 | Vclose _ -> error "unexpected close in ui-font" s spos
1317 | Vend -> error "unexpected end of input in ui-font" s spos
1319 and doc path origin pan anchor c bookmarks v t spos _ =
1320 match t with
1321 | Vdata | Vcdata -> v
1322 | Vend -> error "unexpected end of input in doc" s spos
1323 | Vopen ("bookmarks", _, closed) ->
1324 if closed
1325 then v
1326 else { v with f = pbookmarks path origin pan anchor c bookmarks }
1328 | Vopen ("keymap", attrs, closed) ->
1329 let modename =
1330 try List.assoc "mode" attrs
1331 with Not_found -> "global"
1333 if closed
1334 then v
1335 else
1336 let ret keymap =
1337 let h = findkeyhash c modename in
1338 KeyMap.iter (Hashtbl.replace h) keymap;
1339 doc path origin pan anchor c bookmarks
1341 { v with f = pkeymap ret KeyMap.empty }
1343 | Vopen (_, _, _) ->
1344 error "unexpected subelement in doc" s spos
1346 | Vclose "doc" ->
1347 Hashtbl.add h path (c, List.rev bookmarks, pan, anchor, origin);
1348 { v with f = llppconfig }
1350 | Vclose _ -> error "unexpected close in doc" s spos
1352 and pkeymap ret keymap v t spos _ =
1353 match t with
1354 | Vdata | Vcdata -> v
1355 | Vend -> error "unexpected end of input in keymap" s spos
1356 | Vopen ("map", attrs, closed) ->
1357 let r, l = map_of attrs in
1358 let kss = fromstring keys_of_string spos "in" r [] in
1359 let lss = fromstring keys_of_string spos "out" l [] in
1360 let keymap =
1361 match kss with
1362 | [] -> keymap
1363 | ks :: [] -> KeyMap.add ks (KMinsrl lss) keymap
1364 | ks :: rest -> KeyMap.add ks (KMmulti (rest, lss)) keymap
1366 if closed
1367 then { v with f = pkeymap ret keymap }
1368 else
1369 let f () = v in
1370 { v with f = skip "map" f }
1372 | Vopen _ ->
1373 error "unexpected subelement in keymap" s spos
1375 | Vclose "keymap" ->
1376 { v with f = ret keymap }
1378 | Vclose _ -> error "unexpected close in keymap" s spos
1380 and pbookmarks path origin pan anchor c bookmarks v t spos _ =
1381 match t with
1382 | Vdata | Vcdata -> v
1383 | Vend -> error "unexpected end of input in bookmarks" s spos
1384 | Vopen ("item", attrs, closed) ->
1385 let titleent, spage, srely, svisy = bookmark_of attrs in
1386 let page = fromstring int_of_string spos "page" spage 0
1387 and rely = fromstring float_of_string spos "rely" srely 0.0
1388 and visy = fromstring float_of_string spos "visy" svisy 0.0 in
1389 let bookmarks =
1390 (unentS titleent, 0, Oanchor (page, rely, visy)) :: bookmarks
1392 if closed
1393 then { v with f = pbookmarks path origin pan anchor c bookmarks }
1394 else
1395 let f () = v in
1396 { v with f = skip "item" f }
1398 | Vopen _ ->
1399 error "unexpected subelement in bookmarks" s spos
1401 | Vclose "bookmarks" ->
1402 { v with f = doc path origin pan anchor c bookmarks }
1404 | Vclose _ -> Parser.parse_error "unexpected close in bookmarks" s spos
1406 and skip tag f v t spos _ =
1407 match t with
1408 | Vdata | Vcdata -> v
1409 | Vend ->
1410 Parser.parse_error ("unexpected end of input in skipped " ^ tag) s spos
1411 | Vopen (tag', _, closed) ->
1412 if closed
1413 then v
1414 else
1415 let f' () = { v with f = skip tag f } in
1416 { v with f = skip tag' f' }
1417 | Vclose ctag ->
1418 if tag = ctag
1419 then f ()
1420 else Parser.parse_error ("unexpected close in skipped " ^ tag) s spos
1423 parse { f = toplevel; accu = () } s;
1424 h, dc;
1427 let do_load f contents =
1428 try f contents
1429 with
1430 | Parser.Parse_error (msg, s, pos) ->
1431 let subs = Parser.subs s pos in
1432 Utils.error "parse error: %s: at %d [..%s..]" msg pos subs
1434 | exn ->
1435 failwith ("config load error: " ^ 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 config 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 ob s a b =
1511 if always || a != b
1512 then Printf.bprintf bb "\n %s='%b'" s a
1513 and op s a b =
1514 if always || a <> b
1515 then Printf.bprintf bb "\n %s='%b'" s (a != None)
1516 and oi s a b =
1517 if always || a != b
1518 then Printf.bprintf bb "\n %s='%d'" s a
1519 and oI s a b =
1520 if always || a != b
1521 then Printf.bprintf bb "\n %s='%s'" s (string_with_suffix_of_int a)
1522 and oz s a b =
1523 if always || a <> b
1524 then Printf.bprintf bb "\n %s='%g'" s (a*.100.)
1525 and oF s a b =
1526 if always || a <> b
1527 then Printf.bprintf bb "\n %s='%f'" s a
1528 and oL s a b =
1529 if always || a <> b
1530 then Printf.bprintf bb "\n %s='%Ld'" s a
1531 and oc s a b =
1532 if always || a <> b
1533 then Printf.bprintf bb "\n %s='%s'" s (color_to_string a)
1534 and oC s a b =
1535 if always || a <> b
1536 then Printf.bprintf bb "\n %s='%s'" s (CSTE.to_string a)
1537 and oR s a b =
1538 if always || a <> b
1539 then Printf.bprintf bb "\n %s='%s'" s (irect_to_string a)
1540 and os s a b =
1541 if always || a <> b
1542 then
1543 Printf.bprintf bb "\n %s='%s'" s (Parser.enent a 0 (String.length a))
1544 and og s a b =
1545 if always || a <> b
1546 then
1547 match a with
1548 | Some (_N, _A, _B) ->
1549 Printf.bprintf bb "\n %s='%u,%u,%u'" s _N _A _B
1550 | None ->
1551 match b with
1552 | None -> ()
1553 | _ ->
1554 Printf.bprintf bb "\n %s='none'" s
1555 and oW s a b =
1556 if always || a <> b
1557 then
1558 let v =
1559 match a with
1560 | None -> "false"
1561 | Some f ->
1562 if f = infinity
1563 then "true"
1564 else string_of_float f
1566 Printf.bprintf bb "\n %s='%s'" s v
1567 and oco s a b =
1568 if always || a <> b
1569 then
1570 match a with
1571 | Cmulti ((n, a, b), _) when n > 1 ->
1572 Printf.bprintf bb "\n %s='%d,%d,%d'" s n a b
1573 | Csplit (n, _) when n > 1 ->
1574 Printf.bprintf bb "\n %s='%d'" s ~-n
1575 | Cmulti _ | Csplit _ | Csingle _ -> ()
1576 and obeco s a b =
1577 if always || a <> b
1578 then
1579 match a with
1580 | Some c when c > 1 -> Printf.bprintf bb "\n %s='%d'" s c
1581 | _ -> ()
1582 and oFm s a b =
1583 if always || a <> b
1584 then Printf.bprintf bb "\n %s='%s'" s (FMTE.to_string a)
1585 and oSv s a b m =
1586 if always || a <> b
1587 then Printf.bprintf bb "\n %s='%b'" s (a land m != 0)
1588 and oPm s a b =
1589 if always || a <> b
1590 then Printf.bprintf bb "\n %s='%s'" s (MTE.to_string a)
1592 oi "width" c.cwinw dc.cwinw;
1593 oi "height" c.cwinh dc.cwinh;
1594 oi "scroll-bar-width" c.scrollbw dc.scrollbw;
1595 oi "scroll-handle-height" c.scrollh dc.scrollh;
1596 oSv "horizontal-scrollbar-visible" c.scrollb dc.scrollb scrollbhv;
1597 oSv "vertical-scrollbar-visible" c.scrollb dc.scrollb scrollbvv;
1598 ob "case-insensitive-search" c.icase dc.icase;
1599 ob "preload" c.preload dc.preload;
1600 oi "page-bias" c.pagebias dc.pagebias;
1601 oi "scroll-step" c.scrollstep dc.scrollstep;
1602 oi "auto-scroll-step" c.autoscrollstep dc.autoscrollstep;
1603 ob "max-height-fit" c.maxhfit dc.maxhfit;
1604 ob "crop-hack" c.crophack dc.crophack;
1605 oW "throttle" c.maxwait dc.maxwait;
1606 ob "highlight-links" c.hlinks dc.hlinks;
1607 ob "under-cursor-info" c.underinfo dc.underinfo;
1608 oi "vertical-margin" c.interpagespace dc.interpagespace;
1609 oz "zoom" c.zoom dc.zoom;
1610 ob "presentation" c.presentation dc.presentation;
1611 oi "rotation-angle" c.angle dc.angle;
1612 ob "persistent-bookmarks" c.savebmarks dc.savebmarks;
1613 oFm "fit-model" c.fitmodel dc.fitmodel;
1614 oI "pixmap-cache-size" c.memlimit dc.memlimit;
1615 oi "tex-count" c.texcount dc.texcount;
1616 oi "slice-height" c.sliceheight dc.sliceheight;
1617 oi "thumbnail-width" c.thumbw dc.thumbw;
1618 ob "persistent-location" c.jumpback dc.jumpback;
1619 oc "background-color" c.bgcolor dc.bgcolor;
1620 oi "tile-width" c.tilew dc.tilew;
1621 oi "tile-height" c.tileh dc.tileh;
1622 oI "mupdf-store-size" c.mustoresize dc.mustoresize;
1623 ob "checkers" c.checkers dc.checkers;
1624 oi "aalevel" c.aalevel dc.aalevel;
1625 ob "trim-margins" c.trimmargins dc.trimmargins;
1626 oR "trim-fuzz" c.trimfuzz dc.trimfuzz;
1627 os "uri-launcher" c.urilauncher dc.urilauncher;
1628 os "path-launcher" c.pathlauncher dc.pathlauncher;
1629 oC "color-space" c.colorspace dc.colorspace;
1630 ob "invert-colors" c.invert dc.invert;
1631 oF "brightness" c.colorscale dc.colorscale;
1632 ob "redirectstderr" c.redirectstderr dc.redirectstderr;
1633 og "ghyllscroll" c.ghyllscroll dc.ghyllscroll;
1634 oco "columns" c.columns dc.columns;
1635 obeco "birds-eye-columns" c.beyecolumns dc.beyecolumns;
1636 os "selection-command" c.selcmd dc.selcmd;
1637 os "synctex-command" c.stcmd dc.stcmd;
1638 os "pax-command" c.paxcmd dc.paxcmd;
1639 os "askpass-command" c.passcmd dc.passcmd;
1640 os "savepath-command" c.savecmd dc.savecmd;
1641 ob "update-cursor" c.updatecurs dc.updatecurs;
1642 oi "hint-font-size" c.hfsize dc.hfsize;
1643 oi "horizontal-scroll-step" c.hscrollstep dc.hscrollstep;
1644 oF "page-scroll-scale" c.pgscale dc.pgscale;
1645 ob "use-pbo" c.usepbo dc.usepbo;
1646 ob "wheel-scrolls-pages" c.wheelbypage dc.wheelbypage;
1647 ob "remote-in-a-new-instance" c.riani dc.riani;
1648 op "point-and-x" c.pax dc.pax;
1649 oPm "point-and-x-mark" c.paxmark dc.paxmark;
1650 ob "scroll-bar-on-the-left" c.leftscroll dc.leftscroll;
1651 if not always
1652 then os "title" c.title dc.title;
1653 oL "last-visit" (Int64.of_float time) 0L;
1654 ob "edit-annotations-inline" c.annotinline dc.annotinline;
1657 let keymapsbuf always dc c =
1658 let bb = Buffer.create 16 in
1659 let rec loop = function
1660 | [] -> ()
1661 | (modename, h) :: rest ->
1662 let dh = findkeyhash dc modename in
1663 if always || h <> dh
1664 then (
1665 if Hashtbl.length h > 0
1666 then (
1667 if Buffer.length bb > 0
1668 then Buffer.add_char bb '\n';
1669 Printf.bprintf bb "<keymap mode='%s'>\n" modename;
1670 Hashtbl.iter (fun i o ->
1671 let isdifferent = always ||
1673 let dO = Hashtbl.find dh i in
1674 dO <> o
1675 with Not_found -> true
1677 if isdifferent
1678 then
1679 let addkm (k, m) =
1680 if Wsi.withctrl m then Buffer.add_string bb "ctrl-";
1681 if Wsi.withalt m then Buffer.add_string bb "alt-";
1682 if Wsi.withshift m then Buffer.add_string bb "shift-";
1683 if Wsi.withmeta m then Buffer.add_string bb "meta-";
1684 Buffer.add_string bb (Wsi.keyname k);
1686 let addkms l =
1687 let rec loop = function
1688 | [] -> ()
1689 | km :: [] -> addkm km
1690 | km :: rest -> addkm km; Buffer.add_char bb ' '; loop rest
1692 loop l
1694 Buffer.add_string bb "<map in='";
1695 addkm i;
1696 match o with
1697 | KMinsrt km ->
1698 Buffer.add_string bb "' out='";
1699 addkm km;
1700 Buffer.add_string bb "'/>\n"
1702 | KMinsrl kms ->
1703 Buffer.add_string bb "' out='";
1704 addkms kms;
1705 Buffer.add_string bb "'/>\n"
1707 | KMmulti (ins, kms) ->
1708 Buffer.add_char bb ' ';
1709 addkms ins;
1710 Buffer.add_string bb "' out='";
1711 addkms kms;
1712 Buffer.add_string bb "'/>\n"
1713 ) h;
1714 Buffer.add_string bb "</keymap>";
1717 loop rest
1719 loop c.keyhashes;
1723 let save1 bb leavebirdseye x h dc =
1724 let uifontsize = fstate.fontsize in
1725 let dc = if conf.bedefault then conf else dc in
1726 Buffer.add_string bb "<llppconfig>\n";
1728 if nonemptystr !fontpath
1729 then
1730 Printf.bprintf bb "<ui-font size='%d'><![CDATA[%s]]></ui-font>\n"
1731 uifontsize
1732 !fontpath
1733 else (
1734 if uifontsize <> 14
1735 then
1736 Printf.bprintf bb "<ui-font size='%d'/>\n" uifontsize
1739 Buffer.add_string bb "<defaults";
1740 add_attrs bb true dc dc nan;
1741 let kb = keymapsbuf true dc dc in
1742 if Buffer.length kb > 0
1743 then (
1744 Buffer.add_string bb ">\n";
1745 Buffer.add_buffer bb kb;
1746 Buffer.add_string bb "\n</defaults>\n";
1748 else Buffer.add_string bb "/>\n";
1750 let adddoc path pan anchor c bookmarks time origin =
1751 if bookmarks == [] && c = dc && anchor = emptyanchor
1752 then ()
1753 else (
1754 Printf.bprintf bb "<doc path='%s'"
1755 (Parser.enent path 0 (String.length path));
1757 if nonemptystr origin
1758 then
1759 Printf.bprintf bb "\n origin='%s'"
1760 (Parser.enent origin 0 (String.length origin));
1762 if anchor <> emptyanchor
1763 then (
1764 let n, rely, visy = anchor in
1765 Printf.bprintf bb "\n page='%d'" n;
1766 if rely > 1e-6
1767 then
1768 Printf.bprintf bb " rely='%f'" rely
1770 if abs_float visy > 1e-6
1771 then
1772 Printf.bprintf bb " visy='%f'" visy
1776 if pan != 0
1777 then Printf.bprintf bb " pan='%d'" pan;
1779 add_attrs bb false dc c time;
1780 let kb = keymapsbuf false dc c in
1782 begin match bookmarks with
1783 | [] ->
1784 if Buffer.length kb > 0
1785 then (
1786 Buffer.add_string bb ">\n";
1787 Buffer.add_buffer bb kb;
1788 Buffer.add_string bb "\n</doc>\n";
1790 else Buffer.add_string bb "/>\n"
1791 | _ ->
1792 Buffer.add_string bb ">\n<bookmarks>\n";
1793 List.iter (fun (title, _, kind) ->
1794 begin match kind with
1795 | Oanchor (page, rely, visy) ->
1796 Printf.bprintf bb
1797 "<item title='%s' page='%d'"
1798 (Parser.enent title 0 (String.length title))
1799 page
1801 if rely > 1e-6
1802 then
1803 Printf.bprintf bb " rely='%f'" rely
1805 if abs_float visy > 1e-6
1806 then
1807 Printf.bprintf bb " visy='%f'" visy
1809 | Ohistory _ | Onone | Ouri _ | Oremote _
1810 | Oremotedest _ | Olaunch _ | Oaction _ | Oreaction _ ->
1811 failwith "unexpected link in bookmarks"
1812 end;
1813 Buffer.add_string bb "/>\n";
1814 ) bookmarks;
1815 Buffer.add_string bb "</bookmarks>";
1816 if Buffer.length kb > 0
1817 then (
1818 Buffer.add_string bb "\n";
1819 Buffer.add_buffer bb kb;
1821 Buffer.add_string bb "\n</doc>\n";
1822 end;
1826 let pan, conf =
1827 match state.mode with
1828 | Birdseye (c, pan, _, _, _) ->
1829 let beyecolumns =
1830 match conf.columns with
1831 | Cmulti ((c, _, _), _) -> Some c
1832 | Csingle _ -> None
1833 | Csplit _ -> None
1834 and columns =
1835 match c.columns with
1836 | Cmulti (c, _) -> Cmulti (c, E.a)
1837 | Csingle _ -> Csingle E.a
1838 | Csplit _ -> failwith "quit from bird's eye while split"
1840 pan, { c with beyecolumns = beyecolumns; columns = columns }
1841 | Textentry _
1842 | View
1843 | LinkNav _ -> x, conf
1845 let docpath = if nonemptystr state.path then abspath state.path else E.s in
1846 if nonemptystr docpath
1847 then (
1848 adddoc docpath pan (getanchor ())
1850 let autoscrollstep =
1851 match state.autoscroll with
1852 | Some step -> step
1853 | None -> conf.autoscrollstep
1855 begin match state.mode with
1856 | Birdseye beye -> leavebirdseye beye true
1857 | Textentry _
1858 | View
1859 | LinkNav _ -> ()
1860 end;
1861 { conf with autoscrollstep = autoscrollstep }
1863 (if conf.savebmarks then state.bookmarks else [])
1864 (now ())
1865 state.origin
1867 Hashtbl.iter (fun path (c, bookmarks, x, anchor, origin) ->
1868 if docpath <> abspath path
1869 then adddoc path x anchor c bookmarks c.lastvisit origin
1870 ) h;
1871 Buffer.add_string bb "</llppconfig>\n";
1872 true;
1875 let save leavebirdseye =
1876 let relx = float state.x /. float state.winw in
1877 let w, h, x =
1878 let cx w = truncate (relx *. float w) in
1879 List.fold_left
1880 (fun (w, h, x) ws ->
1881 match ws with
1882 | Wsi.Fullscreen -> (conf.cwinw, conf.cwinh, cx conf.cwinw)
1883 | Wsi.MaxVert -> (w, conf.cwinh, x)
1884 | Wsi.MaxHorz -> (conf.cwinw, h, cx conf.cwinw)
1886 (state.winw, state.winh, state.x) state.winstate
1888 conf.cwinw <- w;
1889 conf.cwinh <- h;
1890 let bb = Buffer.create 32768 in
1891 let save2 (h, dc) =
1892 save1 bb leavebirdseye x h dc
1894 if load1 save2 && Buffer.length bb > 0
1895 then
1897 let tmp = !confpath ^ ".tmp" in
1898 let oc = open_out_bin tmp in
1899 Buffer.output_buffer oc bb;
1900 close_out oc;
1901 Unix.rename tmp !confpath;
1902 with exn ->
1903 prerr_endline
1904 ("error while saving configuration: " ^ exntos exn)
1907 let gc fdi fdo =
1908 let wr s n =
1909 let n' = Unix.write fdo (Bytes.of_string s) 0 n in
1910 if n != n'
1911 then Utils.error "Unix.write %d = %d" n n'
1913 let rd s n =
1914 try Unix.read fdi s 0 n
1915 with exn -> Utils.error "reading gc pipe %s" (exntos exn) in
1916 let href = ref (Hashtbl.create 0) in
1917 let cref = ref defconf in
1918 let push (h, dc) =
1919 let f path (pc, _pb, _px, _pa, _po) =
1920 let s =
1921 Printf.sprintf "%s\000%ld\000" path (Int32.of_float pc.lastvisit)
1923 wr s (String.length s)
1925 Hashtbl.iter f h;
1926 href := h;
1927 cref := dc;
1928 Unix.shutdown fdo Unix.SHUTDOWN_SEND;
1929 true
1931 ignore (load1 push);
1932 let s =
1933 let b = Buffer.create 32768 in
1934 let s = Bytes.create 4096 in
1935 let rec f () =
1936 let n = rd s (Bytes.length s) in
1937 if n = 0
1938 then Buffer.contents b
1939 else (Buffer.add_subbytes b s 0 n; f ())
1941 f ()
1943 let rec f ppos =
1944 match String.index_from s ppos '\000' with
1945 | zpos1 ->
1946 let zpos2 =
1947 try String.index_from s (zpos1+1) '\000' with Not_found -> -1 in
1948 if zpos2 = -1
1949 then error "Incorrect gc input in (%S) at %d" s zpos1
1950 else
1951 let okey = StringLabels.sub s ~pos:ppos ~len:(zpos1-ppos) in
1952 let nkey = StringLabels.sub s ~pos:(zpos1+1) ~len:(zpos2-zpos1-1) in
1953 if emptystr nkey
1954 then (Hashtbl.remove !href okey; f (zpos2+1))
1955 else
1956 let v =
1957 try Hashtbl.find !href okey
1958 with Not_found -> Utils.error "gc: could not find %S" okey
1960 Hashtbl.remove !href okey;
1961 Hashtbl.replace !href nkey v;
1962 f (zpos2+1)
1963 | exception Not_found -> ()
1965 f 0;
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 prerr_endline
1978 ("error while saving configuration: " ^ exntos exn)
1982 let logcurrently = function
1983 | Idle -> dolog "Idle"
1984 | Loading (l, gen) ->
1985 dolog "Loading %d gen=%d curgen=%d" l.pageno gen state.gen
1986 | Tiling (l, pageopaque, colorspace, angle, gen, col, row, tilew, tileh) ->
1987 dolog
1988 "Tiling %d[%d,%d] page=%s cs=%s angle"
1989 l.pageno col row (~> pageopaque)
1990 (CSTE.to_string colorspace)
1992 dolog "gen=(%d,%d) (%d,%d) tile=(%d,%d) (%d,%d)"
1993 angle gen conf.angle state.gen
1994 tilew tileh
1995 conf.tilew conf.tileh
1997 | Outlining _ ->
1998 dolog "outlining"