3 external fz_version
: unit -> string = "ml_fz_version";;
6 { mutable fontsize
: int
7 ; mutable wwidth
: float
8 ; mutable maxrows
: int
13 { fontsize
= 20 * Wsi.fontsizefactor
()
21 let fastghyllscroll = (5,1,2);;
22 let neatghyllscroll = (10,1,9);;
24 let irect_of_string s
=
25 Scanf.sscanf s
"%d/%d/%d/%d" (fun x0 y0 x1 y1
-> (x0
,y0
,x1
,y1
))
28 let irect_to_string (x0
,y0
,x1
,y1
) =
29 Printf.sprintf
"%d/%d/%d/%d" x0 y0 x1 y1
32 let ghyllscroll_of_string s
=
34 | "fast" -> Some
fastghyllscroll
35 | "neat" -> Some
(10,1,9)
39 Scanf.sscanf s
"%u,%u,%u" (fun n a b
-> n
, a
, b
) in
40 if n
<= a
|| n
<= b
|| a
>= b
41 then error
"N(%d),A(%d),B(%d) (N <= A, A < B, N <= B)" n a b
;
45 let ghyllscroll_to_string ((n
, a
, b
) as nab
) =
46 if nab
= fastghyllscroll then "fast"
47 else if nab
= neatghyllscroll then "neat"
48 else Printf.sprintf
"%d,%d,%d" n a b
;
51 let multicolumns_to_string (n
, a
, b
) =
53 then Printf.sprintf
"%d" n
54 else Printf.sprintf
"%d,%d,%d" n a b
;
57 let multicolumns_of_string s
=
59 (int_of_string s
, 0, 0)
61 Scanf.sscanf s
"%u,%u,%u" (fun n a b
->
63 then failwith
"subtly broken";
71 | KMmulti
of key list
* key list
73 and keyhash
= (key
, keymap
) Hashtbl.t
76 | KSinto
of (key list
* key list
)
77 and interpagespace
= int
78 and multicolumns
= multicol
* pagegeom
79 and singlecolumn
= pagegeom
80 and splitcolumns
= columncount
* pagegeom
81 and pagegeom
= (pdimno
* x
* y
* (pageno
* width
* height
* leftx
)) array
82 and multicol
= columncount
* covercount
* covercount
86 and fitmodel
= | FitWidth
| FitProportional
| FitPage
87 and trimmargins
= bool
88 and irect
= (int * int * int * int)
94 (angle
* fitmodel
* trimparams
* texcount
* sliceheight
* memsize
95 * colorspace
* fontpath
* trimcachepath
* haspbo
)
100 and rectcolor
= (float * float * float * float)
105 and fontpath
= string
106 and trimcachepath
= string
109 and trimparams
= (trimmargins
* irect
)
110 and colorspace
= | Rgb
| Bgr
| Gray
112 and usefontconfig
= bool
120 and tileparams
= (x
* y
* width
* height
* tilex
* tiley
)
125 | Uannotation
of (opaque
* slinkindex
)
127 and facename
= string
128 and launchcommand
= string
129 and filename
= string
132 and destname
= string
144 | LDfirstvisible
of (int * int * int)
153 and anchor
= pageno
* top
* dtop
154 and rect
= float * float * float * float * float * float * float * float
155 and infochange
= | Memused
| Docinfo
| Pdim
160 method display
: unit
161 method key
: int -> int -> uioh
162 method button
: int -> bool -> int -> int -> int -> uioh
163 method multiclick
: int -> int -> int -> int -> uioh
164 method motion
: int -> int -> uioh
165 method pmotion
: int -> int -> uioh
166 method infochanged
: infochange
-> unit
167 method scrollpw
: (int * float * float)
168 method scrollph
: (int * float * float)
169 method modehash
: keyhash
170 method eformsgs
: bool
171 method alwaysscrolly
: bool
172 method scroll
: int -> int -> uioh
173 method zoom
: float -> int -> int -> unit
176 module type TextEnumType
=
180 val names
: string array
183 module TextEnumMake
(Ten
: TextEnumType
) =
185 let names = Ten.names;;
186 let to_int (t
: Ten.t
) = Obj.magic t
;;
187 let to_string t
= names.(to_int t
);;
188 let of_int n
: Ten.t
= Obj.magic n
;;
191 if i
= Array.length
names
192 then failwith
("invalid " ^
Ten.name ^
": " ^ s
)
201 module CSTE
= TextEnumMake
(struct
202 type t
= colorspace
;;
203 let name = "colorspace";;
204 let names = [|"rgb"; "bgr"; "gray"|];;
207 module MTE
= TextEnumMake
(struct
210 let names = [|"page"; "block"; "line"; "word"|];;
213 module FMTE
= TextEnumMake
(struct
215 let name = "fitmodel";;
216 let names = [|"width"; "proportional"; "page"|];;
220 { mutable scrollbw
: int
221 ; mutable scrollh
: int
222 ; mutable scrollb
: scrollb
223 ; mutable icase
: bool
224 ; mutable preload
: bool
225 ; mutable pagebias
: int
226 ; mutable verbose
: bool
227 ; mutable debug
: bool
228 ; mutable scrollstep
: int
229 ; mutable hscrollstep
: int
230 ; mutable maxhfit
: bool
231 ; mutable crophack
: bool
232 ; mutable autoscrollstep
: int
233 ; mutable maxwait
: float option
234 ; mutable hlinks
: bool
235 ; mutable underinfo
: bool
236 ; mutable interpagespace
: interpagespace
237 ; mutable zoom
: float
238 ; mutable presentation
: bool
239 ; mutable angle
: angle
240 ; mutable cwinw
: int
241 ; mutable cwinh
: int
242 ; mutable savebmarks
: bool
243 ; mutable fitmodel
: fitmodel
244 ; mutable trimmargins
: trimmargins
245 ; mutable trimfuzz
: irect
246 ; mutable memlimit
: memsize
247 ; mutable texcount
: texcount
248 ; mutable sliceheight
: sliceheight
249 ; mutable thumbw
: width
250 ; mutable jumpback
: bool
251 ; mutable bgcolor
: rgb
252 ; mutable sbarcolor
: rgba
253 ; mutable sbarhndlcolor
: rgba
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 ghyllscroll
: (int * int * int) option
266 ; mutable columns
: columns
267 ; mutable beyecolumns
: columncount
option
268 ; mutable selcmd
: string
269 ; mutable paxcmd
: string
270 ; mutable passcmd
: string
271 ; mutable savecmd
: string
272 ; mutable updatecurs
: bool
273 ; mutable keyhashes
: (string * keyhash
) list
274 ; mutable hfsize
: int
275 ; mutable pgscale
: float
276 ; mutable usepbo
: bool
277 ; mutable wheelbypage
: bool
278 ; mutable stcmd
: string
279 ; mutable riani
: bool
280 ; mutable pax
: float option
281 ; mutable paxmark
: mark
282 ; mutable leftscroll
: bool
283 ; mutable title
: string
284 ; mutable lastvisit
: float
285 ; mutable annotinline
: bool
286 ; mutable coarseprespos
: bool
288 ; mutable usedoccss
: usedoccss
289 ; mutable key
: string
292 | Csingle
of singlecolumn
293 | Cmulti
of multicolumns
294 | Csplit
of splitcolumns
299 | Olaunch
of launchcommand
300 | Oremote
of (filename
* pageno
)
301 | Oremotedest
of (filename
* destname
)
302 | Ohistory
of (filename
* conf
* outline list
* x
* anchor
* filename
)
303 and outline
= (caption
* outlinelevel
* outlinekind
)
304 and outlinelevel
= int
305 and rgb
= (float * float * float)
306 and rgba
= (float * float * float * float)
324 type tile
= opaque
* pixmapsize
* elapsed
325 and elapsed
= float;;
326 type pagemapkey
= pageno
* gen
;;
327 type tilemapkey
= pageno
* gen
* colorspace
* angle
* width
* height
* col
* row
332 | Loading
of (page
* gen
)
334 page
* opaque
* colorspace
* angle
* gen
* col
* row
* width
* height
336 | Outlining
of outline list
339 type mpos
= int * int
341 | Msel
of (mpos
* mpos
)
343 | Mscrolly
| Mscrollx
344 | Mzoom
of (buttonno
* step
* mpos
)
345 | Mzoomrect
of (mpos
* mpos
)
352 | Birdseye
of (conf
* leftx
* pageno
* pageno
* anchor
)
353 | Textentry
of (textentry
* onleave
)
355 | LinkNav
of linktarget
356 and onleave
= leavetextentrystatus
-> unit
357 and leavetextentrystatus
= | Cancel
| Confirm
358 and helpitem
= string * int * action
361 | Action
of (uioh
-> uioh
)
363 | Ltexact
of (pageno
* direction
)
364 | Ltgendir
of direction
365 | Ltnotready
of (pageno
* direction
)
366 and direction
= int (* -1, 0, 1 *)
367 and textentry
= string * string * onhist
option
368 * onkey
* ondone
* cancelonempty
369 and onkey
= string -> Keys.t
-> te
370 and ondone
= string -> unit
371 and histcancel
= unit -> unit
372 and onhist
= ((histcmd
-> string) * histcancel
)
373 and histcmd
= HCnext
| HCprev
| HCfirst
| HClast
374 and cancelonempty
= bool
379 | TEswitch
of textentry
391 { mutable ss
: Unix.file_descr
392 ; mutable wsfd
: Unix.file_descr
393 ; mutable stderr
: Unix.file_descr
394 ; mutable errmsgs
: Buffer.t
395 ; mutable newerrmsgs
: bool
399 ; mutable anchor
: anchor
400 ; mutable ranchors
: (string * string * anchor
* string) list
402 ; mutable layout
: page list
403 ; pagemap
: (pagemapkey
, opaque
) Hashtbl.t
404 ; tilemap
: (tilemapkey
, tile
) Hashtbl.t
405 ; tilelru
: (tilemapkey
* opaque
* pixmapsize
) Queue.t
406 ; mutable pdims
: (pageno
* width
* height
* leftx
) list
407 ; mutable pagecount
: int
408 ; mutable currently
: currently
409 ; mutable mstate
: mstate
410 ; mutable searchpattern
: string
411 ; mutable rects
: (pageno
* rectcolor
* rect
) list
412 ; mutable rects1
: (pageno
* rectcolor
* rect
) list
413 ; prects
: (pageno
, float array
) Hashtbl.t
414 ; mutable text
: string
415 ; mutable winstate
: Wsi.winstate list
416 ; mutable mode
: mode
417 ; mutable uioh
: uioh
418 ; mutable outlines
: outline array
419 ; mutable bookmarks
: outline list
420 ; mutable path
: string
421 ; mutable password
: string
422 ; mutable nameddest
: string
423 ; mutable geomcmds
: (string * ((string * (unit -> unit)) list
))
424 ; mutable memused
: memsize
426 ; mutable throttle
: (page list
* int * float) option
427 ; mutable autoscroll
: int option
428 ; mutable ghyll
: (int option -> unit)
429 ; mutable help
: helpitem array
430 ; mutable docinfo
: (int * string) list
431 ; mutable checkerstexid
: GlTex.texture_id
option
433 ; mutable prevzoom
: (float * int)
434 ; mutable progress
: float
435 ; mutable redisplay
: bool
436 ; mutable mpos
: mpos
437 ; mutable keystate
: keystate
438 ; mutable glinks
: bool
439 ; mutable prevcolumns
: (columns
* float) option
442 ; mutable reprf
: (unit -> unit)
443 ; mutable origin
: string
444 ; mutable roam
: (unit -> unit)
445 ; mutable bzoom
: bool
446 ; mutable traw
: [`
float] Raw.t
447 ; mutable vraw
: [`
float] Raw.t
448 ; mutable lnava
: (pageno
* linkno
) option
449 ; mutable slideshow
: int
452 { pat
: string circbuf
453 ; pag
: string circbuf
454 ; nav
: anchor circbuf
455 ; sel
: string circbuf
459 let emptyanchor = (0, 0.0, 0.0);;
460 let emptykeyhash = Hashtbl.create
0;;
462 let noreprf () = ();;
465 let nouioh : uioh
= object (self
)
467 method key _ _
= self
468 method multiclick _ _ _ _
= self
469 method button _ _ _ _ _
= self
470 method motion _ _
= self
471 method pmotion _ _
= self
472 method infochanged _
= ()
473 method scrollpw
= (0, nan
, nan
)
474 method scrollph
= (0, nan
, nan
)
475 method modehash
= emptykeyhash
476 method eformsgs
= false
477 method alwaysscrolly
= false
478 method scroll _ _
= self
479 method zoom _ _ _
= ()
482 let platform_to_string = function
483 | Punknown
-> "unknown"
488 | Pcygwin
-> "Cygwin"
492 Printf.sprintf
"llpp version %s, fitz %s, ocaml %s/%d bit"
493 Help.version (fz_version
()) Sys.ocaml_version
Sys.word_size
499 ; scrollb
= scrollbhv lor scrollbvv
515 ; presentation
= false
520 ; fitmodel
= FitProportional
521 ; trimmargins
= false
522 ; trimfuzz
= (0,0,0,0)
523 ; memlimit
= 32 lsl 20
528 ; bgcolor
= (0.5, 0.5, 0.5)
529 ; sbarcolor
= (0.64, 0.64, 0.64, 0.7)
530 ; sbarhndlcolor
= (0.0, 0.0, 0.0, 0.7)
534 ; mustoresize
= 256 lsl 20
539 | Plinux
| Psun
| Pbsd
-> "xdg-open \"%s\""
540 | Posx
-> "open \"%s\""
541 | Pcygwin
-> "cygstart \"%s\""
542 | Punknown
-> "echo %s")
543 ; pathlauncher
= "lp \"%s\""
546 | Plinux
| Pbsd
| Psun
-> "xsel -i"
557 ; columns
= Csingle
[||]
560 ; hfsize
= 12 * Wsi.fontsizefactor
()
563 ; wheelbypage
= false
564 ; stcmd
= "echo SyncTex"
567 ; paxmark
= Mark_word
572 ; coarseprespos
= false
577 let mk n
= (n
, Hashtbl.create
1) in
591 let conf = { defconf with angle
= defconf.angle
};;
594 let command = Str.global_replace percentsre url
conf.urilauncher
in
595 try ignore
@@ spawn
command []
596 with exn
-> dolog
"failed to execute `%s': %s" command @@ exntos exn
600 if emptystr
conf.urilauncher
603 match geturl uri
with
604 | "" -> dolog
"obtained empty url from uri %S" uri
611 :: "(searching in this text works just by typing (i.e. no initial '/'))"
616 | "" -> (s
, 0, Noaction
)
617 | url
-> (s
, 0, Action
(fun uioh
-> gotourl url
; uioh
))
622 { store
= Array.make n v
629 let cbcap b
= Array.length b
.store
;;
631 let cbput ?
(update_rc
=true) b v
=
634 b
.wc
<- (b
.wc
+ 1) mod cap;
637 b
.len
<- min
(b
.len
+ 1) cap;
640 let cbput_dont_update_rc b v
= cbput ~update_rc
:false b v
;;
642 let cbempty b
= b
.len
= 0;;
644 let cbgetg b circular dir
=
648 let rc = b
.rc + dir
in
660 else bound
rc 0 (b
.len
-1)
666 let cbget b
= cbgetg b
false;;
667 let cbgetc b
= cbgetg b
true;;
672 ; stderr
= Unix.stderr
673 ; errmsgs
= Buffer.create
0
678 ; anchor
= emptyanchor
682 ; tilelru
= Queue.create
()
683 ; pagemap
= Hashtbl.create
10
684 ; tilemap
= Hashtbl.create
10
691 ; prects
= Hashtbl.create
1
695 ; searchpattern
= E.s
703 { nav
= cbnew 10 emptyanchor
715 ; checkerstexid
= None
716 ; prevzoom
= (1.0, 0)
730 ; traw
= Raw.create_static `
float ~len
:8
731 ; vraw
= Raw.create_static `
float ~len
:8
737 let copykeyhashes c
=
738 List.map
(fun (k
, v
) -> k
, Hashtbl.copy v
) c
.keyhashes
;
742 let d = state.winh
- h
in
743 max
conf.interpagespace
((d + 1) / 2)
746 let rowyh (c
, coverA
, coverB
) b n
=
747 if c
= 1 || (n
< coverA
|| n
>= state.pagecount
- coverB
)
749 let _, _, vy
, (_, _, h
, _) = b
.(n
) in
752 let n'
= n - coverA
in
755 let e = min
state.pagecount
(s + c
) in
756 let rec find m miny maxh
= if m
= e then miny
, maxh
else
757 let _, _, y
, (_, _, h
, _) = b
.(m
) in
758 let miny = min
miny y
in
759 let maxh = max
maxh h
in
765 let ((c
, coverA
, coverB
) as cl
), b
=
766 match conf.columns
with
767 | Csingle b
-> (1, 0, 0), b
768 | Cmulti
(c
, b
) -> c
, b
769 | Csplit
(_, b
) -> (1, 0, 0), b
771 if Array.length b
= 0
774 let rec bsearch nmin nmax
=
776 then bound nmin
0 (state.pagecount
-1)
778 let n = (nmax
+ nmin
) / 2 in
779 let vy, h
= rowyh cl b
n in
783 let ips = calcips h
in
785 let y1 = vy + h
+ ips in
789 then 0, vy + h
+ conf.interpagespace
791 let y0 = vy - conf.interpagespace
in
792 y0, y0 + h
+ conf.interpagespace
802 if n < state.pagecount
- coverB
803 then ((n-coverA
)/c
)*c
+ coverA
810 then bsearch (n+1) nmax
811 else bsearch nmin
(n-1)
814 bsearch 0 (state.pagecount
-1);
818 match conf.columns
with
819 | Cmulti
((_, _, _) as cl
, b
) ->
820 if Array.length b
> 0
822 let y, h
= rowyh cl b
(Array.length b
- 1) in
823 y + h
+ (if conf.presentation
then calcips h
else 0)
826 if Array.length b
> 0
828 let (_, _, y, (_, _, h
, _)) = b
.(Array.length b
- 1) in
829 y + h
+ (if conf.presentation
then calcips h
else 0)
832 if Array.length b
> 0
834 let (_, _, y, (_, _, h
, _)) = b
.(Array.length b
- 1) in
839 let getpageywh pageno
=
840 let pageno = bound
pageno 0 (state.pagecount
-1) in
841 match conf.columns
with
843 if Array.length b
= 0
846 let (_, _, y, (_, w
, h
, _)) = b
.(pageno) in
854 if Array.length b
= 0
857 let y, h
= rowyh cl b
pageno in
858 let (_, _, _, (_, w
, _, _)) = b
.(pageno) in
866 if Array.length b
= 0
870 let (_, _, y, (_, w
, h
, _)) = b
.(n) in
874 let getpageyh pageno =
875 let y,_,h
= getpageywh pageno in
879 let getpagedim pageno =
882 | (n, _, _, _) as pdim
:: rest
->
884 then (if n = pageno then pdim
else ppdim
)
889 f (-1, -1, -1, -1) state.pdims
892 let getpdimno pageno =
896 | (n, _, _, _) :: rest
->
898 then (if n = pageno then np else p
)
906 let getpagey pageno = fst
(getpageyh pageno);;
910 let coloff = l
.pagecol
* l
.pageh
in
911 float (l
.pagey
+ coloff) /. float l
.pageh
919 then float l
.pagedispy
/. float (calcips l
.pageh
)
920 else float l
.pagedispy
/. float conf.interpagespace
923 (l
.pageno, top, dtop)
927 match state.layout
with
928 | l
:: _ -> getanchor1 l
930 let n = page_of_y state.y in
934 let y, h
= getpageyh n in
935 let dy = y - state.y in
939 let ips = calcips h
in
940 float (dy + ips) /. float ips
942 float dy /. float conf.interpagespace
947 let fontpath = ref E.s;;
949 type historder
= [ `lastvisit
| `title
| `path
| `file
];;
952 Map.Make
(struct type t
= (int * int) let compare = compare end);;
955 let l = String.length
s in
956 let b = Buffer.create
l in
957 Parser.unent
b s 0 l;
962 try Sys.getenv
"HOME"
964 dolog
"cannot determine home directory location: %s" @@ exntos exn
;
968 let modifier_of_string = function
969 | "alt" -> Wsi.altmask
970 | "shift" -> Wsi.shiftmask
971 | "ctrl" | "control" -> Wsi.ctrlmask
972 | "meta" -> Wsi.metamask
976 let keys_of_string s =
977 let key_of_string r
s =
978 let elems = Str.full_split r
s in
981 let m1 = modifier_of_string s in
983 then (Wsi.namekey
s, m
)
986 | Str.Delim
s when n land 1 = 0 -> g s
988 | Str.Delim
_ -> (k
, m
)
990 let rec loop n k m
= function
993 let k, m
= f n k m x
in
998 let elems = Str.split whitere
s in
999 List.map
(key_of_string (Str.regexp
"-")) elems
1002 let config_of c attrs
=
1006 | "scroll-bar-width" -> { c
with scrollbw
= max
0 (int_of_string v
) }
1007 | "scroll-handle-height" -> { c
with scrollh
= max
0 (int_of_string v
) }
1008 | "case-insensitive-search" -> { c
with icase
= bool_of_string v
}
1009 | "preload" -> { c
with preload
= bool_of_string v
}
1010 | "page-bias" -> { c
with pagebias
= int_of_string v
}
1011 | "scroll-step" -> { c
with scrollstep
= max
1 (int_of_string v
) }
1012 | "horizontal-scroll-step" ->
1013 { c
with hscrollstep
= max
(int_of_string v
) 1 }
1014 | "auto-scroll-step" ->
1015 { c
with autoscrollstep
= max
0 (int_of_string v
) }
1016 | "max-height-fit" -> { c
with maxhfit
= bool_of_string v
}
1017 | "crop-hack" -> { c
with crophack
= bool_of_string v
}
1020 match String.map asciilower v
with
1021 | "true" -> Some infinity
1023 | f -> Some
(float_of_string
f)
1025 { c
with maxwait
= mw }
1026 | "highlight-links" -> { c
with hlinks
= bool_of_string v
}
1027 | "under-cursor-info" -> { c
with underinfo
= bool_of_string v
}
1028 | "vertical-margin" ->
1029 { c
with interpagespace
= max
0 (int_of_string v
) }
1031 let zoom = float_of_string v
/. 100. in
1032 let zoom = max
zoom 0.0 in
1033 { c
with zoom = zoom }
1034 | "presentation" -> { c
with presentation
= bool_of_string v
}
1035 | "rotation-angle" -> { c
with angle
= int_of_string v
}
1036 | "width" -> { c
with cwinw
= max
20 (int_of_string v
) }
1037 | "height" -> { c
with cwinh
= max
20 (int_of_string v
) }
1038 | "persistent-bookmarks" -> { c
with savebmarks
= bool_of_string v
}
1039 | "proportional-display" ->
1042 then FitProportional
1045 { c
with fitmodel
= fm }
1046 | "fit-model" -> { c
with fitmodel
= FMTE.of_string v
}
1047 | "pixmap-cache-size" ->
1048 { c
with memlimit
= max
2 (int_of_string_with_suffix v
) }
1049 | "tex-count" -> { c
with texcount
= max
1 (int_of_string v
) }
1050 | "slice-height" -> { c
with sliceheight
= max
2 (int_of_string v
) }
1051 | "thumbnail-width" -> { c
with thumbw
= max
2 (int_of_string v
) }
1052 | "persistent-location" -> { c
with jumpback
= bool_of_string v
}
1053 | "background-color" -> { c
with bgcolor
= color_of_string v
}
1054 | "scrollbar-color" -> { c
with sbarcolor
= rgba_of_string v
}
1055 | "scrollbar-handle-color" -> { c
with sbarhndlcolor
= rgba_of_string v
}
1056 | "tile-width" -> { c
with tilew
= max
2 (int_of_string v
) }
1057 | "tile-height" -> { c
with tileh
= max
2 (int_of_string v
) }
1058 | "mupdf-store-size" ->
1059 { c
with mustoresize
= max
1024 (int_of_string_with_suffix v
) }
1060 | "checkers" -> { c
with checkers
= bool_of_string v
}
1061 | "aalevel" -> { c
with aalevel
= max
0 (int_of_string v
) }
1062 | "trim-margins" -> { c
with trimmargins
= bool_of_string v
}
1063 | "trim-fuzz" -> { c
with trimfuzz
= irect_of_string v
}
1064 | "uri-launcher" -> { c
with urilauncher
= unentS v
}
1065 | "path-launcher" -> { c
with pathlauncher
= unentS v
}
1066 | "color-space" -> { c
with colorspace
= CSTE.of_string v
}
1067 | "invert-colors" -> { c
with invert
= bool_of_string v
}
1068 | "brightness" -> { c
with colorscale
= float_of_string v
}
1069 | "ghyllscroll" -> { c
with ghyllscroll
= ghyllscroll_of_string v
}
1071 let (n, _, _) as nab
= multicolumns_of_string v
in
1073 then { c
with columns
= Csplit
(-n, E.a
) }
1074 else { c
with columns
= Cmulti
(nab
, E.a
) }
1075 | "birds-eye-columns" ->
1076 { c
with beyecolumns
= Some
(max
(int_of_string v
) 2) }
1077 | "selection-command" -> { c
with selcmd
= unentS v
}
1078 | "synctex-command" -> { c
with stcmd
= unentS v
}
1079 | "pax-command" -> { c
with paxcmd
= unentS v
}
1080 | "askpass-command" -> { c
with passcmd
= unentS v
}
1081 | "savepath-command" -> { c
with savecmd
= unentS v
}
1082 | "update-cursor" -> { c
with updatecurs
= bool_of_string v
}
1083 | "hint-font-size" -> { c
with hfsize
= bound
(int_of_string v
) 5 100 }
1084 | "page-scroll-scale" -> { c
with pgscale
= float_of_string v
}
1085 | "use-pbo" -> { c
with usepbo
= bool_of_string v
}
1086 | "wheel-scrolls-pages" -> { c
with wheelbypage
= bool_of_string v
}
1087 | "horizontal-scrollbar-visible" ->
1090 then c
.scrollb
lor scrollbhv
1091 else c
.scrollb
land (lnot
scrollbhv)
1093 { c
with scrollb
= b }
1094 | "vertical-scrollbar-visible" ->
1097 then c
.scrollb
lor scrollbvv
1098 else c
.scrollb
land (lnot
scrollbvv)
1100 { c
with scrollb
= b }
1101 | "remote-in-a-new-instance" -> { c
with riani
= bool_of_string v
}
1107 | "point-and-x-mark" -> { c
with paxmark
= MTE.of_string v
}
1108 | "scroll-bar-on-the-left" -> { c
with leftscroll
= bool_of_string v
}
1109 | "title" -> { c
with title
= unentS v
}
1110 | "last-visit" -> { c
with lastvisit
= float_of_string v
}
1111 | "edit-annotations-inline" -> { c
with annotinline
= bool_of_string v
}
1112 | "coarse-presentation-positioning" ->
1113 { c
with coarseprespos
= bool_of_string v
}
1114 | "use-document-css" -> { c
with usedoccss
= bool_of_string v
}
1117 dolog
"error processing attribute (`%S' = `%S'): %s" k v
@@ exntos exn
;
1120 let rec fold c
= function
1123 let c = apply c k v
in
1126 fold { c with keyhashes
= copykeyhashes c } attrs
;
1129 let fromstring f pos
n v
d =
1132 dolog
"error processing attribute (%S=%S) at %d\n%s" n v pos
@@ exntos exn
;
1136 let bookmark_of attrs
=
1137 let rec fold title page rely visy
= function
1138 | ("title", v
) :: rest
-> fold v page rely visy rest
1139 | ("page", v
) :: rest
-> fold title v rely visy rest
1140 | ("rely", v
) :: rest
-> fold title page v visy rest
1141 | ("visy", v
) :: rest
-> fold title page rely v rest
1142 | _ :: rest
-> fold title page rely visy rest
1143 | [] -> title
, page
, rely
, visy
1145 fold "invalid" "0" "0" "0" attrs
1149 let rec fold path key page rely pan visy origin
= function
1150 | ("path", v
) :: rest
-> fold v key page rely pan visy origin rest
1151 | ("key", v
) :: rest
-> fold path v page rely pan visy origin rest
1152 | ("page", v
) :: rest
-> fold path key v rely pan visy origin rest
1153 | ("rely", v
) :: rest
-> fold path key page v pan visy origin rest
1154 | ("pan", v
) :: rest
-> fold path key page rely v visy origin rest
1155 | ("visy", v
) :: rest
-> fold path key page rely pan v origin rest
1156 | ("origin", v
) :: rest
-> fold path key page rely pan visy v rest
1157 | _ :: rest
-> fold path key page rely pan visy origin rest
1158 | [] -> path
, key
, page
, rely
, pan
, visy
, origin
1160 fold E.s E.s "0" "0" "0" "0" E.s attrs
1164 let rec fold rs ls
= function
1165 | ("out", v
) :: rest
-> fold v ls rest
1166 | ("in", v
) :: rest
-> fold rs v rest
1167 | _ :: rest
-> fold ls rs rest
1173 let setconf dst src
=
1174 dst
.scrollbw
<- src
.scrollbw
;
1175 dst
.scrollh
<- src
.scrollh
;
1176 dst
.icase
<- src
.icase
;
1177 dst
.preload
<- src
.preload
;
1178 dst
.pagebias
<- src
.pagebias
;
1179 dst
.verbose
<- src
.verbose
;
1180 dst
.scrollstep
<- src
.scrollstep
;
1181 dst
.maxhfit
<- src
.maxhfit
;
1182 dst
.crophack
<- src
.crophack
;
1183 dst
.autoscrollstep
<- src
.autoscrollstep
;
1184 dst
.maxwait
<- src
.maxwait
;
1185 dst
.hlinks
<- src
.hlinks
;
1186 dst
.underinfo
<- src
.underinfo
;
1187 dst
.interpagespace
<- src
.interpagespace
;
1188 dst
.zoom <- src
.zoom;
1189 dst
.presentation
<- src
.presentation
;
1190 dst
.angle
<- src
.angle
;
1191 dst
.cwinw
<- src
.cwinw
;
1192 dst
.cwinh
<- src
.cwinh
;
1193 dst
.savebmarks
<- src
.savebmarks
;
1194 dst
.memlimit
<- src
.memlimit
;
1195 dst
.fitmodel
<- src
.fitmodel
;
1196 dst
.texcount
<- src
.texcount
;
1197 dst
.sliceheight
<- src
.sliceheight
;
1198 dst
.thumbw
<- src
.thumbw
;
1199 dst
.jumpback
<- src
.jumpback
;
1200 dst
.bgcolor
<- src
.bgcolor
;
1201 dst
.tilew
<- src
.tilew
;
1202 dst
.tileh
<- src
.tileh
;
1203 dst
.mustoresize
<- src
.mustoresize
;
1204 dst
.checkers
<- src
.checkers
;
1205 dst
.aalevel
<- src
.aalevel
;
1206 dst
.trimmargins
<- src
.trimmargins
;
1207 dst
.trimfuzz
<- src
.trimfuzz
;
1208 dst
.urilauncher
<- src
.urilauncher
;
1209 dst
.colorspace
<- src
.colorspace
;
1210 dst
.invert
<- src
.invert
;
1211 dst
.colorscale
<- src
.colorscale
;
1212 dst
.ghyllscroll
<- src
.ghyllscroll
;
1213 dst
.columns
<- src
.columns
;
1214 dst
.beyecolumns
<- src
.beyecolumns
;
1215 dst
.selcmd
<- src
.selcmd
;
1216 dst
.updatecurs
<- src
.updatecurs
;
1217 dst
.pathlauncher
<- src
.pathlauncher
;
1218 dst
.keyhashes
<- copykeyhashes src
;
1219 dst
.hfsize
<- src
.hfsize
;
1220 dst
.hscrollstep
<- src
.hscrollstep
;
1221 dst
.pgscale
<- src
.pgscale
;
1222 dst
.usepbo
<- src
.usepbo
;
1223 dst
.wheelbypage
<- src
.wheelbypage
;
1224 dst
.stcmd
<- src
.stcmd
;
1225 dst
.paxcmd
<- src
.paxcmd
;
1226 dst
.passcmd
<- src
.passcmd
;
1227 dst
.savecmd
<- src
.savecmd
;
1228 dst
.scrollb
<- src
.scrollb
;
1229 dst
.riani
<- src
.riani
;
1230 dst
.paxmark
<- src
.paxmark
;
1231 dst
.leftscroll
<- src
.leftscroll
;
1232 dst
.title
<- src
.title
;
1233 dst
.annotinline
<- src
.annotinline
;
1234 dst
.coarseprespos
<- src
.coarseprespos
;
1236 dst
.usedoccss
<- src
.usedoccss
;
1237 dst
.sbarcolor
<- src
.sbarcolor
;
1238 dst
.sbarhndlcolor
<- src
.sbarhndlcolor
;
1246 let findkeyhash c name =
1247 try List.assoc
name c.keyhashes
1248 with Not_found
-> failwith
("invalid mode name `" ^
name ^
"'")
1253 let h = Hashtbl.create
10 in
1254 let dc = { defconf with angle
= defconf.angle
} in
1255 let rec toplevel v t spos
_ =
1257 | Vdata
| Vcdata
| Vend
-> v
1258 | Vopen
("llppconfig", _, closed
) ->
1261 else { v
with f = llppconfig
}
1262 | Vopen
_ -> parse_error
"unexpected subelement at top level" s spos
1263 | Vclose
_ -> parse_error
"unexpected close at top level" s spos
1265 and llppconfig v t spos
_ =
1267 | Vdata
| Vcdata
-> v
1268 | Vend
-> parse_error
"unexpected end of input in llppconfig" s spos
1269 | Vopen
("defaults", attrs
, closed
) ->
1270 let c = config_of dc attrs
in
1274 else { v
with f = defaults
}
1276 | Vopen
("ui-font", attrs
, closed
) ->
1277 let rec getsize size
= function
1279 | ("size", v
) :: rest
->
1281 fromstring int_of_string spos
"size" v
fstate.fontsize
in
1283 | l -> getsize size l
1285 fstate.fontsize
<- getsize fstate.fontsize attrs
;
1288 else { v
with f = uifont
(Buffer.create
10) }
1290 | Vopen
("doc", attrs
, closed
) ->
1291 let pathent, key
, spage
, srely
, span
, svisy
, origin
= doc_of attrs
in
1292 let path = unentS pathent
1293 and origin
= unentS origin
1294 and pageno = fromstring int_of_string spos
"page" spage
0
1295 and rely
= fromstring float_of_string spos
"rely" srely
0.0
1296 and pan
= fromstring int_of_string spos
"pan" span
0
1297 and visy
= fromstring float_of_string spos
"visy" svisy
0.0 in
1298 let c = config_of dc attrs
in
1300 let anchor = (pageno, rely
, visy
) in
1302 then (Hashtbl.add
h path (c, [], pan
, anchor, origin
); v
)
1303 else { v
with f = doc
path origin pan
anchor c [] }
1306 parse_error
"unexpected subelement in llppconfig" s spos
1308 | Vclose
"llppconfig" -> { v
with f = toplevel }
1309 | Vclose
_ -> parse_error
"unexpected close in llppconfig" s spos
1311 and defaults v t spos
_ =
1313 | Vdata
| Vcdata
-> v
1314 | Vend
-> parse_error
"unexpected end of input in defaults" s spos
1315 | Vopen
("keymap", attrs
, closed
) ->
1317 try List.assoc
"mode" attrs
1318 with Not_found
-> "global" in
1323 let h = findkeyhash dc modename in
1324 KeyMap.iter
(Hashtbl.replace
h) keymap
;
1327 { v
with f = pkeymap
ret KeyMap.empty
}
1329 | Vopen
(_, _, _) ->
1330 parse_error
"unexpected subelement in defaults" s spos
1332 | Vclose
"defaults" ->
1333 { v
with f = llppconfig
}
1335 | Vclose
_ -> parse_error
"unexpected close in defaults" s spos
1337 and uifont
b v t spos epos
=
1340 Buffer.add_substring
b s spos
(epos
- spos
);
1342 | Vopen
(_, _, _) ->
1343 parse_error
"unexpected subelement in ui-font" s spos
1344 | Vclose
"ui-font" ->
1345 if emptystr
!fontpath
1346 then fontpath := Buffer.contents
b;
1347 { v
with f = llppconfig
}
1348 | Vclose
_ -> parse_error
"unexpected close in ui-font" s spos
1349 | Vend
-> parse_error
"unexpected end of input in ui-font" s spos
1351 and doc
path origin pan
anchor c bookmarks v t spos
_ =
1353 | Vdata
| Vcdata
-> v
1354 | Vend
-> parse_error
"unexpected end of input in doc" s spos
1355 | Vopen
("bookmarks", _, closed
) ->
1358 else { v
with f = pbookmarks
path origin pan
anchor c bookmarks
}
1360 | Vopen
("keymap", attrs
, closed
) ->
1362 try List.assoc
"mode" attrs
1363 with Not_found
-> "global"
1369 let h = findkeyhash c modename in
1370 KeyMap.iter
(Hashtbl.replace
h) keymap
;
1371 doc
path origin pan
anchor c bookmarks
1373 { v
with f = pkeymap
ret KeyMap.empty
}
1375 | Vopen
("css", [], false) ->
1376 { v
with f = pcss
path origin pan
anchor c bookmarks
}
1378 | Vopen
(_, _, _) ->
1379 parse_error
"unexpected subelement in doc" s spos
1382 Hashtbl.add
h path (c, List.rev bookmarks
, pan
, anchor, origin
);
1383 { v
with f = llppconfig
}
1385 | Vclose
_ -> parse_error
"unexpected close in doc" s spos
1387 and pcss
path origin pan
anchor c bookmarks v t spos epos
=
1390 let b = Buffer.create
10 in
1391 Buffer.add_substring
b s spos
(epos
- spos
);
1392 { v
with f = pcss
path origin pan
anchor
1393 { c with css
= Buffer.contents
b }
1395 | Vend
-> parse_error
"unexpected end of input in css" s spos
1396 | Vopen
_ -> parse_error
"unexpected subelement in css" s spos
1397 | Vclose
"css" -> { v
with f = doc
path origin pan
anchor c bookmarks
}
1398 | Vclose
_ -> parse_error
"unexpected close in css" s spos
1400 and pkeymap
ret keymap v t spos
_ =
1402 | Vdata
| Vcdata
-> v
1403 | Vend
-> parse_error
"unexpected end of input in keymap" s spos
1404 | Vopen
("map", attrs
, closed
) ->
1405 let r, l = map_of attrs
in
1406 let kss = fromstring keys_of_string spos
"in" r [] in
1407 let lss = fromstring keys_of_string spos
"out" l [] in
1411 | ks
:: [] -> KeyMap.add ks
(KMinsrl
lss) keymap
1412 | ks
:: rest
-> KeyMap.add ks
(KMmulti
(rest
, lss)) keymap
1415 then { v
with f = pkeymap
ret keymap }
1418 { v
with f = skip
"map" f }
1421 parse_error
"unexpected subelement in keymap" s spos
1423 | Vclose
"keymap" ->
1424 { v
with f = ret keymap }
1426 | Vclose
_ -> parse_error
"unexpected close in keymap" s spos
1428 and pbookmarks
path origin pan
anchor c bookmarks v t spos
_ =
1430 | Vdata
| Vcdata
-> v
1431 | Vend
-> parse_error
"unexpected end of input in bookmarks" s spos
1432 | Vopen
("item", attrs
, closed
) ->
1433 let titleent, spage
, srely
, svisy
= bookmark_of attrs
in
1434 let page = fromstring int_of_string spos
"page" spage
0
1435 and rely
= fromstring float_of_string spos
"rely" srely
0.0
1436 and visy
= fromstring float_of_string spos
"visy" svisy
0.0 in
1438 (unentS titleent, 0, Oanchor
(page, rely
, visy
)) :: bookmarks
1441 then { v
with f = pbookmarks
path origin pan
anchor c bookmarks }
1444 { v
with f = skip
"item" f }
1447 parse_error
"unexpected subelement in bookmarks" s spos
1449 | Vclose
"bookmarks" ->
1450 { v
with f = doc
path origin pan
anchor c bookmarks }
1452 | Vclose
_ -> parse_error
"unexpected close in bookmarks" s spos
1454 and skip tag
f v t spos
_ =
1456 | Vdata
| Vcdata
-> v
1458 parse_error
("unexpected end of input in skipped " ^ tag
) s spos
1459 | Vopen
(tag'
, _, closed
) ->
1463 let f'
() = { v
with f = skip tag
f } in
1464 { v
with f = skip tag'
f'
}
1468 else parse_error
("unexpected close in skipped " ^ tag
) s spos
1471 parse
{ f = toplevel; accu
= () } s;
1475 let do_load f contents
=
1478 | Parser.Parse_error
(msg
, s, pos
) ->
1479 let subs = Parser.subs s pos
in
1480 Utils.error
"parse error: %s: at %d [..%S..]" msg pos
subs
1482 | exn
-> Utils.error
"parse error: %s" @@ exntos exn
1487 let xdgconfdir = Utils.getenvwithdef
"XDG_CONFIG_HOME" E.s in
1488 if emptystr
xdgconfdir
1491 let dir = Filename.concat
home ".config" in
1492 if Sys.is_directory
dir then dir else home
1496 Filename.concat
dir "llpp.conf"
1499 let confpath = ref defconfpath;;
1501 let load2 f default
=
1502 match filecontents
!confpath with
1503 | contents
-> f @@ do_load get contents
1504 | exception Unix.Unix_error
(Unix.ENOENT
, "open", _) ->
1505 f (Hashtbl.create
0, defconf)
1507 dolog
"error loading configuration from `%S': %s" !confpath @@ exntos exn
;
1511 let load1 f = load2 f false;;
1519 (fun path (conf, _, _, _, _) ((_, besttime
) as best
) ->
1520 if conf.lastvisit
> besttime
1521 then (path, conf.lastvisit
)
1524 (state.path, -.infinity
)
1528 let pc, pb
, px
, pa
, po
=
1529 let def = dc, [], 0, emptyanchor, state.origin
in
1530 if emptystr
state.path
1533 let absname = abspath
state.path in
1534 match Hashtbl.find h absname with
1536 | exception Not_found
->
1537 let exception E
of (conf * outline list
* int * anchor * string) in
1538 let key = try Digest.file
absname |> Digest.to_hex
with _ -> E.s in
1543 Hashtbl.iter
(fun p
((c, _, _, _, _) as v
) ->
1546 dolog
"will use %s's settings due to matching keys" p
;
1553 | exception E v
-> v
1557 state.bookmarks <- pb
;
1561 then state.anchor <- pa
;
1562 cbput state.hists
.nav pa
;
1570 Hashtbl.fold (fun path (pc, pb
, px
, pa
, po
) accu
->
1571 (path, pc, pb
, px
, pa
, po
) :: accu
)
1577 let add_attrs bb always
dc c time
=
1579 Buffer.add_string bb
"\n ";
1580 Printf.bprintf bb fmt
s
1582 let o c fmt
s = if c then o' fmt
s else ignore
in
1583 let ob s a
b = o (always
|| a
!= b) "%s='%b'" s a
1584 and op
s a
b = o (always
|| a
<> b) "%s='%b'" s (a
!= None
)
1585 and oi
s a
b = o (always
|| a
!= b) "%s='%d'" s a
1586 and oI
s a
b = o (always
|| a
!= b) "%s='%s'" s (string_with_suffix_of_int a
)
1587 and oz
s a
b = o (always
|| a
<> b) "%s='%g'" s (a
*.100.)
1588 and oF
s a
b = o (always
|| a
<> b) "%s='%f'" s a
1589 and oL
s a
b = o (always
|| a
<> b) "%s='%Ld'" s a
1590 and oc
s a
b = o (always
|| a
<> b) "%s='%s'" s (color_to_string a
)
1591 and oA
s a
b = o (always
|| a
<> b) "%s='%s'" s (rgba_to_string a
)
1592 and oC
s a
b = o (always
|| a
<> b) "%s='%s'" s (CSTE.to_string a
)
1593 and oR
s a
b = o (always
|| a
<> b) "%s='%s'" s (irect_to_string a
)
1594 and oFm
s a
b = o (always
|| a
<> b) "%s='%s'" s (FMTE.to_string a
)
1596 o (always
|| a
land m
<> b land m
) "%s='%b'" s (a
land m
!= 0)
1597 and oPm
s a
b = o (always
|| a
<> b) "%s='%s'" s (MTE.to_string a
)
1599 o (always
|| a
<> b) "%s='%s'" s @@ Parser.enent a
0 (String.length a
)
1604 | Some
(_N
, _A
, _B
) -> o'
"%s='%u,%u,%u'" s _N _A _B
1608 | _ -> o'
"%s='none'" s
1618 else string_of_float
f
1625 | Cmulti
((n, a
, b), _) when n > 1 -> o'
"%s='%d,%d,%d'" s n a
b
1626 | Csplit
(n, _) when n > 1 -> o'
"%s='%d'" s ~
-n
1627 | Cmulti
_ | Csplit
_ | Csingle
_ -> ()
1632 | Some
c when c > 1 -> o'
"%s='%d'" s c
1635 oi
"width" c.cwinw
dc.cwinw
;
1636 oi
"height" c.cwinh
dc.cwinh
;
1637 oi
"scroll-bar-width" c.scrollbw
dc.scrollbw
;
1638 oi
"scroll-handle-height" c.scrollh
dc.scrollh
;
1639 oSv
"horizontal-scrollbar-visible" c.scrollb
dc.scrollb
scrollbhv;
1640 oSv
"vertical-scrollbar-visible" c.scrollb
dc.scrollb
scrollbvv;
1641 ob "case-insensitive-search" c.icase
dc.icase
;
1642 ob "preload" c.preload
dc.preload
;
1643 oi
"page-bias" c.pagebias
dc.pagebias
;
1644 oi
"scroll-step" c.scrollstep
dc.scrollstep
;
1645 oi
"auto-scroll-step" c.autoscrollstep
dc.autoscrollstep
;
1646 ob "max-height-fit" c.maxhfit
dc.maxhfit
;
1647 ob "crop-hack" c.crophack
dc.crophack
;
1648 oW
"throttle" c.maxwait
dc.maxwait
;
1649 ob "highlight-links" c.hlinks
dc.hlinks
;
1650 ob "under-cursor-info" c.underinfo
dc.underinfo
;
1651 oi
"vertical-margin" c.interpagespace
dc.interpagespace
;
1652 oz
"zoom" c.zoom dc.zoom;
1653 ob "presentation" c.presentation
dc.presentation
;
1654 oi
"rotation-angle" c.angle
dc.angle
;
1655 ob "persistent-bookmarks" c.savebmarks
dc.savebmarks
;
1656 oFm
"fit-model" c.fitmodel
dc.fitmodel
;
1657 oI
"pixmap-cache-size" c.memlimit
dc.memlimit
;
1658 oi
"tex-count" c.texcount
dc.texcount
;
1659 oi
"slice-height" c.sliceheight
dc.sliceheight
;
1660 oi
"thumbnail-width" c.thumbw
dc.thumbw
;
1661 ob "persistent-location" c.jumpback
dc.jumpback
;
1662 oc
"background-color" c.bgcolor
dc.bgcolor
;
1663 oA
"scrollbar-color" c.sbarcolor
dc.sbarcolor
;
1664 oA
"scrollbar-handle-color" c.sbarhndlcolor
dc.sbarhndlcolor
;
1665 oi
"tile-width" c.tilew
dc.tilew
;
1666 oi
"tile-height" c.tileh
dc.tileh
;
1667 oI
"mupdf-store-size" c.mustoresize
dc.mustoresize
;
1668 ob "checkers" c.checkers
dc.checkers
;
1669 oi
"aalevel" c.aalevel
dc.aalevel
;
1670 ob "trim-margins" c.trimmargins
dc.trimmargins
;
1671 oR
"trim-fuzz" c.trimfuzz
dc.trimfuzz
;
1672 os
"uri-launcher" c.urilauncher
dc.urilauncher
;
1673 os
"path-launcher" c.pathlauncher
dc.pathlauncher
;
1674 oC
"color-space" c.colorspace
dc.colorspace
;
1675 ob "invert-colors" c.invert
dc.invert
;
1676 oF
"brightness" c.colorscale
dc.colorscale
;
1677 og
"ghyllscroll" c.ghyllscroll
dc.ghyllscroll
;
1678 oco
"columns" c.columns
dc.columns
;
1679 obeco
"birds-eye-columns" c.beyecolumns
dc.beyecolumns
;
1680 os
"selection-command" c.selcmd
dc.selcmd
;
1681 os
"synctex-command" c.stcmd
dc.stcmd
;
1682 os
"pax-command" c.paxcmd
dc.paxcmd
;
1683 os
"askpass-command" c.passcmd
dc.passcmd
;
1684 os
"savepath-command" c.savecmd
dc.savecmd
;
1685 ob "update-cursor" c.updatecurs
dc.updatecurs
;
1686 oi
"hint-font-size" c.hfsize
dc.hfsize
;
1687 oi
"horizontal-scroll-step" c.hscrollstep
dc.hscrollstep
;
1688 oF
"page-scroll-scale" c.pgscale
dc.pgscale
;
1689 ob "use-pbo" c.usepbo
dc.usepbo
;
1690 ob "wheel-scrolls-pages" c.wheelbypage
dc.wheelbypage
;
1691 ob "remote-in-a-new-instance" c.riani
dc.riani
;
1692 op
"point-and-x" c.pax
dc.pax
;
1693 oPm
"point-and-x-mark" c.paxmark
dc.paxmark
;
1694 ob "scroll-bar-on-the-left" c.leftscroll
dc.leftscroll
;
1696 then os
"title" c.title
dc.title
;
1697 oL
"last-visit" (Int64.of_float time
) 0L;
1698 ob "edit-annotations-inline" c.annotinline
dc.annotinline
;
1699 ob "coarse-presentation-positioning" c.coarseprespos
dc.coarseprespos
;
1700 ob "use-document-css" c.usedoccss
dc.usedoccss
;
1703 let keymapsbuf always
dc c =
1705 let bb = create
16 in
1706 let rec loop = function
1708 | (modename, h) :: rest
->
1709 let dh = findkeyhash dc modename in
1710 if always
|| h <> dh
1712 if Hashtbl.length
h > 0
1714 if length
bb > 0 then add_char
bb '
\n'
;
1715 Printf.bprintf
bb "<keymap mode='%s'>\n" modename;
1716 Hashtbl.iter
(fun i
o ->
1717 if always
|| match Hashtbl.find dh i
1718 with | dO
-> dO
<> o | exception Not_found
-> false
1721 if Wsi.withctrl m
then add_string
bb "ctrl-";
1722 if Wsi.withalt m
then add_string
bb "alt-";
1723 if Wsi.withshift m
then add_string
bb "shift-";
1724 if Wsi.withmeta m
then add_string
bb "meta-";
1725 add_string
bb (Wsi.keyname
k);
1728 let rec loop = function
1730 | km
:: [] -> addkm km
1731 | km
:: rest
-> addkm km
; add_char
bb ' '
; loop rest
1735 add_string
bb "<map in='";
1739 add_string
bb "' out='"; addkm km
; add_string
bb "'/>\n"
1742 add_string
bb "' out='"; addkms kms
; add_string
bb "'/>\n"
1744 | KMmulti
(ins
, kms
) ->
1745 add_char
bb ' '
; addkms ins
; add_string
bb "' out='";
1746 addkms kms
; add_string
bb "'/>\n"
1748 add_string
bb "</keymap>";
1757 let keystostrlist c =
1758 let rec loop accu
= function
1760 | (modename, h) :: rest
->
1762 if Hashtbl.length
h > 0
1764 let accu = Printf.sprintf
"\xc2\xb7Keys for %s" modename :: accu in
1765 Hashtbl.fold (fun i
o a
->
1766 let bb = Buffer.create
10 in
1768 if Wsi.withctrl m
then Buffer.add_string
bb "ctrl-";
1769 if Wsi.withalt m
then Buffer.add_string
bb "alt-";
1770 if Wsi.withshift m
then Buffer.add_string
bb "shift-";
1771 if Wsi.withmeta m
then Buffer.add_string
bb "meta-";
1772 Buffer.add_string
bb (Wsi.keyname
k);
1775 let rec loop = function
1777 | km
:: [] -> addkm km
1779 addkm km
; Buffer.add_char
bb ' '
;
1785 Buffer.add_char
bb '
\t'
;
1793 | KMmulti
(ins
, kms
) ->
1794 Buffer.add_char
bb ' '
;
1796 Buffer.add_string
bb "\t";
1799 Buffer.contents
bb :: a
1809 let save1 bb leavebirdseye x
h dc =
1810 let uifontsize = fstate.fontsize
in
1811 let dc = if conf.bedefault
then conf else dc in
1812 Buffer.add_string
bb "<llppconfig>\n";
1814 if nonemptystr
!fontpath
1816 Printf.bprintf
bb "<ui-font size='%d'><![CDATA[%s]]></ui-font>\n"
1822 Printf.bprintf
bb "<ui-font size='%d'/>\n" uifontsize
1825 Buffer.add_string
bb "<defaults";
1826 add_attrs bb true dc dc nan
;
1827 let kb = keymapsbuf true dc dc in
1828 if Buffer.length
kb > 0
1830 Buffer.add_string
bb ">\n";
1831 Buffer.add_buffer
bb kb;
1832 Buffer.add_string
bb "\n</defaults>\n";
1834 else Buffer.add_string
bb "/>\n";
1836 let adddoc path pan
anchor c bookmarks time origin
=
1837 if bookmarks == [] && c = dc && anchor = emptyanchor
1840 Printf.bprintf
bb "<doc path='%s'"
1841 (Parser.enent
path 0 (String.length
path));
1843 if nonemptystr
c.key
1845 Printf.bprintf
bb "\n key='%s'" c.key;
1847 if nonemptystr origin
1848 then Printf.bprintf
bb "\n origin='%s'"
1849 (Parser.enent origin
0 (String.length origin
));
1851 if anchor <> emptyanchor
1853 let n, rely
, visy
= anchor in
1854 Printf.bprintf
bb "\n page='%d'" n;
1857 then Printf.bprintf
bb " rely='%f'" rely
;
1859 if abs_float visy
> 1e-6
1860 then Printf.bprintf
bb " visy='%f'" visy
;
1864 then Printf.bprintf
bb " pan='%d'" pan
;
1866 add_attrs bb false dc c time
;
1867 if nonemptystr
c.css
1868 then Printf.bprintf
bb ">\n <css><![CDATA[%s]]></css>" c.css
;
1869 let kb = keymapsbuf false dc c in
1871 begin match bookmarks with
1873 if Buffer.length
kb > 0
1875 Buffer.add_string
bb ">\n";
1876 Buffer.add_buffer
bb kb;
1877 Buffer.add_string
bb "\n</doc>\n";
1880 if nonemptystr
c.css
1881 then Buffer.add_string
bb "\n</doc>\n"
1882 else Buffer.add_string
bb "/>\n"
1884 Buffer.add_string
bb ">\n<bookmarks>\n";
1885 List.iter
(fun (title
, _, kind
) ->
1886 begin match kind
with
1887 | Oanchor
(page, rely
, visy
) ->
1889 "<item title='%s' page='%d'"
1890 (Parser.enent title
0 (String.length title
))
1895 Printf.bprintf
bb " rely='%f'" rely
1897 if abs_float visy
> 1e-6
1899 Printf.bprintf
bb " visy='%f'" visy
1901 | Ohistory
_ | Onone
| Ouri
_ | Oremote
_
1902 | Oremotedest
_ | Olaunch
_ ->
1903 failwith
"unexpected link in bookmarks"
1905 Buffer.add_string
bb "/>\n";
1907 Buffer.add_string
bb "</bookmarks>";
1908 if Buffer.length
kb > 0
1910 Buffer.add_string
bb "\n";
1911 Buffer.add_buffer
bb kb;
1913 Buffer.add_string
bb "\n</doc>\n";
1919 match state.mode
with
1920 | Birdseye
(c, pan, _, _, _) ->
1922 match conf.columns
with
1923 | Cmulti
((c, _, _), _) -> Some
c
1927 match c.columns
with
1928 | Cmulti
(c, _) -> Cmulti
(c, E.a
)
1929 | Csingle
_ -> Csingle
E.a
1930 | Csplit
_ -> failwith
"quit from bird's eye while split"
1932 pan, { c with beyecolumns = beyecolumns; columns
= columns
}
1935 | LinkNav
_ -> x
, conf
1937 let docpath = if nonemptystr
state.path then abspath
state.path else E.s in
1938 if nonemptystr
docpath
1940 adddoc docpath pan (getanchor ())
1942 let autoscrollstep =
1943 match state.autoscroll
with
1945 | None
-> conf.autoscrollstep
1947 begin match state.mode
with
1948 | Birdseye beye
-> leavebirdseye beye
true
1954 try Digest.file
docpath |> Digest.to_hex
1957 { conf with autoscrollstep; key }
1959 (if conf.savebmarks
then state.bookmarks else [])
1963 Hashtbl.iter
(fun path (c, bookmarks, x
, anchor, origin
) ->
1964 if docpath <> abspath
path
1965 then adddoc path x
anchor c bookmarks c.lastvisit origin
1967 Buffer.add_string
bb "</llppconfig>\n";
1971 let save leavebirdseye
=
1972 let relx = float state.x
/. float state.winw
in
1974 let cx w = truncate
(relx *. float w) in
1976 (fun (w, h, x
) ws
->
1978 | Wsi.Fullscreen
-> (conf.cwinw
, conf.cwinh
, cx conf.cwinw
)
1979 | Wsi.MaxVert
-> (w, conf.cwinh
, x
)
1980 | Wsi.MaxHorz
-> (conf.cwinw
, h, cx conf.cwinw
)
1982 (state.winw
, state.winh
, state.x
) state.winstate
1986 let bb = Buffer.create
32768 in
1988 save1 bb leavebirdseye x
h dc
1990 if load1 save2 && Buffer.length
bb > 0
1993 let tmp = !confpath ^
".tmp" in
1994 let oc = open_out_bin
tmp in
1995 Buffer.output_buffer
oc bb;
1997 Unix.rename
tmp !confpath;
1999 dolog
"error saving configuration: %s" @@ exntos exn
2003 let href = ref @@ Hashtbl.create
0 in
2004 let cref = ref defconf in
2007 if Sys.file_exists
path
2009 else (dolog
"removing %s" path; None
) in
2010 Hashtbl.filter_map_inplace
f h;
2015 ignore
(load1 push);
2016 let bb = Buffer.create
32768 in
2017 let save2 (_h
, dc) = save1 bb (fun _ _ -> ()) 0 !href dc in
2018 if load1 save2 && Buffer.length
bb > 0
2021 let tmp = !confpath ^
".tmp" in
2022 let oc = open_out_bin
tmp in
2023 Buffer.output_buffer
oc bb;
2025 Unix.rename
tmp !confpath;
2027 dolog
"error saving configuration: %s" @@ exntos exn
2031 let logcurrently = function
2032 | Idle
-> dolog
"Idle"
2033 | Loading
(l, gen
) ->
2034 dolog
"Loading %d gen=%d curgen=%d" l.pageno gen
state.gen
2035 | Tiling
(l, pageopaque
, colorspace
, angle
, gen
, col
, row
, tilew
, tileh
) ->
2037 "Tiling %d[%d,%d] page=%s cs=%s angle=%d"
2038 l.pageno col row
(~
> pageopaque
)
2039 (CSTE.to_string colorspace
) angle
;
2040 dolog
"gen=(%d,%d) (%d,%d) tile=(%d,%d) (%d,%d)"
2041 angle gen
conf.angle
state.gen
2043 conf.tilew
conf.tileh
;