1493 lines · 46.0 KB · OCaml
RawDownload
open Utils let irect_of_string s =  Scanf.sscanf s "%d/%d/%d/%d" (fun x0 y0 x1 y1 -> (x0,y0,x1,y1)) let irect_to_string (x0,y0,x1,y1) = Printf.sprintf "%d/%d/%d/%d" x0 y0 x1 y1 let multicolumns_to_string (n, a, b) =  if a = 0 && b = 0  then Printf.sprintf "%d" n  else Printf.sprintf "%d,%d,%d" n a b let multicolumns_of_string s =  try    (int_of_string s, 0, 0)  with _ ->    Scanf.sscanf s "%u,%u,%u" (fun n a b ->        if a > 1 || b > 1        then error "subtly broken";        (n, a, b)      ) include Confstruct type angle         = intand opaque         = Opaque.tand rectcolor      = rgbaand pixmapsize     = intand gen            = intand top            = floatand dtop           = floatand fontpath       = stringand trimmargins    = booland trimparams     = (trimmargins * irect)and uri            = stringand caption        = stringand tilex          = intand tiley          = intand tileparams     = (x * y * w * h * tilex * tiley)and under =  | Unone  | Ulinkuri of string  | Utext of facename  | Utextannot of (opaque * slinkindex)  | Ufileannot of (opaque * slinkindex)and slinkindex = intand facename = stringand launchcommand = stringand filename = stringand linkno = intand destname = stringand link =  | Lnotfound  | Lfound of intand linkdir =  | LDfirst  | LDlast  | LDfirstvisible of (int * int * int)  | LDleft of int  | LDright of int  | LDdown of int  | LDup of intand pagewithlinks =  | Pwlnotfound  | Pwl of intand anchor = pageno * top * dtopand rect = float * float * float * float * float * float * float * floatand infochange = | Memused | Docinfo | Pdimand redirstderr = booland fontstate =  { mutable fontsize : int  ; mutable wwidth : float  ; mutable maxrows : int  } let fstate =  { fontsize = Wsi.fontsizescale 20  ; wwidth = nan  ; maxrows = -1  } class type uioh =  object    method display : unit    method key : int -> int -> uioh    method button : int -> bool -> int -> int -> int -> uioh    method multiclick : int -> int -> int -> int -> uioh    method motion : int -> int -> uioh    method pmotion : int -> int -> uioh    method infochanged : infochange -> unit    method scrollpw : (int * float * float)    method scrollph : (int * float * float)    method modehash : keyhash    method eformsgs : bool    method alwaysscrolly : bool    method scroll : int -> int -> uioh    method zoom : float -> int -> int -> unit  end module type TextEnumType = sig  type t  val name : string  val names : string arrayend module TextEnumMake (Ten : TextEnumType) = struct  let names = Ten.names  let to_int (t : Ten.t) = Obj.magic t  let to_string t = names.(to_int t)  let of_int n : Ten.t = Obj.magic n  let of_string s =    let rec find i =      if i = Array.length names      then error "invalid %s: %s" Ten.name s      else (        if Ten.names.(i) = s        then of_int i        else find (i+1)      )    in find 0end module CSTE = TextEnumMake (struct                  type t = colorspace                  let name = "colorspace"                  let names = [|"rgb"; "gray"|]                end) module MTE = TextEnumMake (struct                 type t = mark                 let name = "mark"                 let names = [|"page"; "block"; "line"; "word"|]               end) module FMTE = TextEnumMake (struct                  type t = fitmodel                  let name = "fitmodel"                  let names = [|"width"; "proportional"; "page"|]                end) type outlinekind =  | Onone  | Oanchor of anchor  | Ouri of uri  | Olaunch of launchcommand  | Oremote of (filename * pageno)  | Oremotedest of (filename * destname)  | Ohistory of (filename * conf * outline list * x * anchor * filename)and outline = (caption * outlinelevel * outlinekind)and outlinelevel = int type page =  { pageno    : int  ; pagedimno : int  ; pagew     : int  ; pageh     : int  ; pagex     : int  ; pagey     : int  ; pagevw    : int  ; pagevh    : int  ; pagedispx : int  ; pagedispy : int  ; pagecol   : int  } type tile = opaque * pixmapsize * elapsedand elapsed = floatand pagemapkey = pageno * genand tilemapkey = pageno * gen * colorspace * angle * w * h * col * rowand row = intand col = intand currently =  | Idle  | Loading of (page * gen)  | Tiling    of (page * opaque * colorspace * angle * gen * col * row * w * h)  | Outlining of outline listand mpos = int * intand mstate =  | Mnone  | Msel of (mpos * mpos)  | Mpan of mpos  | Mscrolly | Mscrollx  | Mzoom of (buttonno * step * mpos)  | Mzoomrect of (mpos * mpos)and buttonno = intand step = intand mode =  | View  | Birdseye of (conf * leftx * pageno * pageno * anchor)  | Textentry of (textentry * onleave)  | LinkNav of linktargetand onleave = leavetextentrystatus -> unitand leavetextentrystatus = | Cancel | Confirmand helpitem = string * int * actionand action = (uioh -> uioh) optionand linktarget =  | Ltexact of (pageno * direction)  | Ltgendir of direction  | Ltnotready of (pageno * direction)and direction = int             (* -1, 0, 1 *)and textentry = string * string * onhist option * onkey * ondone * cancelonemptyand onkey = string -> Keys.t -> teand ondone = string -> unitand histcancel = unit -> unitand onhist = ((histcmd -> string) * histcancel)and histcmd = HCnext | HCprev | HCfirst | HClastand cancelonempty = booland te =  | TEstop  | TEdone of string  | TEcont of string  | TEswitch of textentryand 'a circbuf =  { store : 'a array  ; mutable rc : int  ; mutable wc : int  ; mutable len : int  }and 'a nav =  { past   : 'a list  ; future : 'a list  } let emptykeyhash = Hashtbl.create 0let noreprf () = ()let noroamf () = () let nouioh : uioh =  object (self)    method display = ()    method key _ _ = self    method multiclick _ _ _ _ = self    method button _ _ _ _ _ = self    method motion _ _ = self    method pmotion _ _ = self    method infochanged _ = ()    method scrollpw = (0, nan, nan)    method scrollph = (0, nan, nan)    method modehash = emptykeyhash    method eformsgs = false    method alwaysscrolly = false    method scroll _ _ = self    method zoom _ _ _ = ()  end let cbnew n v =  { store = Array.make n v  ; rc = 0  ; wc = 0  ; len = 0  } let cbcap b = Array.length b.store let cbput ?(update_rc=true) b v  =  let cap = cbcap b in  b.store.(b.wc) <- v;  b.wc <- (b.wc + 1) mod cap;  if update_rc  then b.rc <- b.wc;  b.len <- min (b.len + 1) cap let cbput_dont_update_rc b v = cbput ~update_rc:false b v let cbempty b = b.len = 0 let cbgetg b circular dir =  if cbempty b  then b.store.(0)  else    let rc = b.rc + dir in    let rc =      if circular      then (        if rc = -1        then b.len-1        else (          if rc >= b.len          then 0          else rc        )      )      else bound rc 0 (b.len-1)    in    b.rc <- rc;    b.store.(rc) let cbget b = cbgetg b falselet cbgetc b = cbgetg b true type hists =  { pat : string circbuf  ; pag : string circbuf  ; sel : string circbuf  } let home =  try Sys.getenv "HOME"  with exn ->    dolog "cannot determine home directory location: %s" @@ exntos exn;    E.s module S = struct  let confpath = ref E.s  let ss = ref Unix.stdin  let wsfd = ref Unix.stdin  let stderr = ref Unix.stdin  let selfexec = ref E.s  let ignoredoctitlte = ref false  let errmsgs = Buffer.create 0  let newerrmsgs = ref false  let w = ref max_int  let x = ref max_int  let y = ref max_int  let xf = ref 0.0  let yf = ref 0.0  let anchor = ref E.j  let ranchors : (string * string * string * anchor * string) list ref = ref []  let maxy = ref max_int  let layout : page list ref = ref []  let pagemap : (pagemapkey, opaque) Hashtbl.t = Hashtbl.create 0  let tilemap : (tilemapkey, tile) Hashtbl.t = Hashtbl.create 0  let pdims : (pageno * w * h * leftx) list ref = ref []  let pagecount = ref max_int  let currently = ref Idle  let mstate = ref Mnone  let searchpattern = ref E.s  let rects : (pageno * rectcolor * rect) list ref = ref []  let rects1 : (pageno * rectcolor * rect) list ref = ref []  let text = ref E.s  let path = ref E.s  let password = ref E.s  let mimetype = ref E.s  let nameddest = ref E.s  let origin = ref E.s  let winstate : Wsi.winstate list ref = ref []  let mode : mode ref = ref View  let uioh : uioh ref = ref nouioh  let outlines : outline array ref = ref [||]  let bookmarks : outline list ref = ref []  let geomcmds : (string * ((string * (unit -> unit)) list)) ref    = ref (E.s, [])  let memused : memsize ref = ref 0  let gen : gen ref = ref 0  let autoscroll : int option ref = ref None  let help : helpitem array ref = ref E.a  let docinfo : (int * string) list ref = ref []  let hists : hists ref    = ref { pat = cbnew 10 E.s; pag = cbnew 10 E.s; sel = cbnew 10 E.s; }  let prevzoom = ref (1.0, 0)  let progress = ref ~-.1.0  let mpos = ref (-1, -1)  let keystate = ref KSnone  let glinks = ref false  let prevcolumns : (columns * zoom) option ref = ref None  let winw = ref ~-1  let winh = ref ~-1  let reprf = ref noreprf  let roamf = ref noroamf  let bzoom = ref false  let lnava : (pageno * linkno) option ref = ref None  let reload : (x * y * float) option ref = ref None  let nav : anchor nav ref = ref { past = []; future  = []; }  let tilelru : (tilemapkey * opaque * pixmapsize) Queue.t = Queue.create ()  let fontpath = ref E.s  let redirstderr = ref falseend let conf = { defconf with keyhashes = copykeyhashes defconf } let calcips h =  let d = !S.winh - h in  max conf.interpagespace ((d + 1) / 2) let rowyh (c, coverA, coverB) b n =  if c = 1 || (n < coverA || n >= !S.pagecount - coverB)  then    let _, _, vy, (_, _, h, _) = b.(n) in    (vy, h)  else    let n' = n - coverA in    let d = n' mod c in    let s = n - d in    let e = min !S.pagecount (s + c) in    let rec findminmax m miny maxh =      if m = e      then miny, maxh      else        let _, _, y, (_, _, h, _) = b.(m) in        let miny = min miny y in        let maxh = max maxh h in        findminmax (m+1) miny maxh    in    findminmax s max_int 0 let page_of_y y =  let ((c, coverA, coverB) as cl), b =    match conf.columns with    | Csplit (_, b) | Csingle b -> (1, 0, 0), b    | Cmulti (c, b) -> c, b  in  if Array.length b = 0  then -1  else    let rec bsearch nmin nmax =      if nmin > nmax      then bound nmin 0 (!S.pagecount-1)      else        let n = (nmax + nmin) / 2 in        let vy, h = rowyh cl b n in        let y0, y1 =          if conf.presentation          then            let ips = calcips h in            let y0 = vy - ips in            let y1 = vy + h + ips in            y0, y1          else (            if n = 0            then 0, vy + h + conf.interpagespace            else              let y0 = vy - conf.interpagespace in              y0, y0 + h + conf.interpagespace          )        in        if y >= y0 && y < y1        then (          if c = 1          then n          else (            if n > coverA            then              if n < !S.pagecount - coverB              then ((n-coverA)/c)*c + coverA              else n            else n          )        )        else (          if y > y0          then bsearch (n+1) nmax          else bsearch nmin (n-1)        )    in    bsearch 0 (!S.pagecount-1) let calcheight () =  match conf.columns with  | Cmulti ((_, _, _) as cl, b) ->     if Array.length b > 0     then       let y, h = rowyh cl b (Array.length b - 1) in       y + h + (if conf.presentation then calcips h else 0)     else 0  | Csingle b ->     if Array.length b > 0     then       let (_, _, y, (_, _, h, _)) = b.(Array.length b - 1) in       y + h + (if conf.presentation then calcips h else 0)     else 0  | Csplit (_, b) ->     if Array.length b > 0     then       let (_, _, y, (_, _, h, _)) = b.(Array.length b - 1) in       y + h     else 0 let getpageywh pageno =  let pageno = bound pageno 0 (!S.pagecount-1) in  match conf.columns with  | Csingle b ->     if Array.length b = 0     then 0, 0, 0     else       let (_, _, y, (_, w, h, _)) = b.(pageno) in       let y =         if conf.presentation         then y - calcips h         else y       in       y, w, h  | Cmulti (cl, b) ->     if Array.length b = 0     then 0, 0, 0     else       let y, h = rowyh cl b pageno in       let (_, _, _, (_, w, _, _)) = b.(pageno) in       let y =         if conf.presentation         then y - calcips h         else y       in       y, w, h  | Csplit (c, b) ->     if Array.length b = 0     then 0, 0, 0     else       let n = pageno*c in       let (_, _, y, (_, w, h, _)) = b.(n) in

Lines 1–500 of 1493.

Keyboard shortcuts

General

Show keyboard shortcuts
?
Focus the current search
/

Issues and pull requests

Open filters
f

Issues, pull requests and Inbox

Select next item
j↓
Select previous item
k↑
Open selected item
Enter
Dismiss filters or clear selection
Esc

Repository code

Go to file
t