3 let irect_of_string s
=
4 Scanf.sscanf s
"%d/%d/%d/%d" (fun x0 y0 x1 y1
-> (x0
,y0
,x1
,y1
))
6 let irect_to_string (x0
,y0
,x1
,y1
) = Printf.sprintf
"%d/%d/%d/%d" x0 y0 x1 y1
8 let multicolumns_to_string (n
, a
, b
) =
10 then Printf.sprintf
"%d" n
11 else Printf.sprintf
"%d,%d,%d" n a b
13 let multicolumns_of_string s
=
15 (int_of_string s
, 0, 0)
17 Scanf.sscanf s
"%u,%u,%u" (fun n a b
->
19 then error
"subtly broken";
33 and trimmargins
= bool
34 and trimparams
= (trimmargins
* irect
)
39 and tileparams
= (x
* y
* w
* h
* tilex
* tiley
)
44 | Utextannot
of (opaque
* slinkindex
)
45 | Ufileannot
of (opaque
* slinkindex
)
48 and launchcommand
= string
58 | LDfirstvisible
of (int * int * int)
66 and anchor
= pageno
* top
* dtop
67 and rect
= float * float * float * float * float * float * float * float
68 and infochange
= | Memused
| Docinfo
| Pdim
69 and redirstderr
= bool
71 { mutable fontsize
: int
72 ; mutable wwidth
: float
73 ; mutable maxrows
: int
77 { fontsize
= Wsi.fontsizescale
20
85 method key
: int -> int -> uioh
86 method button
: int -> bool -> int -> int -> int -> uioh
87 method multiclick
: int -> int -> int -> int -> uioh
88 method motion
: int -> int -> uioh
89 method pmotion
: int -> int -> uioh
90 method infochanged
: infochange
-> unit
91 method scrollpw
: (int * float * float)
92 method scrollph
: (int * float * float)
93 method modehash
: keyhash
94 method eformsgs
: bool
95 method alwaysscrolly
: bool
96 method scroll
: int -> int -> uioh
97 method zoom
: float -> int -> int -> unit
100 module type TextEnumType
= sig
103 val names
: string array
106 module TextEnumMake
(Ten
: TextEnumType
) = struct
107 let names = Ten.names
108 let to_int (t
: Ten.t
) = Obj.magic t
109 let to_string t
= names.(to_int t
)
110 let of_int n
: Ten.t
= Obj.magic n
113 if i
= Array.length
names
114 then error
"invalid %s: %s" Ten.name s
123 module CSTE
= TextEnumMake
(struct
125 let name = "colorspace"
126 let names = [|"rgb"; "gray"|]
129 module MTE
= TextEnumMake
(struct
132 let names = [|"page"; "block"; "line"; "word"|]
135 module FMTE
= TextEnumMake
(struct
137 let name = "fitmodel"
138 let names = [|"width"; "proportional"; "page"|]
145 | Olaunch
of launchcommand
146 | Oremote
of (filename
* pageno
)
147 | Oremotedest
of (filename
* destname
)
148 | Ohistory
of (filename
* conf
* outline list
* x
* anchor
* filename
)
149 and outline
= (caption
* outlinelevel
* outlinekind
)
150 and outlinelevel
= int
166 type tile
= opaque
* pixmapsize
* elapsed
168 and pagemapkey
= pageno
* gen
169 and tilemapkey
= pageno
* gen
* colorspace
* angle
* w
* h
* col
* row
174 | Loading
of (page
* gen
)
176 of (page
* opaque
* colorspace
* angle
* gen
* col
* row
* w
* h
)
177 | Outlining
of outline list
181 | Msel
of (mpos
* mpos
)
183 | Mscrolly
| Mscrollx
184 | Mzoom
of (buttonno
* step
* mpos
)
185 | Mzoomrect
of (mpos
* mpos
)
190 | Birdseye
of (conf
* leftx
* pageno
* pageno
* anchor
)
191 | Textentry
of (textentry
* onleave
)
192 | LinkNav
of linktarget
193 and onleave
= leavetextentrystatus
-> unit
194 and leavetextentrystatus
= | Cancel
| Confirm
195 and helpitem
= string * int * action
196 and action
= (uioh
-> uioh
) option
198 | Ltexact
of (pageno
* direction
)
199 | Ltgendir
of direction
200 | Ltnotready
of (pageno
* direction
)
201 and direction
= int (* -1, 0, 1 *)
202 and textentry
= string * string * onhist
option * onkey
* ondone
* cancelonempty
203 and onkey
= string -> Keys.t
-> te
204 and ondone
= string -> unit
205 and histcancel
= unit -> unit
206 and onhist
= ((histcmd
-> string) * histcancel
)
207 and histcmd
= HCnext
| HCprev
| HCfirst
| HClast
208 and cancelonempty
= bool
213 | TEswitch
of textentry
225 let emptykeyhash = Hashtbl.create
0
232 method key _ _
= self
233 method multiclick _ _ _ _
= self
234 method button _ _ _ _ _
= self
235 method motion _ _
= self
236 method pmotion _ _
= self
237 method infochanged _
= ()
238 method scrollpw
= (0, nan
, nan
)
239 method scrollph
= (0, nan
, nan
)
240 method modehash
= emptykeyhash
241 method eformsgs
= false
242 method alwaysscrolly
= false
243 method scroll _ _
= self
244 method zoom _ _ _
= ()
248 { store
= Array.make n v
254 let cbcap b
= Array.length b
.store
256 let cbput ?
(update_rc
=true) b v
=
259 b
.wc
<- (b
.wc
+ 1) mod cap;
262 b
.len
<- min
(b
.len
+ 1) cap
264 let cbput_dont_update_rc b v
= cbput ~update_rc
:false b v
266 let cbempty b
= b
.len
= 0
268 let cbgetg b circular dir
=
272 let rc = b
.rc + dir
in
284 else bound
rc 0 (b
.len
-1)
289 let cbget b
= cbgetg b
false
290 let cbgetc b
= cbgetg b
true
293 { pat
: string circbuf
294 ; pag
: string circbuf
295 ; sel
: string circbuf
299 try Sys.getenv
"HOME"
301 dolog
"cannot determine home directory location: %s" @@ exntos exn
;
306 let dir = Filename.concat
home ".config" in
307 if Sys.is_directory
dir then dir else home
309 Filename.concat
dir "llpp.conf"
312 let confpath = ref defconfpath
313 let ss = ref Unix.stdin
314 let wsfd = ref Unix.stdin
315 let stderr = ref Unix.stdin
316 let selfexec = ref E.s
317 let ignoredoctitlte = ref false
318 let errmsgs = Buffer.create
0
319 let newerrmsgs = ref false
326 let ranchors : (string * string * string * anchor * string) list
ref = ref []
327 let maxy = ref max_int
328 let layout : page list
ref = ref []
329 let pagemap : (pagemapkey
, opaque
) Hashtbl.t
= Hashtbl.create
0
330 let tilemap : (tilemapkey
, tile
) Hashtbl.t
= Hashtbl.create
0
331 let pdims : (pageno
* w * h
* leftx
) list
ref = ref []
332 let pagecount = ref max_int
333 let currently = ref Idle
334 let mstate = ref Mnone
335 let searchpattern = ref E.s
336 let rects : (pageno
* rectcolor
* rect
) list
ref = ref []
337 let rects1 : (pageno
* rectcolor
* rect
) list
ref = ref []
340 let password = ref E.s
341 let mimetype = ref E.s
342 let nameddest = ref E.s
344 let winstate : Wsi.winstate list
ref = ref []
345 let mode : mode ref = ref View
346 let uioh : uioh ref = ref nouioh
347 let outlines : outline array
ref = ref [||]
348 let bookmarks : outline list
ref = ref []
349 let geomcmds : (string * ((string * (unit -> unit)) list
)) ref
351 let memused : memsize
ref = ref 0
352 let gen : gen ref = ref 0
353 let autoscroll : int option ref = ref None
354 let help : helpitem array
ref = ref E.a
355 let docinfo : (int * string) list
ref = ref []
356 let hists : hists ref
357 = ref { pat
= cbnew 10 E.s
; pag
= cbnew 10 E.s
; sel
= cbnew 10 E.s
; }
358 let prevzoom = ref (1.0, 0)
359 let progress = ref ~
-.1.0
360 let mpos = ref (-1, -1)
361 let keystate = ref KSnone
362 let glinks = ref false
363 let prevcolumns : (columns
* zoom
) option ref = ref None
366 let reprf = ref noreprf
367 let roamf = ref noroamf
368 let bzoom = ref false
369 let lnava : (pageno
* linkno
) option ref = ref None
370 let reload : (x * y * float) option ref = ref None
371 let nav : anchor nav ref = ref { past
= []; future
= []; }
372 let tilelru : (tilemapkey
* opaque
* pixmapsize
) Queue.t
= Queue.create
()
373 let fontpath = ref E.s
374 let redirstderr = ref false
377 let conf = { defconf
with keyhashes
= copykeyhashes defconf
}
380 let d = !S.winh - h
in
381 max
conf.interpagespace
((d + 1) / 2)
383 let rowyh (c
, coverA
, coverB
) b n
=
384 if c
= 1 || (n
< coverA
|| n
>= !S.pagecount - coverB
)
386 let _, _, vy
, (_, _, h
, _) = b
.(n
) in
389 let n'
= n - coverA
in
392 let e = min
!S.pagecount (s + c
) in
393 let rec findminmax m miny maxh
=
397 let _, _, y, (_, _, h
, _) = b
.(m
) in
398 let miny = min
miny y in
399 let maxh = max
maxh h
in
400 findminmax (m
+1) miny maxh
402 findminmax s max_int
0
405 let ((c
, coverA
, coverB
) as cl
), b
=
406 match conf.columns
with
407 | Csplit
(_, b
) | Csingle b
-> (1, 0, 0), b
408 | Cmulti
(c
, b
) -> c
, b
410 if Array.length b
= 0
413 let rec bsearch nmin nmax
=
415 then bound nmin
0 (!S.pagecount-1)
417 let n = (nmax
+ nmin
) / 2 in
418 let vy, h
= rowyh cl b
n in
422 let ips = calcips h
in
424 let y1 = vy + h
+ ips in
428 then 0, vy + h
+ conf.interpagespace
430 let y0 = vy - conf.interpagespace
in
431 y0, y0 + h
+ conf.interpagespace
441 if n < !S.pagecount - coverB
442 then ((n-coverA
)/c
)*c
+ coverA
449 then bsearch (n+1) nmax
450 else bsearch nmin
(n-1)
453 bsearch 0 (!S.pagecount-1)
456 match conf.columns
with
457 | Cmulti
((_, _, _) as cl
, b
) ->
458 if Array.length b
> 0
460 let y, h
= rowyh cl b
(Array.length b
- 1) in
461 y + h
+ (if conf.presentation
then calcips h
else 0)
464 if Array.length b
> 0
466 let (_, _, y, (_, _, h
, _)) = b
.(Array.length b
- 1) in
467 y + h
+ (if conf.presentation
then calcips h
else 0)
470 if Array.length b
> 0
472 let (_, _, y, (_, _, h
, _)) = b
.(Array.length b
- 1) in
476 let getpageywh pageno
=
477 let pageno = bound
pageno 0 (!S.pagecount-1) in
478 match conf.columns
with
480 if Array.length b
= 0
483 let (_, _, y, (_, w, h
, _)) = b
.(pageno) in
491 if Array.length b
= 0
494 let y, h
= rowyh cl b
pageno in
495 let (_, _, _, (_, w, _, _)) = b
.(pageno) in
503 if Array.length b
= 0
507 let (_, _, y, (_, w, h
, _)) = b
.(n) in
510 let getpageyh pageno =
511 let y,_,h
= getpageywh pageno in
514 let getpagedim pageno =
517 | (n, _, _, _) as pdim
:: rest
->
519 then (if n = pageno then pdim
else ppdim
)
523 f (-1, -1, -1, -1) !S.pdims
525 let getpdimno pageno =
529 | (n, _, _, _) :: rest
->
531 then (if n = pageno then np else p
)
537 let getpagey pageno = fst
(getpageyh pageno)
541 let coloff = l
.pagecol
* l
.pageh
in
542 float (l
.pagey
+ coloff) /. float l
.pageh
549 then float l
.pagedispy
/. float (calcips l
.pageh
)
550 else float l
.pagedispy
/. float conf.interpagespace
553 (l
.pageno, top, dtop)
557 | l
:: _ -> getanchor1 l
559 let n = page_of_y !S.y in
563 let y, h
= getpageyh n in
568 let ips = calcips h
in
569 float (dy + ips) /. float ips
570 else float dy /. float conf.interpagespace
574 type historder
= [ `lastvisit
| `title
| `
path | `file
]
577 Map.Make
(struct type t
= (int * int) let compare = compare end)
580 let l = String.length
s in
581 let b = Buffer.create
l in
582 Parser.unent
b s 0 l;
585 let modifier_of_string = function
586 | "alt" -> Wsi.altmask
587 | "shift" -> Wsi.shiftmask
588 | "ctrl" | "control" -> Wsi.ctrlmask
589 | "meta" -> Wsi.metamask
592 let keys_of_string s =
593 let key_of_string r
s =
594 let elems = Str.full_split r
s in
597 let m1 = modifier_of_string s in
599 then (Wsi.namekey
s, m
)
602 | Str.Delim
s when n land 1 = 0 -> g s
604 | Str.Delim
_ -> (k
, m
)
606 let rec loop n k m
= function
609 let k, m
= f n k m
x in
614 let elems = Str.split
Utils.Re.whitespace
s in
615 List.map
(key_of_string (Str.regexp
"-")) elems
618 let l = String.length v
in
620 then error
"set must contain more than one char, but has %d" l;
621 let module S
= Set.Make
(struct type t
= char
let compare = compare end) in
625 let e = String.get v i
in
627 then error
"set has duplicates (at least '%c')" e
628 else check (S.add
e s) (i
+1)
630 check (S.singleton
(String.get v
0)) 1
632 let config_of c attrs
=
633 let maxv ?
(f=int_of_string
) u
s = max u
@@ f s in
637 | "scroll-bar-width" -> { c
with scrollbw
= maxv 0 v
}
638 | "scroll-handle-height" -> { c
with scrollh
= maxv 0 v
}
639 | "case-insensitive-search" -> { c
with icase
= bool_of_string v
}
640 | "preload" -> { c
with preload
= bool_of_string v
}
641 | "page-bias" -> { c
with pagebias
= int_of_string v
}
642 | "scroll-step" -> { c
with scrollstep
= maxv 1 v
}
643 | "horizontal-scroll-step" -> { c
with hscrollstep
= maxv 1 v
}
644 | "auto-scroll-step" -> { c
with autoscrollstep
= maxv 0 v
}
645 | "max-height-fit" -> { c
with maxhfit
= bool_of_string v
}
646 | "highlight-links" -> { c
with hlinks
= bool_of_string v
}
647 | "under-cursor-info" -> { c
with underinfo
= bool_of_string v
}
648 | "vertical-margin" -> { c
with interpagespace
= maxv 0 v
}
650 let zoom = float_of_string v
/. 100. in
651 let zoom = max
zoom 0.0 in
652 { c
with zoom = zoom }
653 | "presentation" -> { c
with presentation
= bool_of_string v
}
654 | "rotation-angle" -> { c
with angle
= int_of_string v
}
655 | "width" -> { c
with cwinw
= maxv 20 v
}
656 | "height" -> { c
with cwinh
= maxv 20 v
}
657 | "proportional-display" ->
658 { c
with fitmodel
= if bool_of_string v
662 | "fit-model" -> { c
with fitmodel
= FMTE.of_string v
}
663 | "pixmap-cache-size" ->
664 { c
with memlimit
= maxv ~
f:int_of_string_with_suffix
2 v
}
665 | "tex-count" -> { c
with texcount
= maxv 1 v
}
666 | "slice-height" -> { c
with sliceheight
= maxv 2 v
}
667 | "thumbnail-width" -> { c
with thumbw
= maxv 2 v
}
668 | "background-color" -> { c
with bgcolor
= color_of_string v
}
669 | "paper-color" -> { c
with papercolor
= rgba_of_string v
}
670 | "scrollbar-color" -> { c
with sbarcolor
= rgba_of_string v
}
671 | "scrollbar-handle-color" -> { c
with sbarhndlcolor
= rgba_of_string v
}
672 | "texture-color" -> { c
with texturecolor
= rgba_of_string v
}
673 | "tile-width" -> { c
with tilew
= maxv 2 v
}
674 | "tile-height" -> { c
with tileh
= maxv 2 v
}
675 | "mupdf-store-size" ->
676 { c
with mustoresize
= maxv ~
f:int_of_string_with_suffix
1024 v
}
677 | "aalevel" -> { c
with aalevel
= maxv 0 v
}
678 | "trim-margins" -> { c
with trimmargins
= bool_of_string v
}
679 | "trim-fuzz" -> { c
with trimfuzz
= irect_of_string v
}
680 | "uri-launcher" -> { c
with urilauncher
= unentS v
}
681 | "path-launcher" -> { c
with pathlauncher
= unentS v
}
682 | "color-space" -> { c
with colorspace
= CSTE.of_string v
}
683 | "invert-colors" -> { c
with invert
= bool_of_string v
}
684 | "brightness" -> { c
with colorscale
= float_of_string v
}
686 let (n, _, _) as nab
= multicolumns_of_string v
in
688 then { c
with columns
= Csplit
(-n, E.a
) }
689 else { c
with columns
= Cmulti
(nab
, E.a
) }
690 | "birds-eye-columns" -> { c
with beyecolumns
= Some
(maxv 2 v
) }
691 | "selection-command" -> { c
with selcmd
= unentS v
}
692 | "paste-command" -> { c
with pastecmd
= unentS v
}
693 | "synctex-command" -> { c
with stcmd
= unentS v
}
694 | "pax-command" -> { c
with paxcmd
= unentS v
}
695 | "askpass-command" -> { c
with passcmd
= unentS v
}
696 | "savepath-command" -> { c
with savecmd
= unentS v
}
697 | "update-cursor" -> { c
with updatecurs
= bool_of_string v
}
698 | "hint-font-size" -> { c
with hfsize
= bound
(int_of_string v
) 5 100 }
699 | "page-scroll-scale" -> { c
with pgscale
= float_of_string v
}
700 | "wheel-scrolls-pages" -> { c
with wheelbypage
= bool_of_string v
}
701 | "horizontal-scrollbar-visible" ->
702 { c
with scrollb
= if bool_of_string v
703 then c
.scrollb
lor scrollbhv
704 else c
.scrollb
land (lnot scrollbhv
)
706 | "vertical-scrollbar-visible" ->
707 { c
with scrollb
= if bool_of_string v
708 then c
.scrollb
lor scrollbvv
709 else c
.scrollb
land (lnot scrollbvv
)
711 | "remote-in-a-new-instance" -> { c
with riani
= bool_of_string v
}
713 { c
with pax
= if bool_of_string v
then Some
0.0 else None
}
714 | "point-and-x-mark" -> { c
with paxmark
= MTE.of_string v
}
715 | "scroll-bar-on-the-left" -> { c
with leftscroll
= bool_of_string v
}
716 | "title" -> { c
with title
= unentS v
}
717 | "last-visit" -> { c
with lastvisit
= float_of_string v
}
718 | "edit-annotations-inline" -> { c
with annotinline
= bool_of_string v
}
719 | "coarse-presentation-positioning" ->
720 { c
with coarseprespos
= bool_of_string v
}
721 | "use-document-css" -> { c
with usedoccss
= bool_of_string v
}
722 | "hint-charset" -> validatehcs v
; { c
with hcs
= v
}
723 | "rlw" -> { c
with rlw
= int_of_string v
}
724 | "rlh" -> { c
with rlh
= int_of_string v
}
725 | "rlem" -> { c
with rlem
= int_of_string v
}
728 dolog
"error processing attribute (`%S' = `%S'): %s" k v
@@ exntos exn
;
731 let rec fold c
= function
734 let c = apply c k v
in
737 fold { c with keyhashes
= copykeyhashes
c } attrs
739 let fromstring f pos
n v
d =
742 dolog
"error processing attribute (%S=%S) at %d\n%s" n v pos
@@ exntos exn
;
745 let bookmark_of attrs
=
746 let rec fold title page rely visy
= function
747 | ("title", v
) :: rest
-> fold v page rely visy rest
748 | ("page", v
) :: rest
-> fold title v rely visy rest
749 | ("rely", v
) :: rest
-> fold title page v visy rest
750 | ("visy", v
) :: rest
-> fold title page rely v rest
751 | _ :: rest
-> fold title page rely visy rest
752 | [] -> title
, page
, rely
, visy
754 fold "invalid" "0" "0" "0" attrs
757 let rec fold path key page rely pan visy
origin dcf
= function
758 | ("path", v
) :: rest
-> fold v key page rely pan visy
origin dcf rest
759 | ("key", v
) :: rest
-> fold path v page rely pan visy
origin dcf rest
760 | ("page", v
) :: rest
-> fold path key v rely pan visy
origin dcf rest
761 | ("rely", v
) :: rest
-> fold path key page v pan visy
origin dcf rest
762 | ("pan", v
) :: rest
-> fold path key page rely v visy
origin dcf rest
763 | ("visy", v
) :: rest
-> fold path key page rely pan v
origin dcf rest
764 | ("origin", v
) :: rest
-> fold path key page rely pan visy v dcf rest
765 | ("dcf", v
) :: rest
-> fold path key page rely pan visy
origin v rest
766 | _ :: rest
-> fold path key page rely pan visy
origin dcf rest
767 | [] -> path, key
, page
, rely
, pan
, visy
, origin, dcf
769 fold E.s E.s "0" "0" "0" "0" E.s E.s attrs
772 let rec fold rs ls
= function
773 | ("out", v
) :: rest
-> fold v ls rest
774 | ("in", v
) :: rest
-> fold rs v rest
775 | _ :: rest
-> fold ls rs rest
780 let findkeyhash c name =
781 try List.assoc
name c.keyhashes
782 with Not_found
-> error
"invalid mode name `%s'" name
786 let h = Hashtbl.create
10 in
787 let dc = { defconf
with angle
= defconf
.angle
} in
788 let rec toplevel v t spos
_ =
790 | Vdata
| Vcdata
| Vend
-> v
791 | Vopen
("llppconfig", _, closed
) ->
794 else { v
with f = llppconfig
}
795 | Vopen
_ -> parse_error
"unexpected subelement at top level" s spos
796 | Vclose
_ -> parse_error
"unexpected close at top level" s spos
798 and llppconfig v t spos
_ =
800 | Vdata
| Vcdata
-> v
801 | Vend
-> parse_error
"unexpected end of input in llppconfig" s spos
802 | Vopen
("defaults", attrs
, closed
) ->
803 let c = config_of dc attrs
in
807 else { v
with f = defaults
}
809 | Vopen
("ui-font", attrs
, closed
) ->
810 let rec getsize size
= function
812 | ("size", v
) :: rest
->
814 fromstring int_of_string spos
"size" v
fstate.fontsize
in
816 | l -> getsize size l
818 fstate.fontsize
<- getsize fstate.fontsize attrs
;
821 else { v
with f = uifont
(Buffer.create
10) }
823 | Vopen
("doc", attrs
, closed
) ->
824 let pathent, key
, spage
, srely
, span
, svisy
, origin, dcf
826 let path = unentS pathent
827 and origin = unentS origin
828 and pageno = fromstring int_of_string spos
"page" spage
0
829 and rely
= fromstring float_of_string spos
"rely" srely
0.0
830 and pan
= fromstring int_of_string spos
"pan" span
0
831 and visy
= fromstring float_of_string spos
"visy" svisy
0.0 in
832 let c = config_of dc attrs
in
835 let anchor = (pageno, rely
, visy
) in
837 then (Hashtbl.add
h path (c, [], pan
, anchor, origin); v
)
838 else { v
with f = doc
path origin pan
anchor c [] }
840 | Vopen
_ -> parse_error
"unexpected subelement in llppconfig" s spos
841 | Vclose
"llppconfig" -> { v
with f = toplevel }
842 | Vclose
_ -> parse_error
"unexpected close in llppconfig" s spos
844 and defaults v t spos
_ =
846 | Vdata
| Vcdata
-> v
847 | Vend
-> parse_error
"unexpected end of input in defaults" s spos
848 | Vopen
("keymap", attrs
, closed
) ->
850 try List.assoc
"mode" attrs
851 with Not_found
-> "global" in
856 let h = findkeyhash dc modename in
857 KeyMap.iter
(Hashtbl.replace
h) keymap
;
860 { v
with f = pkeymap
ret KeyMap.empty
}
862 | Vopen
(_, _, _) -> parse_error
"unexpected subelement in defaults" s spos
864 | Vclose
"defaults" ->
865 { v
with f = llppconfig
}
867 | Vclose
_ -> parse_error
"unexpected close in defaults" s spos
869 and uifont
b v t spos epos
=
872 Buffer.add_substring
b s spos
(epos
- spos
);
874 | Vopen
(_, _, _) -> parse_error
"unexpected subelement in ui-font" s spos
875 | Vclose
"ui-font" ->
876 if emptystr
!S.fontpath
877 then S.fontpath := Buffer.contents
b;
878 { v
with f = llppconfig
}
879 | Vclose
_ -> parse_error
"unexpected close in ui-font" s spos
880 | Vend
-> parse_error
"unexpected end of input in ui-font" s spos
882 and doc
path origin pan
anchor c bookmarks v t spos
_ =
884 | Vdata
| Vcdata
-> v
885 | Vend
-> parse_error
"unexpected end of input in doc" s spos
886 | Vopen
("bookmarks", _, closed
) ->
889 else { v
with f = pbookmarks
path origin pan
anchor c bookmarks }
891 | Vopen
("keymap", attrs
, closed
) ->
893 try List.assoc
"mode" attrs
894 with Not_found
-> "global"
900 let h = findkeyhash c modename in
901 KeyMap.iter
(Hashtbl.replace
h) keymap
;
902 doc
path origin pan
anchor c bookmarks
904 { v
with f = pkeymap
ret KeyMap.empty
}
906 | Vopen
("css", [], false) ->
907 { v
with f = pcss
path origin pan
anchor c bookmarks }
910 parse_error
"unexpected subelement in doc" s spos
913 Hashtbl.add
h path (c, List.rev
bookmarks, pan
, anchor, origin);
914 { v
with f = llppconfig
}
916 | Vclose
_ -> parse_error
"unexpected close in doc" s spos
918 and pcss
path origin pan
anchor c bookmarks v t spos epos
=
921 let b = Buffer.create
10 in
922 Buffer.add_substring
b s spos
(epos
- spos
);
923 { v
with f = pcss
path origin pan
anchor
924 { c with css
= Buffer.contents
b }
926 | Vend
-> parse_error
"unexpected end of input in css" s spos
927 | Vopen
_ -> parse_error
"unexpected subelement in css" s spos
928 | Vclose
"css" -> { v
with f = doc
path origin pan
anchor c bookmarks }
929 | Vclose
_ -> parse_error
"unexpected close in css" s spos
931 and pkeymap
ret keymap v t spos
_ =
933 | Vdata
| Vcdata
-> v
934 | Vend
-> parse_error
"unexpected end of input in keymap" s spos
935 | Vopen
("map", attrs
, closed
) ->
936 let r, l = map_of attrs
in
937 let kss = fromstring keys_of_string spos
"in" r [] in
938 let lss = fromstring keys_of_string spos
"out" l [] in
942 | ks
:: [] -> KeyMap.add ks
(KMinsrl
lss) keymap
943 | ks
:: rest
-> KeyMap.add ks
(KMmulti
(rest
, lss)) keymap
946 then { v
with f = pkeymap
ret keymap }
949 { v
with f = skip
"map" f }
951 | Vopen
_ -> parse_error
"unexpected subelement in keymap" s spos
953 { v
with f = ret keymap }
954 | Vclose
_ -> parse_error
"unexpected close in keymap" s spos
956 and pbookmarks
path origin pan
anchor c bookmarks v t spos
_ =
958 | Vdata
| Vcdata
-> v
959 | Vend
-> parse_error
"unexpected end of input in bookmarks" s spos
960 | Vopen
("item", attrs
, closed
) ->
961 let titleent, spage
, srely
, svisy
= bookmark_of attrs
in
962 let page = fromstring int_of_string spos
"page" spage
0
963 and rely
= fromstring float_of_string spos
"rely" srely
0.0
964 and visy
= fromstring float_of_string spos
"visy" svisy
0.0 in
966 (unentS titleent, 0, Oanchor
(page, rely
, visy
)) :: bookmarks
969 then { v
with f = pbookmarks
path origin pan
anchor c bookmarks }
972 { v
with f = skip
"item" f }
974 | Vopen
_ -> parse_error
"unexpected subelement in bookmarks" s spos
975 | Vclose
"bookmarks" ->
976 { v
with f = doc
path origin pan
anchor c bookmarks }
977 | Vclose
_ -> parse_error
"unexpected close in bookmarks" s spos
979 and skip tag
f v t spos
_ =
981 | Vdata
| Vcdata
-> v
982 | Vend
-> parse_error
("unexpected end of input in skipped " ^ tag
) s spos
983 | Vopen
(tag'
, _, closed
) ->
987 let f'
() = { v
with f = skip tag
f } in
988 { v
with f = skip tag'
f'
}
992 else parse_error
("unexpected close in skipped " ^ tag
) s spos
994 parse
{ f = toplevel; accu
= () } s;
997 let do_load f contents
=
1000 | Parser.Parse_error
(msg
, s, pos
) ->
1001 let subs = Parser.subs s pos
in
1002 Utils.error
"parse error: %s: at %d [..%S..]" msg pos
subs
1004 | exn
-> Utils.error
"parse error: %s" @@ exntos exn
1006 let load2 f default
=
1007 match filecontents
!S.confpath with
1008 | contents
-> f @@ do_load get contents
1009 | exception Unix.Unix_error
(Unix.ENOENT
, "open", _) ->
1010 f (Hashtbl.create
0, defconf
)
1012 dolog
"error loading configuration from `%S': %s"
1013 !S.confpath @@ exntos exn
;
1016 let load1 f = load2 f false
1024 (fun path (conf, _, _, _, _) ((_, besttime
) as best
) ->
1025 if conf.lastvisit
> besttime
1026 then (path, conf.lastvisit
)
1029 (!S.path, -.infinity
)
1033 let pc, pb
, px
, pa
, po
=
1034 let def = dc, [], 0, E.j
, !S.origin in
1038 let absname = abspath
!S.path in
1039 match Hashtbl.find h absname with
1040 | (c,b,x,a
,_) -> (c,b,x,a
,!S.origin)
1041 | exception Not_found
->
1042 let exception E
of (conf * outline list
* int * anchor * string) in
1043 let key = try Digest.file
absname |> Digest.to_hex
with _ -> E.s in
1047 Hashtbl.iter
(fun p
((c, _, _, _, _) as v
) ->
1050 dolog
"will use %s's settings due to matching keys" p
;
1057 | exception E v
-> v
1071 Hashtbl.fold (fun path (pc, pb
, px
, pa
, po
) accu
->
1072 (path, pc, pb
, px
, pa
, po
) :: accu
)
1077 let add_attrs bb always
dc c time
=
1079 Buffer.add_string bb
"\n ";
1080 Printf.bprintf bb fmt
s
1082 let o c fmt
s = if c then o' fmt
s else ignore
in
1083 let ob s a
b = o (always
|| a
!= b) "%s='%b'" s a
1084 and op
s a
b = o (always
|| a
<> b) "%s='%b'" s (a
!= None
)
1085 and oi
s a
b = o (always
|| a
!= b) "%s='%d'" s a
1086 and oI
s a
b = o (always
|| a
!= b) "%s='%s'" s (string_with_suffix_of_int a
)
1087 and oz
s a
b = o (always
|| a
<> b) "%s='%g'" s (a
*.100.)
1088 and oF
s a
b = o (always
|| a
<> b) "%s='%f'" s a
1089 and oL
s a
b = o (always
|| a
<> b) "%s='%Ld'" s a
1090 and oc
s a
b = o (always
|| a
<> b) "%s='%s'" s (color_to_string a
)
1091 and oA
s a
b = o (always
|| a
<> b) "%s='%s'" s (rgba_to_string a
)
1092 and oC
s a
b = o (always
|| a
<> b) "%s='%s'" s (CSTE.to_string a
)
1093 and oR
s a
b = o (always
|| a
<> b) "%s='%s'" s (irect_to_string a
)
1094 and oFm
s a
b = o (always
|| a
<> b) "%s='%s'" s (FMTE.to_string a
)
1096 o (always
|| a
land m
<> b land m
) "%s='%b'" s (a
land m
!= 0)
1097 and oPm
s a
b = o (always
|| a
<> b) "%s='%s'" s (MTE.to_string a
)
1099 o (always
|| a
<> b) "%s='%s'" s @@ Parser.enent a
0 (String.length a
)
1104 | Cmulti
((n, a
, b), _) when n > 1 -> o'
"%s='%d,%d,%d'" s n a
b
1105 | Csplit
(n, _) when n > 1 -> o'
"%s='%d'" s ~
-n
1106 | Cmulti
_ | Csplit
_ | Csingle
_ -> ()
1111 | Some
c when c > 1 -> o'
"%s='%d'" s c
1114 oi
"width" c.cwinw
dc.cwinw
;
1115 oi
"height" c.cwinh
dc.cwinh
;
1116 oi
"scroll-bar-width" c.scrollbw
dc.scrollbw
;
1117 oi
"scroll-handle-height" c.scrollh
dc.scrollh
;
1118 oSv
"horizontal-scrollbar-visible" c.scrollb
dc.scrollb scrollbhv
;
1119 oSv
"vertical-scrollbar-visible" c.scrollb
dc.scrollb scrollbvv
;
1120 ob "case-insensitive-search" c.icase
dc.icase
;
1121 ob "preload" c.preload
dc.preload
;
1122 oi
"page-bias" c.pagebias
dc.pagebias
;
1123 oi
"scroll-step" c.scrollstep
dc.scrollstep
;
1124 oi
"auto-scroll-step" c.autoscrollstep
dc.autoscrollstep
;
1125 ob "max-height-fit" c.maxhfit
dc.maxhfit
;
1126 ob "highlight-links" c.hlinks
dc.hlinks
;
1127 ob "under-cursor-info" c.underinfo
dc.underinfo
;
1128 oi
"vertical-margin" c.interpagespace
dc.interpagespace
;
1129 oz
"zoom" c.zoom dc.zoom;
1130 ob "presentation" c.presentation
dc.presentation
;
1131 oi
"rotation-angle" c.angle
dc.angle
;
1132 oFm
"fit-model" c.fitmodel
dc.fitmodel
;
1133 oI
"pixmap-cache-size" c.memlimit
dc.memlimit
;
1134 oi
"tex-count" c.texcount
dc.texcount
;
1135 oi
"slice-height" c.sliceheight
dc.sliceheight
;
1136 oi
"thumbnail-width" c.thumbw
dc.thumbw
;
1137 oc
"background-color" c.bgcolor
dc.bgcolor
;
1138 oA
"paper-color" c.papercolor
dc.papercolor
;
1139 oA
"scrollbar-color" c.sbarcolor
dc.sbarcolor
;
1140 oA
"scrollbar-handle-color" c.sbarhndlcolor
dc.sbarhndlcolor
;
1141 oA
"texture-color" c.texturecolor
dc.texturecolor
;
1142 oi
"tile-width" c.tilew
dc.tilew
;
1143 oi
"tile-height" c.tileh
dc.tileh
;
1144 oI
"mupdf-store-size" c.mustoresize
dc.mustoresize
;
1145 oi
"aalevel" c.aalevel
dc.aalevel
;
1146 ob "trim-margins" c.trimmargins
dc.trimmargins
;
1147 oR
"trim-fuzz" c.trimfuzz
dc.trimfuzz
;
1148 os
"uri-launcher" c.urilauncher
dc.urilauncher
;
1149 os
"path-launcher" c.pathlauncher
dc.pathlauncher
;
1150 oC
"color-space" c.colorspace
dc.colorspace
;
1151 ob "invert-colors" c.invert
dc.invert
;
1152 oF
"brightness" c.colorscale
dc.colorscale
;
1153 oco
"columns" c.columns
dc.columns
;
1154 obeco
"birds-eye-columns" c.beyecolumns
dc.beyecolumns
;
1155 os
"selection-command" c.selcmd
dc.selcmd
;
1156 os
"paste-command" c.pastecmd
dc.pastecmd
;
1157 os
"synctex-command" c.stcmd
dc.stcmd
;
1158 os
"pax-command" c.paxcmd
dc.paxcmd
;
1159 os
"askpass-command" c.passcmd
dc.passcmd
;
1160 os
"savepath-command" c.savecmd
dc.savecmd
;
1161 ob "update-cursor" c.updatecurs
dc.updatecurs
;
1162 oi
"hint-font-size" c.hfsize
dc.hfsize
;
1163 oi
"horizontal-scroll-step" c.hscrollstep
dc.hscrollstep
;
1164 oF
"page-scroll-scale" c.pgscale
dc.pgscale
;
1165 ob "wheel-scrolls-pages" c.wheelbypage
dc.wheelbypage
;
1166 ob "remote-in-a-new-instance" c.riani
dc.riani
;
1167 op
"point-and-x" c.pax
dc.pax
;
1168 oPm
"point-and-x-mark" c.paxmark
dc.paxmark
;
1169 ob "scroll-bar-on-the-left" c.leftscroll
dc.leftscroll
;
1171 then os
"title" c.title
dc.title
;
1172 oL
"last-visit" (Int64.of_float time
) 0L;
1173 ob "edit-annotations-inline" c.annotinline
dc.annotinline
;
1174 ob "coarse-presentation-positioning" c.coarseprespos
dc.coarseprespos
;
1175 ob "use-document-css" c.usedoccss
dc.usedoccss
;
1176 os
"dcf" c.dcf
dc.dcf
;
1177 os
"hint-charset" c.hcs
dc.hcs
;
1178 oi
"rlw" c.rlw
dc.rlw
;
1179 oi
"rlh" c.rlh
dc.rlh
;
1180 oi
"rlem" c.rlem
dc.rlem
1182 let keymapsbuf always
dc c =
1184 let bb = create
16 in
1185 let rec loop = function
1187 | (modename, h) :: rest
->
1188 let dh = findkeyhash dc modename in
1189 if always
|| h <> dh
1191 if Hashtbl.length
h > 0
1193 if length
bb > 0 then add_char
bb '
\n'
;
1194 Printf.bprintf
bb "<keymap mode='%s'>\n" modename;
1195 Hashtbl.iter
(fun i
o ->
1196 if always
|| match Hashtbl.find dh i
1197 with | dO
-> dO
<> o | exception Not_found
-> false
1200 if Wsi.withctrl m
then add_string
bb "ctrl-";
1201 if Wsi.withalt m
then add_string
bb "alt-";
1202 if Wsi.withshift m
then add_string
bb "shift-";
1203 if Wsi.withmeta m
then add_string
bb "meta-";
1204 add_string
bb (Wsi.keyname
k);
1207 let rec loop = function
1209 | km
:: [] -> addkm km
1210 | km
:: rest
-> addkm km
; add_char
bb ' '
; loop rest
1214 add_string
bb "<map in='";
1218 add_string
bb "' out='"; addkm km
; add_string
bb "'/>\n"
1221 add_string
bb "' out='"; addkms kms
; add_string
bb "'/>\n"
1223 | KMmulti
(ins
, kms
) ->
1224 add_char
bb ' '
; addkms ins
; add_string
bb "' out='";
1225 addkms kms
; add_string
bb "'/>\n"
1227 add_string
bb "</keymap>";
1235 let keystostrlist c =
1236 let rec loop accu
= function
1238 | (modename, h) :: rest
->
1240 if Hashtbl.length
h > 0
1242 let accu = Printf.sprintf
"\xc2\xb7Keys for %s" modename :: accu in
1243 Hashtbl.fold (fun i
o a
->
1244 let bb = Buffer.create
10 in
1246 if Wsi.withctrl m
then Buffer.add_string
bb "ctrl-";
1247 if Wsi.withalt m
then Buffer.add_string
bb "alt-";
1248 if Wsi.withshift m
then Buffer.add_string
bb "shift-";
1249 if Wsi.withmeta m
then Buffer.add_string
bb "meta-";
1250 Buffer.add_string
bb (Wsi.keyname
k);
1253 let rec loop = function
1255 | km
:: [] -> addkm km
1257 addkm km
; Buffer.add_char
bb ' '
;
1263 Buffer.add_char
bb '
\t'
;
1265 | KMinsrt km
-> addkm km
1266 | KMinsrl kms
-> addkms kms
1267 | KMmulti
(ins
, kms
) ->
1268 Buffer.add_char
bb ' '
;
1270 Buffer.add_string
bb "\t";
1273 Buffer.contents
bb :: a
1282 let save1 bb leavebirdseye
x h dc =
1283 let uifontsize = fstate.fontsize
in
1284 Buffer.add_string
bb "<llppconfig>\n";
1285 if nonemptystr
!S.fontpath
1287 Printf.bprintf
bb "<ui-font size='%d'><![CDATA[%s]]></ui-font>\n"
1288 uifontsize !S.fontpath
1292 then Printf.bprintf
bb "<ui-font size='%d'/>\n" uifontsize
1295 Buffer.add_string
bb "<defaults";
1296 add_attrs bb true dc dc nan
;
1297 let kb = keymapsbuf true dc dc in
1298 if Buffer.length
kb > 0
1300 Buffer.add_string
bb ">\n";
1301 Buffer.add_buffer
bb kb;
1302 Buffer.add_string
bb "\n</defaults>\n";
1304 else Buffer.add_string
bb "/>\n";
1306 let adddoc path pan
anchor c bookmarks time
origin =
1307 if not
(bookmarks == [] && c = dc && anchor = E.j
)
1309 Printf.bprintf
bb "<doc path='%s'"
1310 (Parser.enent
path 0 (String.length
path));
1312 if nonemptystr
c.key
1314 Printf.bprintf
bb "\n key='%s'" c.key;
1317 if nonemptystr
origin
1319 Printf.bprintf
bb "\n origin='%s'"
1320 (Parser.enent
origin 0 (String.length
origin));
1325 let n, rely
, visy
= anchor in
1326 Printf.bprintf
bb "\n page='%d'" n;
1329 then Printf.bprintf
bb " rely='%f'" rely
;
1331 if abs_float visy
> 1e-6
1332 then Printf.bprintf
bb " visy='%f'" visy
;
1336 then Printf.bprintf
bb " pan='%d'" pan
;
1338 add_attrs bb false dc c time
;
1339 if nonemptystr
c.css
1340 then Printf.bprintf
bb ">\n <css><![CDATA[%s]]></css>" c.css
;
1341 let kb = keymapsbuf false dc c in
1343 begin match bookmarks with
1345 if Buffer.length
kb > 0
1347 Buffer.add_string
bb ">\n";
1348 Buffer.add_buffer
bb kb;
1349 Buffer.add_string
bb "\n</doc>\n";
1352 if nonemptystr
c.css
1353 then Buffer.add_string
bb "\n</doc>\n"
1354 else Buffer.add_string
bb "/>\n"
1357 Buffer.add_string
bb ">\n<bookmarks>\n";
1358 List.iter
(fun (title
, _, kind
) ->
1359 begin match kind
with
1360 | Oanchor
(page, rely
, visy
) ->
1362 "<item title='%s' page='%d'"
1363 (Parser.enent title
0 (String.length title
))
1366 then Printf.bprintf
bb " rely='%f'" rely
;
1367 if abs_float visy
> 1e-6
1368 then Printf.bprintf
bb " visy='%f'" visy
;
1370 | Ohistory
_ | Onone
| Ouri
_ | Oremote
_
1371 | Oremotedest
_ | Olaunch
_ -> error
"unexpected link in bookmarks"
1373 Buffer.add_string
bb "/>\n";
1375 Buffer.add_string
bb "</bookmarks>";
1376 if Buffer.length
kb > 0
1378 Buffer.add_string
bb "\n";
1379 Buffer.add_buffer
bb kb;
1381 Buffer.add_string
bb "\n</doc>\n"
1388 | Birdseye
(c, pan, _, _, _) ->
1390 match conf.columns
with
1391 | Cmulti
((c, _, _), _) -> Some
c
1395 match c.columns
with
1396 | Cmulti
(c, _) -> Cmulti
(c, E.a
)
1397 | Csingle
_ -> Csingle
E.a
1398 | Csplit
_ -> failwith
"quit from bird's eye while split"
1400 pan, { c with beyecolumns = beyecolumns; columns
= columns
}
1403 | LinkNav
_ -> x, conf
1405 let docpath = if nonemptystr
!S.path then abspath
!S.path else E.s in
1406 if nonemptystr
docpath
1408 adddoc docpath pan (getanchor ())
1410 begin match !S.mode with
1411 | Birdseye beye
-> leavebirdseye beye
true
1417 autoscrollstep
= (match !S.autoscroll with
1419 | None
-> conf.autoscrollstep
)
1420 ; key = (if emptystr
conf.key
1421 then (try Digest.file
docpath |> Digest.to_hex
with _ -> E.s)
1429 Hashtbl.iter
(fun path (c, bookmarks, x, anchor, origin) ->
1430 if docpath <> abspath
path
1431 then adddoc path x anchor c bookmarks c.lastvisit
origin
1433 Buffer.add_string
bb "</llppconfig>\n";
1436 let save leavebirdseye
=
1437 let relx = float !S.x /. float !S.winw in
1439 let cx w = truncate
(relx *. float w) in
1441 (fun (w, h, x) ws
->
1443 | Wsi.Fullscreen
-> (conf.cwinw
, conf.cwinh
, cx conf.cwinw
)
1444 | Wsi.MaxVert
-> (w, conf.cwinh
, x)
1445 | Wsi.MaxHorz
-> (conf.cwinw
, h, cx conf.cwinw
)
1447 (!S.winw, !S.winh, !S.x) !S.winstate
1451 let bb = Buffer.create
32768 in
1452 let save2 (h, dc) = save1 bb leavebirdseye
x h dc in
1453 if load1 save2 && Buffer.length
bb > 0
1456 let tmp = !S.confpath ^
".tmp" in
1457 let oc = open_out_bin
tmp in
1458 Buffer.output_buffer
oc bb;
1460 Unix.rename
tmp !S.confpath;
1461 with exn
-> dolog
"error saving configuration: %s" @@ exntos exn
1464 let href = ref @@ Hashtbl.create
0 in
1465 let cref = ref defconf
in
1468 if Sys.file_exists
path then Some v
else (dolog1
"-%S" path; None
)
1470 Hashtbl.filter_map_inplace
f h;
1475 ignore
(load1 push);
1476 let bb = Buffer.create
32768 in
1477 let save2 (_h
, dc) = save1 bb (fun _ _ -> ()) 0 !href dc in
1478 if load1 save2 && Buffer.length
bb > 0
1481 let tmp = !S.confpath ^
".tmp" in
1482 let oc = open_out_bin
tmp in
1483 Buffer.output_buffer
oc bb;
1485 Unix.rename
tmp !S.confpath;
1486 with exn
-> dolog
"error saving configuration: %s" @@ exntos exn
1489 let logcurrently = function
1490 | Idle
-> dolog
"Idle"
1491 | Loading
(l, gen) -> dolog
"Loading %d gen=%d curgen=%d" l.pageno gen !S.gen
1492 | Tiling
(l, pageopaque
, colorspace
, angle
, gen, col
, row
, tilew
, tileh
) ->
1493 dolog
"Tiling %d[%d,%d] page=%s cs=%s angle=%d"
1494 l.pageno col row
(Opaque.to_string pageopaque
)
1495 (CSTE.to_string colorspace
) angle
;
1496 dolog
"gen=(%d,%d) (%d,%d) tile=(%d,%d) (%d,%d)"
1497 angle
gen conf.angle
!S.gen
1499 conf.tilew
conf.tileh
1500 | Outlining
_ -> dolog
"outlining"