4 { mutable fontsize
: int
5 ; mutable wwidth
: float
6 ; mutable maxrows
: int
11 { fontsize
= 20 * Wsi.fontsizefactor
()
17 let irect_of_string s
=
18 Scanf.sscanf s
"%d/%d/%d/%d" (fun x0 y0 x1 y1
-> (x0
,y0
,x1
,y1
))
21 let irect_to_string (x0
,y0
,x1
,y1
) = Printf.sprintf
"%d/%d/%d/%d" x0 y0 x1 y1
;;
23 let multicolumns_to_string (n
, a
, b
) =
25 then Printf.sprintf
"%d" n
26 else Printf.sprintf
"%d,%d,%d" n a b
;
29 let multicolumns_of_string s
=
31 (int_of_string s
, 0, 0)
33 Scanf.sscanf s
"%u,%u,%u" (fun n a b
->
35 then error
"subtly broken";
51 and trimmargins
= bool
52 and trimparams
= (trimmargins
* irect
)
58 and tileparams
= (x
* y
* width
* height
* tilex
* tiley
)
63 | Uannotation
of (opaque
* slinkindex
)
66 and launchcommand
= string
76 | LDfirstvisible
of (int * int * int)
85 and anchor
= pageno
* top
* dtop
86 and rect
= float * float * float * float * float * float * float * float
87 and infochange
= | Memused
| Docinfo
| Pdim
93 method key
: int -> int -> uioh
94 method button
: int -> bool -> int -> int -> int -> uioh
95 method multiclick
: int -> int -> int -> int -> uioh
96 method motion
: int -> int -> uioh
97 method pmotion
: int -> int -> uioh
98 method infochanged
: infochange
-> unit
99 method scrollpw
: (int * float * float)
100 method scrollph
: (int * float * float)
101 method modehash
: keyhash
102 method eformsgs
: bool
103 method alwaysscrolly
: bool
104 method scroll
: int -> int -> uioh
105 method zoom
: float -> int -> int -> unit
108 module type TextEnumType
=
112 val names
: string array
115 module TextEnumMake
(Ten
: TextEnumType
) =
117 let names = Ten.names;;
118 let to_int (t
: Ten.t
) = Obj.magic t
;;
119 let to_string t
= names.(to_int t
);;
120 let of_int n
: Ten.t
= Obj.magic n
;;
123 if i
= Array.length
names
124 then error
"invalid %s: %s" Ten.name s
133 module CSTE
= TextEnumMake
(
135 type t
= colorspace
;;
136 let name = "colorspace";;
137 let names = [|"rgb"; "gray"|];;
140 module MTE
= TextEnumMake
(
144 let names = [|"page"; "block"; "line"; "word"|];;
147 module FMTE
= TextEnumMake
(
150 let name = "fitmodel";;
151 let names = [|"width"; "proportional"; "page"|];;
158 | Olaunch
of launchcommand
159 | Oremote
of (filename
* pageno
)
160 | Oremotedest
of (filename
* destname
)
161 | Ohistory
of (filename
* conf
* outline list
* x
* anchor
* filename
)
162 and outline
= (caption
* outlinelevel
* outlinekind
)
163 and outlinelevel
= int
181 type tile
= opaque
* pixmapsize
* elapsed
182 and elapsed
= float;;
183 type pagemapkey
= pageno
* gen
;;
184 type tilemapkey
= pageno
* gen
* colorspace
* angle
* width
* height
* col
* row
189 | Loading
of (page
* gen
)
191 of (page
* opaque
* colorspace
* angle
* gen
* col
* row
* width
* height
)
192 | Outlining
of outline list
195 type mpos
= int * int
197 | Msel
of (mpos
* mpos
)
199 | Mscrolly
| Mscrollx
200 | Mzoom
of (buttonno
* step
* mpos
)
201 | Mzoomrect
of (mpos
* mpos
)
208 | Birdseye
of (conf
* leftx
* pageno
* pageno
* anchor
)
209 | Textentry
of (textentry
* onleave
)
211 | LinkNav
of linktarget
212 and onleave
= leavetextentrystatus
-> unit
213 and leavetextentrystatus
= | Cancel
| Confirm
214 and helpitem
= string * int * action
217 | Action
of (uioh
-> uioh
)
219 | Ltexact
of (pageno
* direction
)
220 | Ltgendir
of direction
221 | Ltnotready
of (pageno
* direction
)
222 and direction
= int (* -1, 0, 1 *)
223 and textentry
= string * string * onhist
option * onkey
* ondone
* cancelonempty
224 and onkey
= string -> Keys.t
-> te
225 and ondone
= string -> unit
226 and histcancel
= unit -> unit
227 and onhist
= ((histcmd
-> string) * histcancel
)
228 and histcmd
= HCnext
| HCprev
| HCfirst
| HClast
229 and cancelonempty
= bool
234 | TEswitch
of textentry
252 { mutable ss
: Unix.file_descr
253 ; mutable wsfd
: Unix.file_descr
254 ; mutable stderr
: Unix.file_descr
255 ; mutable errmsgs
: Buffer.t
256 ; mutable newerrmsgs
: bool
260 ; mutable anchor
: anchor
261 ; mutable ranchors
: (string * string * anchor
* string) list
263 ; mutable layout
: page list
264 ; pagemap
: (pagemapkey
, opaque
) Hashtbl.t
265 ; tilemap
: (tilemapkey
, tile
) Hashtbl.t
266 ; tilelru
: (tilemapkey
* opaque
* pixmapsize
) Queue.t
267 ; mutable pdims
: (pageno
* width
* height
* leftx
) list
268 ; mutable pagecount
: int
269 ; mutable currently
: currently
270 ; mutable mstate
: mstate
271 ; mutable searchpattern
: string
272 ; mutable rects
: (pageno
* rectcolor
* rect
) list
273 ; mutable rects1
: (pageno
* rectcolor
* rect
) list
274 ; prects
: (pageno
, float array
) Hashtbl.t
275 ; mutable text
: string
276 ; mutable winstate
: Wsi.winstate list
277 ; mutable mode
: mode
278 ; mutable uioh
: uioh
279 ; mutable outlines
: outline array
280 ; mutable bookmarks
: outline list
281 ; mutable path
: string
282 ; mutable password
: string
283 ; mutable nameddest
: string
284 ; mutable geomcmds
: (string * ((string * (unit -> unit)) list
))
285 ; mutable memused
: memsize
287 ; mutable autoscroll
: int option
288 ; mutable help
: helpitem array
289 ; mutable docinfo
: (int * string) list
291 ; mutable prevzoom
: (float * int)
292 ; mutable progress
: float
293 ; mutable mpos
: mpos
294 ; mutable keystate
: keystate
295 ; mutable glinks
: bool
296 ; mutable prevcolumns
: (columns
* float) option
299 ; mutable reprf
: (unit -> unit)
300 ; mutable origin
: string
301 ; mutable roam
: (unit -> unit)
302 ; mutable bzoom
: bool
303 ; mutable lnava
: (pageno
* linkno
) option
304 ; mutable slideshow
: int
305 ; mutable reload
: (x
* y
* float) option
306 ; mutable nav
: anchor nav
309 { pat
: string circbuf
310 ; pag
: string circbuf
311 ; sel
: string circbuf
315 let emptyanchor = (0, 0.0, 0.0);;
316 let emptykeyhash = Hashtbl.create
0;;
317 let noreprf () = ();;
323 method key _ _
= self
324 method multiclick _ _ _ _
= self
325 method button _ _ _ _ _
= self
326 method motion _ _
= self
327 method pmotion _ _
= self
328 method infochanged _
= ()
329 method scrollpw
= (0, nan
, nan
)
330 method scrollph
= (0, nan
, nan
)
331 method modehash
= emptykeyhash
332 method eformsgs
= false
333 method alwaysscrolly
= false
334 method scroll _ _
= self
335 method zoom _ _ _
= ()
338 let platform_to_string = function
339 | Punknown
-> "unknown"
345 let conf = { defconf
with keyhashes
= copykeyhashes defconf
};;
348 { store
= Array.make n v
355 let cbcap b
= Array.length b
.store
;;
357 let cbput ?
(update_rc
=true) b v
=
360 b
.wc
<- (b
.wc
+ 1) mod cap;
363 b
.len
<- min
(b
.len
+ 1) cap;
366 let cbput_dont_update_rc b v
= cbput ~update_rc
:false b v
;;
368 let cbempty b
= b
.len
= 0;;
370 let cbgetg b circular dir
=
374 let rc = b
.rc + dir
in
386 else bound
rc 0 (b
.len
-1)
392 let cbget b
= cbgetg b
false;;
393 let cbgetc b
= cbgetg b
true;;
398 ; stderr
= Unix.stderr
399 ; errmsgs
= Buffer.create
0
404 ; anchor
= emptyanchor
408 ; tilelru
= Queue.create
()
409 ; pagemap
= Hashtbl.create
10
410 ; tilemap
= Hashtbl.create
10
417 ; prects
= Hashtbl.create
1
421 ; searchpattern
= E.s
429 { pat
= cbnew 10 E.s
; pag
= cbnew 10 E.s
; sel
= cbnew 10 E.s
; }
435 ; prevzoom
= (1.0, 0)
451 ; nav
= { past
= []; future
= []; }
456 let d = state.winh
- h
in
457 max
conf.interpagespace
((d + 1) / 2)
460 let rowyh (c
, coverA
, coverB
) b n
=
461 if c
= 1 || (n
< coverA
|| n
>= state.pagecount
- coverB
)
463 let _, _, vy
, (_, _, h
, _) = b
.(n
) in
466 let n'
= n - coverA
in
469 let e = min
state.pagecount
(s + c
) in
470 let rec find m miny maxh
= if m
= e then miny
, maxh
else
471 let _, _, y
, (_, _, h
, _) = b
.(m
) in
472 let miny = min
miny y
in
473 let maxh = max
maxh h
in
479 let ((c
, coverA
, coverB
) as cl
), b
=
480 match conf.columns
with
481 | Csplit
(_, b
) | Csingle b
-> (1, 0, 0), b
482 | Cmulti
(c
, b
) -> c
, b
484 if Array.length b
= 0
487 let rec bsearch nmin nmax
=
489 then bound nmin
0 (state.pagecount
-1)
491 let n = (nmax
+ nmin
) / 2 in
492 let vy, h
= rowyh cl b
n in
496 let ips = calcips h
in
498 let y1 = vy + h
+ ips in
502 then 0, vy + h
+ conf.interpagespace
504 let y0 = vy - conf.interpagespace
in
505 y0, y0 + h
+ conf.interpagespace
515 if n < state.pagecount
- coverB
516 then ((n-coverA
)/c
)*c
+ coverA
523 then bsearch (n+1) nmax
524 else bsearch nmin
(n-1)
527 bsearch 0 (state.pagecount
-1);
531 match conf.columns
with
532 | Cmulti
((_, _, _) as cl
, b
) ->
533 if Array.length b
> 0
535 let y, h
= rowyh cl b
(Array.length b
- 1) in
536 y + h
+ (if conf.presentation
then calcips h
else 0)
539 if Array.length b
> 0
541 let (_, _, y, (_, _, h
, _)) = b
.(Array.length b
- 1) in
542 y + h
+ (if conf.presentation
then calcips h
else 0)
545 if Array.length b
> 0
547 let (_, _, y, (_, _, h
, _)) = b
.(Array.length b
- 1) in
552 let getpageywh pageno
=
553 let pageno = bound
pageno 0 (state.pagecount
-1) in
554 match conf.columns
with
556 if Array.length b
= 0
559 let (_, _, y, (_, w
, h
, _)) = b
.(pageno) in
567 if Array.length b
= 0
570 let y, h
= rowyh cl b
pageno in
571 let (_, _, _, (_, w
, _, _)) = b
.(pageno) in
579 if Array.length b
= 0
583 let (_, _, y, (_, w
, h
, _)) = b
.(n) in
587 let getpageyh pageno =
588 let y,_,h
= getpageywh pageno in
592 let getpagedim pageno =
595 | (n, _, _, _) as pdim
:: rest
->
597 then (if n = pageno then pdim
else ppdim
)
601 f (-1, -1, -1, -1) state.pdims
604 let getpdimno pageno =
608 | (n, _, _, _) :: rest
->
610 then (if n = pageno then np else p
)
617 let getpagey pageno = fst
(getpageyh pageno);;
621 let coloff = l
.pagecol
* l
.pageh
in
622 float (l
.pagey
+ coloff) /. float l
.pageh
629 then float l
.pagedispy
/. float (calcips l
.pageh
)
630 else float l
.pagedispy
/. float conf.interpagespace
633 (l
.pageno, top, dtop)
637 match state.layout
with
638 | l
:: _ -> getanchor1 l
640 let n = page_of_y state.y in
644 let y, h
= getpageyh n in
645 let dy = y - state.y in
649 let ips = calcips h
in
650 float (dy + ips) /. float ips
651 else float dy /. float conf.interpagespace
656 let fontpath = ref E.s;;
657 let bedefault = ref false;;
659 type historder
= [ `lastvisit
| `title
| `path
| `file
];;
662 Map.Make
(struct type t
= (int * int) let compare = compare end);;
665 let l = String.length
s in
666 let b = Buffer.create
l in
667 Parser.unent
b s 0 l;
672 try Sys.getenv
"HOME"
674 dolog
"cannot determine home directory location: %s" @@ exntos exn
;
678 let modifier_of_string = function
679 | "alt" -> Wsi.altmask
680 | "shift" -> Wsi.shiftmask
681 | "ctrl" | "control" -> Wsi.ctrlmask
682 | "meta" -> Wsi.metamask
686 let keys_of_string s =
687 let key_of_string r
s =
688 let elems = Str.full_split r
s in
691 let m1 = modifier_of_string s in
693 then (Wsi.namekey
s, m
)
696 | Str.Delim
s when n land 1 = 0 -> g s
698 | Str.Delim
_ -> (k
, m
)
700 let rec loop n k m
= function
703 let k, m
= f n k m x
in
708 let elems = Str.split
Utils.Re.whitespace
s in
709 List.map
(key_of_string (Str.regexp
"-")) elems
712 let config_of c attrs
=
713 let maxv ?
(f=int_of_string
) u
s = max u
@@ f s in
717 | "scroll-bar-width" -> { c
with scrollbw
= maxv 0 v
}
718 | "scroll-handle-height" -> { c
with scrollh
= maxv 0 v
}
719 | "case-insensitive-search" -> { c
with icase
= bool_of_string v
}
720 | "preload" -> { c
with preload
= bool_of_string v
}
721 | "page-bias" -> { c
with pagebias
= int_of_string v
}
722 | "scroll-step" -> { c
with scrollstep
= maxv 1 v
}
723 | "horizontal-scroll-step" -> { c
with hscrollstep
= maxv 1 v
}
724 | "auto-scroll-step" -> { c
with autoscrollstep
= maxv 0 v
}
725 | "max-height-fit" -> { c
with maxhfit
= bool_of_string v
}
726 | "highlight-links" -> { c
with hlinks
= bool_of_string v
}
727 | "under-cursor-info" -> { c
with underinfo
= bool_of_string v
}
728 | "vertical-margin" -> { c
with interpagespace
= maxv 0 v
}
730 let zoom = float_of_string v
/. 100. in
731 let zoom = max
zoom 0.0 in
732 { c
with zoom = zoom }
733 | "presentation" -> { c
with presentation
= bool_of_string v
}
734 | "rotation-angle" -> { c
with angle
= int_of_string v
}
735 | "width" -> { c
with cwinw
= maxv 20 v
}
736 | "height" -> { c
with cwinh
= maxv 20 v
}
737 | "proportional-display" ->
743 { c
with fitmodel
= fm }
744 | "fit-model" -> { c
with fitmodel
= FMTE.of_string v
}
745 | "pixmap-cache-size" ->
746 { c
with memlimit
= maxv ~
f:int_of_string_with_suffix
2 v
}
747 | "tex-count" -> { c
with texcount
= maxv 1 v
}
748 | "slice-height" -> { c
with sliceheight
= maxv 2 v
}
749 | "thumbnail-width" -> { c
with thumbw
= maxv 2 v
}
750 | "background-color" -> { c
with bgcolor
= color_of_string v
}
751 | "paper-color" -> { c
with papercolor
= rgba_of_string v
}
752 | "scrollbar-color" -> { c
with sbarcolor
= rgba_of_string v
}
753 | "scrollbar-handle-color" -> { c
with sbarhndlcolor
= rgba_of_string v
}
754 | "texture-color" -> { c
with texturecolor
= rgba_of_string v
}
755 | "tile-width" -> { c
with tilew
= maxv 2 v
}
756 | "tile-height" -> { c
with tileh
= maxv 2 v
}
757 | "mupdf-store-size" ->
758 { c
with mustoresize
= maxv ~
f:int_of_string_with_suffix
1024 v
}
759 | "checkers" -> { c
with checkers
= bool_of_string v
}
760 | "aalevel" -> { c
with aalevel
= maxv 0 v
}
761 | "trim-margins" -> { c
with trimmargins
= bool_of_string v
}
762 | "trim-fuzz" -> { c
with trimfuzz
= irect_of_string v
}
763 | "uri-launcher" -> { c
with urilauncher
= unentS v
}
764 | "path-launcher" -> { c
with pathlauncher
= unentS v
}
765 | "color-space" -> { c
with colorspace
= CSTE.of_string v
}
766 | "invert-colors" -> { c
with invert
= bool_of_string v
}
767 | "brightness" -> { c
with colorscale
= float_of_string v
}
769 let (n, _, _) as nab
= multicolumns_of_string v
in
771 then { c
with columns
= Csplit
(-n, E.a
) }
772 else { c
with columns
= Cmulti
(nab
, E.a
) }
773 | "birds-eye-columns" -> { c
with beyecolumns
= Some
(maxv 2 v
) }
774 | "selection-command" -> { c
with selcmd
= unentS v
}
775 | "paste-command" -> { c
with pastecmd
= unentS v
}
776 | "synctex-command" -> { c
with stcmd
= unentS v
}
777 | "pax-command" -> { c
with paxcmd
= unentS v
}
778 | "askpass-command" -> { c
with passcmd
= unentS v
}
779 | "savepath-command" -> { c
with savecmd
= unentS v
}
780 | "update-cursor" -> { c
with updatecurs
= bool_of_string v
}
781 | "hint-font-size" -> { c
with hfsize
= bound
(int_of_string v
) 5 100 }
782 | "page-scroll-scale" -> { c
with pgscale
= float_of_string v
}
783 | "use-pbo" -> { c
with usepbo
= bool_of_string v
}
784 | "wheel-scrolls-pages" -> { c
with wheelbypage
= bool_of_string v
}
785 | "horizontal-scrollbar-visible" ->
786 { c
with scrollb
= if bool_of_string v
787 then c
.scrollb
lor scrollbhv
788 else c
.scrollb
land (lnot scrollbhv
)
790 | "vertical-scrollbar-visible" ->
791 { c
with scrollb
= if bool_of_string v
792 then c
.scrollb
lor scrollbvv
793 else c
.scrollb
land (lnot scrollbvv
)
795 | "remote-in-a-new-instance" -> { c
with riani
= bool_of_string v
}
797 { c
with pax
= if bool_of_string v
then Some
0.0 else None
}
798 | "point-and-x-mark" -> { c
with paxmark
= MTE.of_string v
}
799 | "scroll-bar-on-the-left" -> { c
with leftscroll
= bool_of_string v
}
800 | "title" -> { c
with title
= unentS v
}
801 | "last-visit" -> { c
with lastvisit
= float_of_string v
}
802 | "edit-annotations-inline" -> { c
with annotinline
= bool_of_string v
}
803 | "coarse-presentation-positioning" ->
804 { c
with coarseprespos
= bool_of_string v
}
805 | "use-document-css" -> { c
with usedoccss
= bool_of_string v
}
808 dolog
"error processing attribute (`%S' = `%S'): %s" k v
@@ exntos exn
;
811 let rec fold c
= function
814 let c = apply c k v
in
817 fold { c with keyhashes
= copykeyhashes
c } attrs
;
820 let fromstring f pos
n v
d =
823 dolog
"error processing attribute (%S=%S) at %d\n%s" n v pos
@@ exntos exn
;
827 let bookmark_of attrs
=
828 let rec fold title page rely visy
= function
829 | ("title", v
) :: rest
-> fold v page rely visy rest
830 | ("page", v
) :: rest
-> fold title v rely visy rest
831 | ("rely", v
) :: rest
-> fold title page v visy rest
832 | ("visy", v
) :: rest
-> fold title page rely v rest
833 | _ :: rest
-> fold title page rely visy rest
834 | [] -> title
, page
, rely
, visy
836 fold "invalid" "0" "0" "0" attrs
840 let rec fold path key page rely pan visy origin dcf
= function
841 | ("path", v
) :: rest
-> fold v key page rely pan visy origin dcf rest
842 | ("key", v
) :: rest
-> fold path v page rely pan visy origin dcf rest
843 | ("page", v
) :: rest
-> fold path key v rely pan visy origin dcf rest
844 | ("rely", v
) :: rest
-> fold path key page v pan visy origin dcf rest
845 | ("pan", v
) :: rest
-> fold path key page rely v visy origin dcf rest
846 | ("visy", v
) :: rest
-> fold path key page rely pan v origin dcf rest
847 | ("origin", v
) :: rest
-> fold path key page rely pan visy v dcf rest
848 | ("dcf", v
) :: rest
-> fold path key page rely pan visy origin v rest
849 | _ :: rest
-> fold path key page rely pan visy origin dcf rest
850 | [] -> path
, key
, page
, rely
, pan
, visy
, origin
, dcf
852 fold E.s E.s "0" "0" "0" "0" E.s E.s attrs
856 let rec fold rs ls
= function
857 | ("out", v
) :: rest
-> fold v ls rest
858 | ("in", v
) :: rest
-> fold rs v rest
859 | _ :: rest
-> fold ls rs rest
865 let findkeyhash c name =
866 try List.assoc
name c.keyhashes
867 with Not_found
-> error
"invalid mode name `%s'" name
872 let h = Hashtbl.create
10 in
873 let dc = { defconf
with angle
= defconf
.angle
} in
874 let rec toplevel v t spos
_ =
876 | Vdata
| Vcdata
| Vend
-> v
877 | Vopen
("llppconfig", _, closed
) ->
880 else { v
with f = llppconfig
}
881 | Vopen
_ -> parse_error
"unexpected subelement at top level" s spos
882 | Vclose
_ -> parse_error
"unexpected close at top level" s spos
884 and llppconfig v t spos
_ =
886 | Vdata
| Vcdata
-> v
887 | Vend
-> parse_error
"unexpected end of input in llppconfig" s spos
888 | Vopen
("defaults", attrs
, closed
) ->
889 let c = config_of dc attrs
in
893 else { v
with f = defaults
}
895 | Vopen
("ui-font", attrs
, closed
) ->
896 let rec getsize size
= function
898 | ("size", v
) :: rest
->
900 fromstring int_of_string spos
"size" v
fstate.fontsize
in
902 | l -> getsize size l
904 fstate.fontsize
<- getsize fstate.fontsize attrs
;
907 else { v
with f = uifont
(Buffer.create
10) }
909 | Vopen
("doc", attrs
, closed
) ->
910 let pathent, key
, spage
, srely
, span
, svisy
, origin
, dcf
912 let path = unentS pathent
913 and origin
= unentS origin
914 and pageno = fromstring int_of_string spos
"page" spage
0
915 and rely
= fromstring float_of_string spos
"rely" srely
0.0
916 and pan
= fromstring int_of_string spos
"pan" span
0
917 and visy
= fromstring float_of_string spos
"visy" svisy
0.0 in
918 let c = config_of dc attrs
in
921 let anchor = (pageno, rely
, visy
) in
923 then (Hashtbl.add
h path (c, [], pan
, anchor, origin
); v
)
924 else { v
with f = doc
path origin pan
anchor c [] }
926 | Vopen
_ -> parse_error
"unexpected subelement in llppconfig" s spos
927 | Vclose
"llppconfig" -> { v
with f = toplevel }
928 | Vclose
_ -> parse_error
"unexpected close in llppconfig" s spos
930 and defaults v t spos
_ =
932 | Vdata
| Vcdata
-> v
933 | Vend
-> parse_error
"unexpected end of input in defaults" s spos
934 | Vopen
("keymap", attrs
, closed
) ->
936 try List.assoc
"mode" attrs
937 with Not_found
-> "global" in
942 let h = findkeyhash dc modename in
943 KeyMap.iter
(Hashtbl.replace
h) keymap
;
946 { v
with f = pkeymap
ret KeyMap.empty
}
949 parse_error
"unexpected subelement in defaults" s spos
951 | Vclose
"defaults" ->
952 { v
with f = llppconfig
}
954 | Vclose
_ -> parse_error
"unexpected close in defaults" s spos
956 and uifont
b v t spos epos
=
959 Buffer.add_substring
b s spos
(epos
- spos
);
961 | Vopen
(_, _, _) -> parse_error
"unexpected subelement in ui-font" s spos
962 | Vclose
"ui-font" ->
963 if emptystr
!fontpath
964 then fontpath := Buffer.contents
b;
965 { v
with f = llppconfig
}
966 | Vclose
_ -> parse_error
"unexpected close in ui-font" s spos
967 | Vend
-> parse_error
"unexpected end of input in ui-font" s spos
969 and doc
path origin pan
anchor c bookmarks v t spos
_ =
971 | Vdata
| Vcdata
-> v
972 | Vend
-> parse_error
"unexpected end of input in doc" s spos
973 | Vopen
("bookmarks", _, closed
) ->
976 else { v
with f = pbookmarks
path origin pan
anchor c bookmarks
}
978 | Vopen
("keymap", attrs
, closed
) ->
980 try List.assoc
"mode" attrs
981 with Not_found
-> "global"
987 let h = findkeyhash c modename in
988 KeyMap.iter
(Hashtbl.replace
h) keymap
;
989 doc
path origin pan
anchor c bookmarks
991 { v
with f = pkeymap
ret KeyMap.empty
}
993 | Vopen
("css", [], false) ->
994 { v
with f = pcss
path origin pan
anchor c bookmarks
}
997 parse_error
"unexpected subelement in doc" s spos
1000 Hashtbl.add
h path (c, List.rev bookmarks
, pan
, anchor, origin
);
1001 { v
with f = llppconfig
}
1003 | Vclose
_ -> parse_error
"unexpected close in doc" s spos
1005 and pcss
path origin pan
anchor c bookmarks v t spos epos
=
1008 let b = Buffer.create
10 in
1009 Buffer.add_substring
b s spos
(epos
- spos
);
1010 { v
with f = pcss
path origin pan
anchor
1011 { c with css
= Buffer.contents
b }
1013 | Vend
-> parse_error
"unexpected end of input in css" s spos
1014 | Vopen
_ -> parse_error
"unexpected subelement in css" s spos
1015 | Vclose
"css" -> { v
with f = doc
path origin pan
anchor c bookmarks
}
1016 | Vclose
_ -> parse_error
"unexpected close in css" s spos
1018 and pkeymap
ret keymap v t spos
_ =
1020 | Vdata
| Vcdata
-> v
1021 | Vend
-> parse_error
"unexpected end of input in keymap" s spos
1022 | Vopen
("map", attrs
, closed
) ->
1023 let r, l = map_of attrs
in
1024 let kss = fromstring keys_of_string spos
"in" r [] in
1025 let lss = fromstring keys_of_string spos
"out" l [] in
1029 | ks
:: [] -> KeyMap.add ks
(KMinsrl
lss) keymap
1030 | ks
:: rest
-> KeyMap.add ks
(KMmulti
(rest
, lss)) keymap
1033 then { v
with f = pkeymap
ret keymap }
1036 { v
with f = skip
"map" f }
1038 | Vopen
_ -> parse_error
"unexpected subelement in keymap" s spos
1039 | Vclose
"keymap" ->
1040 { v
with f = ret keymap }
1041 | Vclose
_ -> parse_error
"unexpected close in keymap" s spos
1043 and pbookmarks
path origin pan
anchor c bookmarks v t spos
_ =
1045 | Vdata
| Vcdata
-> v
1046 | Vend
-> parse_error
"unexpected end of input in bookmarks" s spos
1047 | Vopen
("item", attrs
, closed
) ->
1048 let titleent, spage
, srely
, svisy
= bookmark_of attrs
in
1049 let page = fromstring int_of_string spos
"page" spage
0
1050 and rely
= fromstring float_of_string spos
"rely" srely
0.0
1051 and visy
= fromstring float_of_string spos
"visy" svisy
0.0 in
1053 (unentS titleent, 0, Oanchor
(page, rely
, visy
)) :: bookmarks
1056 then { v
with f = pbookmarks
path origin pan
anchor c bookmarks }
1059 { v
with f = skip
"item" f }
1061 | Vopen
_ -> parse_error
"unexpected subelement in bookmarks" s spos
1062 | Vclose
"bookmarks" ->
1063 { v
with f = doc
path origin pan
anchor c bookmarks }
1064 | Vclose
_ -> parse_error
"unexpected close in bookmarks" s spos
1066 and skip tag
f v t spos
_ =
1068 | Vdata
| Vcdata
-> v
1070 parse_error
("unexpected end of input in skipped " ^ tag
) s spos
1071 | Vopen
(tag'
, _, closed
) ->
1075 let f'
() = { v
with f = skip tag
f } in
1076 { v
with f = skip tag'
f'
}
1080 else parse_error
("unexpected close in skipped " ^ tag
) s spos
1082 parse
{ f = toplevel; accu
= () } s;
1086 let do_load f contents
=
1089 | Parser.Parse_error
(msg
, s, pos
) ->
1090 let subs = Parser.subs s pos
in
1091 Utils.error
"parse error: %s: at %d [..%S..]" msg pos
subs
1093 | exn
-> Utils.error
"parse error: %s" @@ exntos exn
1098 let xdgconfdir = Utils.getenvdef
"XDG_CONFIG_HOME" E.s in
1099 if emptystr
xdgconfdir
1102 let dir = Filename.concat
home ".config" in
1103 if Sys.is_directory
dir then dir else home
1107 Filename.concat
dir "llpp.conf"
1110 let confpath = ref defconfpath;;
1112 let load2 f default
=
1113 match filecontents
!confpath with
1114 | contents
-> f @@ do_load get contents
1115 | exception Unix.Unix_error
(Unix.ENOENT
, "open", _) ->
1116 f (Hashtbl.create
0, defconf
)
1118 dolog
"error loading configuration from `%S': %s" !confpath @@ exntos exn
;
1122 let load1 f = load2 f false;;
1130 (fun path (conf, _, _, _, _) ((_, besttime
) as best
) ->
1131 if conf.lastvisit
> besttime
1132 then (path, conf.lastvisit
)
1135 (state.path, -.infinity
)
1139 let pc, pb
, px
, pa
, po
=
1140 let def = dc, [], 0, emptyanchor, state.origin
in
1141 if emptystr
state.path
1144 let absname = abspath
state.path in
1145 match Hashtbl.find h absname with
1146 | (c,b,x
,a
,_) -> (c,b,x
,a
,state.origin
)
1147 | exception Not_found
->
1148 let exception E
of (conf * outline list
* int * anchor * string) in
1149 let key = try Digest.file
absname |> Digest.to_hex
with _ -> E.s in
1153 Hashtbl.iter
(fun p
((c, _, _, _, _) as v
) ->
1156 dolog
"will use %s's settings due to matching keys" p
;
1163 | exception E v
-> v
1167 state.bookmarks <- pb
;
1178 Hashtbl.fold (fun path (pc, pb
, px
, pa
, po
) accu
->
1179 (path, pc, pb
, px
, pa
, po
) :: accu
)
1185 let add_attrs bb always
dc c time
=
1187 Buffer.add_string bb
"\n ";
1188 Printf.bprintf bb fmt
s
1190 let o c fmt
s = if c then o' fmt
s else ignore
in
1191 let ob s a
b = o (always
|| a
!= b) "%s='%b'" s a
1192 and op
s a
b = o (always
|| a
<> b) "%s='%b'" s (a
!= None
)
1193 and oi
s a
b = o (always
|| a
!= b) "%s='%d'" s a
1194 and oI
s a
b = o (always
|| a
!= b) "%s='%s'" s (string_with_suffix_of_int a
)
1195 and oz
s a
b = o (always
|| a
<> b) "%s='%g'" s (a
*.100.)
1196 and oF
s a
b = o (always
|| a
<> b) "%s='%f'" s a
1197 and oL
s a
b = o (always
|| a
<> b) "%s='%Ld'" s a
1198 and oc
s a
b = o (always
|| a
<> b) "%s='%s'" s (color_to_string a
)
1199 and oA
s a
b = o (always
|| a
<> b) "%s='%s'" s (rgba_to_string a
)
1200 and oC
s a
b = o (always
|| a
<> b) "%s='%s'" s (CSTE.to_string a
)
1201 and oR
s a
b = o (always
|| a
<> b) "%s='%s'" s (irect_to_string a
)
1202 and oFm
s a
b = o (always
|| a
<> b) "%s='%s'" s (FMTE.to_string a
)
1204 o (always
|| a
land m
<> b land m
) "%s='%b'" s (a
land m
!= 0)
1205 and oPm
s a
b = o (always
|| a
<> b) "%s='%s'" s (MTE.to_string a
)
1207 o (always
|| a
<> b) "%s='%s'" s @@ Parser.enent a
0 (String.length a
)
1212 | Cmulti
((n, a
, b), _) when n > 1 -> o'
"%s='%d,%d,%d'" s n a
b
1213 | Csplit
(n, _) when n > 1 -> o'
"%s='%d'" s ~
-n
1214 | Cmulti
_ | Csplit
_ | Csingle
_ -> ()
1219 | Some
c when c > 1 -> o'
"%s='%d'" s c
1222 oi
"width" c.cwinw
dc.cwinw
;
1223 oi
"height" c.cwinh
dc.cwinh
;
1224 oi
"scroll-bar-width" c.scrollbw
dc.scrollbw
;
1225 oi
"scroll-handle-height" c.scrollh
dc.scrollh
;
1226 oSv
"horizontal-scrollbar-visible" c.scrollb
dc.scrollb scrollbhv
;
1227 oSv
"vertical-scrollbar-visible" c.scrollb
dc.scrollb scrollbvv
;
1228 ob "case-insensitive-search" c.icase
dc.icase
;
1229 ob "preload" c.preload
dc.preload
;
1230 oi
"page-bias" c.pagebias
dc.pagebias
;
1231 oi
"scroll-step" c.scrollstep
dc.scrollstep
;
1232 oi
"auto-scroll-step" c.autoscrollstep
dc.autoscrollstep
;
1233 ob "max-height-fit" c.maxhfit
dc.maxhfit
;
1234 ob "highlight-links" c.hlinks
dc.hlinks
;
1235 ob "under-cursor-info" c.underinfo
dc.underinfo
;
1236 oi
"vertical-margin" c.interpagespace
dc.interpagespace
;
1237 oz
"zoom" c.zoom dc.zoom;
1238 ob "presentation" c.presentation
dc.presentation
;
1239 oi
"rotation-angle" c.angle
dc.angle
;
1240 oFm
"fit-model" c.fitmodel
dc.fitmodel
;
1241 oI
"pixmap-cache-size" c.memlimit
dc.memlimit
;
1242 oi
"tex-count" c.texcount
dc.texcount
;
1243 oi
"slice-height" c.sliceheight
dc.sliceheight
;
1244 oi
"thumbnail-width" c.thumbw
dc.thumbw
;
1245 oc
"background-color" c.bgcolor
dc.bgcolor
;
1246 oA
"paper-color" c.papercolor
dc.papercolor
;
1247 oA
"scrollbar-color" c.sbarcolor
dc.sbarcolor
;
1248 oA
"scrollbar-handle-color" c.sbarhndlcolor
dc.sbarhndlcolor
;
1249 oA
"texture-color" c.texturecolor
dc.texturecolor
;
1250 oi
"tile-width" c.tilew
dc.tilew
;
1251 oi
"tile-height" c.tileh
dc.tileh
;
1252 oI
"mupdf-store-size" c.mustoresize
dc.mustoresize
;
1253 ob "checkers" c.checkers
dc.checkers
;
1254 oi
"aalevel" c.aalevel
dc.aalevel
;
1255 ob "trim-margins" c.trimmargins
dc.trimmargins
;
1256 oR
"trim-fuzz" c.trimfuzz
dc.trimfuzz
;
1257 os
"uri-launcher" c.urilauncher
dc.urilauncher
;
1258 os
"path-launcher" c.pathlauncher
dc.pathlauncher
;
1259 oC
"color-space" c.colorspace
dc.colorspace
;
1260 ob "invert-colors" c.invert
dc.invert
;
1261 oF
"brightness" c.colorscale
dc.colorscale
;
1262 oco
"columns" c.columns
dc.columns
;
1263 obeco
"birds-eye-columns" c.beyecolumns
dc.beyecolumns
;
1264 os
"selection-command" c.selcmd
dc.selcmd
;
1265 os
"paste-command" c.pastecmd
dc.pastecmd
;
1266 os
"synctex-command" c.stcmd
dc.stcmd
;
1267 os
"pax-command" c.paxcmd
dc.paxcmd
;
1268 os
"askpass-command" c.passcmd
dc.passcmd
;
1269 os
"savepath-command" c.savecmd
dc.savecmd
;
1270 ob "update-cursor" c.updatecurs
dc.updatecurs
;
1271 oi
"hint-font-size" c.hfsize
dc.hfsize
;
1272 oi
"horizontal-scroll-step" c.hscrollstep
dc.hscrollstep
;
1273 oF
"page-scroll-scale" c.pgscale
dc.pgscale
;
1274 ob "use-pbo" c.usepbo
dc.usepbo
;
1275 ob "wheel-scrolls-pages" c.wheelbypage
dc.wheelbypage
;
1276 ob "remote-in-a-new-instance" c.riani
dc.riani
;
1277 op
"point-and-x" c.pax
dc.pax
;
1278 oPm
"point-and-x-mark" c.paxmark
dc.paxmark
;
1279 ob "scroll-bar-on-the-left" c.leftscroll
dc.leftscroll
;
1281 then os
"title" c.title
dc.title
;
1282 oL
"last-visit" (Int64.of_float time
) 0L;
1283 ob "edit-annotations-inline" c.annotinline
dc.annotinline
;
1284 ob "coarse-presentation-positioning" c.coarseprespos
dc.coarseprespos
;
1285 ob "use-document-css" c.usedoccss
dc.usedoccss
;
1286 os
"dcf" c.dcf
dc.dcf
;
1289 let keymapsbuf always
dc c =
1291 let bb = create
16 in
1292 let rec loop = function
1294 | (modename, h) :: rest
->
1295 let dh = findkeyhash dc modename in
1296 if always
|| h <> dh
1298 if Hashtbl.length
h > 0
1300 if length
bb > 0 then add_char
bb '
\n'
;
1301 Printf.bprintf
bb "<keymap mode='%s'>\n" modename;
1302 Hashtbl.iter
(fun i
o ->
1303 if always
|| match Hashtbl.find dh i
1304 with | dO
-> dO
<> o | exception Not_found
-> false
1307 if Wsi.withctrl m
then add_string
bb "ctrl-";
1308 if Wsi.withalt m
then add_string
bb "alt-";
1309 if Wsi.withshift m
then add_string
bb "shift-";
1310 if Wsi.withmeta m
then add_string
bb "meta-";
1311 add_string
bb (Wsi.keyname
k);
1314 let rec loop = function
1316 | km
:: [] -> addkm km
1317 | km
:: rest
-> addkm km
; add_char
bb ' '
; loop rest
1321 add_string
bb "<map in='";
1325 add_string
bb "' out='"; addkm km
; add_string
bb "'/>\n"
1328 add_string
bb "' out='"; addkms kms
; add_string
bb "'/>\n"
1330 | KMmulti
(ins
, kms
) ->
1331 add_char
bb ' '
; addkms ins
; add_string
bb "' out='";
1332 addkms kms
; add_string
bb "'/>\n"
1334 add_string
bb "</keymap>";
1343 let keystostrlist c =
1344 let rec loop accu
= function
1346 | (modename, h) :: rest
->
1348 if Hashtbl.length
h > 0
1350 let accu = Printf.sprintf
"\xc2\xb7Keys for %s" modename :: accu in
1351 Hashtbl.fold (fun i
o a
->
1352 let bb = Buffer.create
10 in
1354 if Wsi.withctrl m
then Buffer.add_string
bb "ctrl-";
1355 if Wsi.withalt m
then Buffer.add_string
bb "alt-";
1356 if Wsi.withshift m
then Buffer.add_string
bb "shift-";
1357 if Wsi.withmeta m
then Buffer.add_string
bb "meta-";
1358 Buffer.add_string
bb (Wsi.keyname
k);
1361 let rec loop = function
1363 | km
:: [] -> addkm km
1365 addkm km
; Buffer.add_char
bb ' '
;
1371 Buffer.add_char
bb '
\t'
;
1373 | KMinsrt km
-> addkm km
1374 | KMinsrl kms
-> addkms kms
1375 | KMmulti
(ins
, kms
) ->
1376 Buffer.add_char
bb ' '
;
1378 Buffer.add_string
bb "\t";
1381 Buffer.contents
bb :: a
1391 let save1 bb leavebirdseye x
h dc =
1392 let uifontsize = fstate.fontsize
in
1393 let dc = if !bedefault then conf else dc in
1394 Buffer.add_string
bb "<llppconfig>\n";
1395 if nonemptystr
!fontpath
1396 then Printf.bprintf
bb "<ui-font size='%d'><![CDATA[%s]]></ui-font>\n"
1397 uifontsize !fontpath
1400 then Printf.bprintf
bb "<ui-font size='%d'/>\n" uifontsize
1403 Buffer.add_string
bb "<defaults";
1404 add_attrs bb true dc dc nan
;
1405 let kb = keymapsbuf true dc dc in
1406 if Buffer.length
kb > 0
1408 Buffer.add_string
bb ">\n";
1409 Buffer.add_buffer
bb kb;
1410 Buffer.add_string
bb "\n</defaults>\n";
1412 else Buffer.add_string
bb "/>\n";
1414 let adddoc path pan
anchor c bookmarks time origin
=
1415 if not
(bookmarks == [] && c = dc && anchor = emptyanchor)
1417 Printf.bprintf
bb "<doc path='%s'"
1418 (Parser.enent
path 0 (String.length
path));
1420 if nonemptystr
c.key
1421 then Printf.bprintf
bb "\n key='%s'" c.key;
1423 if nonemptystr origin
1424 then Printf.bprintf
bb "\n origin='%s'"
1425 (Parser.enent origin
0 (String.length origin
));
1427 if anchor <> emptyanchor
1429 let n, rely
, visy
= anchor in
1430 Printf.bprintf
bb "\n page='%d'" n;
1433 then Printf.bprintf
bb " rely='%f'" rely
;
1435 if abs_float visy
> 1e-6
1436 then Printf.bprintf
bb " visy='%f'" visy
;
1440 then Printf.bprintf
bb " pan='%d'" pan
;
1442 add_attrs bb false dc c time
;
1443 if nonemptystr
c.css
1444 then Printf.bprintf
bb ">\n <css><![CDATA[%s]]></css>" c.css
;
1445 let kb = keymapsbuf false dc c in
1447 begin match bookmarks with
1449 if Buffer.length
kb > 0
1451 Buffer.add_string
bb ">\n";
1452 Buffer.add_buffer
bb kb;
1453 Buffer.add_string
bb "\n</doc>\n";
1456 if nonemptystr
c.css
1457 then Buffer.add_string
bb "\n</doc>\n"
1458 else Buffer.add_string
bb "/>\n"
1461 Buffer.add_string
bb ">\n<bookmarks>\n";
1462 List.iter
(fun (title
, _, kind
) ->
1463 begin match kind
with
1464 | Oanchor
(page, rely
, visy
) ->
1466 "<item title='%s' page='%d'"
1467 (Parser.enent title
0 (String.length title
))
1470 then Printf.bprintf
bb " rely='%f'" rely
;
1471 if abs_float visy
> 1e-6
1472 then Printf.bprintf
bb " visy='%f'" visy
;
1474 | Ohistory
_ | Onone
| Ouri
_ | Oremote
_
1475 | Oremotedest
_ | Olaunch
_ -> error
"unexpected link in bookmarks"
1477 Buffer.add_string
bb "/>\n";
1479 Buffer.add_string
bb "</bookmarks>";
1480 if Buffer.length
kb > 0
1482 Buffer.add_string
bb "\n";
1483 Buffer.add_buffer
bb kb;
1485 Buffer.add_string
bb "\n</doc>\n";
1491 match state.mode
with
1492 | Birdseye
(c, pan, _, _, _) ->
1494 match conf.columns
with
1495 | Cmulti
((c, _, _), _) -> Some
c
1499 match c.columns
with
1500 | Cmulti
(c, _) -> Cmulti
(c, E.a
)
1501 | Csingle
_ -> Csingle
E.a
1502 | Csplit
_ -> failwith
"quit from bird's eye while split"
1504 pan, { c with beyecolumns = beyecolumns; columns
= columns
}
1507 | LinkNav
_ -> x
, conf
1509 let docpath = if nonemptystr
state.path then abspath
state.path else E.s in
1510 if nonemptystr
docpath
1512 adddoc docpath pan (getanchor ())
1514 let autoscrollstep =
1515 match state.autoscroll
with
1517 | None
-> conf.autoscrollstep
1519 begin match state.mode
with
1520 | Birdseye beye
-> leavebirdseye beye
true
1526 if emptystr
conf.key
1527 then (try Digest.file
docpath |> Digest.to_hex
with _ -> E.s)
1529 in { conf with autoscrollstep; key }
1535 Hashtbl.iter
(fun path (c, bookmarks, x
, anchor, origin
) ->
1536 if docpath <> abspath
path
1537 then adddoc path x
anchor c bookmarks c.lastvisit origin
1539 Buffer.add_string
bb "</llppconfig>\n";
1543 let save leavebirdseye
=
1544 let relx = float state.x
/. float state.winw
in
1546 let cx w = truncate
(relx *. float w) in
1548 (fun (w, h, x
) ws
->
1550 | Wsi.Fullscreen
-> (conf.cwinw
, conf.cwinh
, cx conf.cwinw
)
1551 | Wsi.MaxVert
-> (w, conf.cwinh
, x
)
1552 | Wsi.MaxHorz
-> (conf.cwinw
, h, cx conf.cwinw
)
1554 (state.winw
, state.winh
, state.x
) state.winstate
1558 let bb = Buffer.create
32768 in
1559 let save2 (h, dc) = save1 bb leavebirdseye x
h dc in
1560 if load1 save2 && Buffer.length
bb > 0
1563 let tmp = !confpath ^
".tmp" in
1564 let oc = open_out_bin
tmp in
1565 Buffer.output_buffer
oc bb;
1567 Unix.rename
tmp !confpath;
1568 with exn
-> dolog
"error saving configuration: %s" @@ exntos exn
1572 let href = ref @@ Hashtbl.create
0 in
1573 let cref = ref defconf
in
1576 if Sys.file_exists
path
1578 else (dolog
"removing entry for '%s'" path; None
) in
1579 Hashtbl.filter_map_inplace
f h;
1584 ignore
(load1 push);
1585 let bb = Buffer.create
32768 in
1586 let save2 (_h
, dc) = save1 bb (fun _ _ -> ()) 0 !href dc in
1587 if load1 save2 && Buffer.length
bb > 0
1590 let tmp = !confpath ^
".tmp" in
1591 let oc = open_out_bin
tmp in
1592 Buffer.output_buffer
oc bb;
1594 Unix.rename
tmp !confpath;
1595 with exn
-> dolog
"error saving configuration: %s" @@ exntos exn
1599 let logcurrently = function
1600 | Idle
-> dolog
"Idle"
1601 | Loading
(l, gen
) ->
1602 dolog
"Loading %d gen=%d curgen=%d" l.pageno gen
state.gen
1603 | Tiling
(l, pageopaque
, colorspace
, angle
, gen
, col
, row
, tilew
, tileh
) ->
1604 dolog
"Tiling %d[%d,%d] page=%s cs=%s angle=%d"
1605 l.pageno col row
(~
> pageopaque
)
1606 (CSTE.to_string colorspace
) angle
;
1607 dolog
"gen=(%d,%d) (%d,%d) tile=(%d,%d) (%d,%d)"
1608 angle gen
conf.angle
state.gen
1610 conf.tilew
conf.tileh
1611 | Outlining
_ -> dolog
"outlining"
1615 dolog
{|l %d dim
=%d
{
1622 l.pageno l.pagedimno
1626 l.pagedispx
l.pagedispy