From 4ce5e3c86c6555668094410610d6be62be140822 Mon Sep 17 00:00:00 2001
From: malc <av1474@comtv.ru>
Date: Thu, 8 Jan 2015 07:12:50 +0300
Subject: [PATCH] Keyboard navigation/hints for annotations

---
 link.c  | 144 +++++++-----
 main.ml | 782 ++++++++++++++++++++++++++++++++--------------------------------
 2 files changed, 477 insertions(+), 449 deletions(-)

diff --git a/link.c b/link.c
index f46f971..c07e387 100644
--- a/link.c
+++ b/link.c
@@ -163,8 +163,12 @@ struct pagedim {
 };
 
 struct slink  {
+    enum { SLINK, SANNOT } tag;
     fz_irect bbox;
-    fz_link *link;
+    union {
+        fz_link *link;
+        pdf_annot *annot;
+    } u;
 };
 
 struct annot  {
@@ -1564,8 +1568,7 @@ static char *strofspan (fz_text_span *span)
     return p;
 }
 
-static int matchspan (regex_t *re, fz_text_page UNUSED_ATTR *page,
-                      fz_text_span *span, fz_matrix UNUSED_ATTR ctm,
+static int matchspan (regex_t *re, fz_text_span *span,
                       int stop, int pageno, double start)
 {
     int ret;
@@ -1752,8 +1755,7 @@ static void search (regex_t *re, int pageno, int y, int forward)
                 }
 
                 for (span = line->first_span; span; span = span->next) {
-                    switch (matchspan (re, text, span, ctm,
-                                       stop, pageno, start)) {
+                    switch (matchspan (re, span, stop, pageno, start)) {
                     case 0: break;
                     case 1: stop = 1; break;
                     case -1: stop = 1; goto endloop;
@@ -2497,125 +2499,140 @@ static void droptext (struct page *page)
     }
 }
 
-static void dropslinks (struct page *page)
+static void dropanots (struct page *page)
 {
-    if (page->slinks) {
-        free (page->slinks);
-        page->slinks = NULL;
-        page->slinkcount = 0;
+    if (page->annots) {
+        free (page->annots);
+        page->annots = NULL;
+        page->annotcount = 0;
     }
 }
 
-static void ensureslinks (struct page *page)
+static void ensureanots (struct page *page)
 {
     fz_matrix ctm;
     int i, count = 0;
-    size_t slinksize = sizeof (*page->slinks);
-    fz_link *link, *links;
+    size_t anotsize = sizeof (*page->annots);
+    pdf_annot *annot;
 
     if (state.gen != page->sgen) {
-        dropslinks (page);
+        dropanots (page);
         page->sgen = state.gen;
     }
-    if (page->slinks) return;
+    if (page->annots) return;
 
     switch (page->type) {
     case DPDF:
-        links = page->u.pdfpage->links;
         trimctm (page->u.pdfpage, page->pdimno);
         fz_concat (&ctm,
                    &state.pagedims[page->pdimno].tctm,
                    &state.pagedims[page->pdimno].ctm);
         break;
 
-    case DXPS:
-        links = page->u.xpspage->links;
-        ctm = state.pagedims[page->pdimno].ctm;
-        break;
-
     default:
         return;
     }
 
-    for (link = links; link; link = link->next) {
+    for (annot = pdf_first_annot (state.u.pdf, page->u.pdfpage);
+         annot;
+         annot = pdf_next_annot (state.u.pdf, annot)) {
         count++;
     }
+
     if (count > 0) {
-        page->slinkcount = count;
-        page->slinks = calloc (count, slinksize);
-        if (!page->slinks) {
-            err (1, "calloc slinks %d", count);
+        page->annotcount = count;
+        page->annots = calloc (count, anotsize);
+        if (!page->annots) {
+            err (1, "calloc annots %d", count);
         }
 
-        for (i = 0, link = links; link; ++i, link = link->next) {
+        for (annot = pdf_first_annot (state.u.pdf, page->u.pdfpage), i = 0;
+             annot;
+             annot = pdf_next_annot (state.u.pdf, annot), i++) {
             fz_rect rect;
 
-            rect = link->rect;
+            pdf_bound_annot (state.u.pdf, annot, &rect);
             fz_transform_rect (&rect, &ctm);
-            page->slinks[i].link = link;
-            fz_round_rect (&page->slinks[i].bbox, &rect);
+            page->annots[i].annot = annot;
+            fz_round_rect (&page->annots[i].bbox, &annot->pagerect);
         }
-        qsort (page->slinks, count, slinksize, compareslinks);
     }
 }
 
-static void dropanots (struct page *page)
+static void dropslinks (struct page *page)
 {
-    if (page->annots) {
-        free (page->annots);
-        page->annots = NULL;
-        page->annotcount = 0;
+    if (page->slinks) {
+        free (page->slinks);
+        page->slinks = NULL;
+        page->slinkcount = 0;
     }
 }
 
-static void ensureanots (struct page *page)
+static void ensureslinks (struct page *page)
 {
     fz_matrix ctm;
-    int i, count = 0;
-    size_t anotsize = sizeof (*page->annots);
-    pdf_annot *annot;
+    int i, count;
+    size_t slinksize = sizeof (*page->slinks);
+    fz_link *link, *links;
 
+    ensureanots (page);
     if (state.gen != page->sgen) {
-        dropanots (page);
+        dropslinks (page);
         page->sgen = state.gen;
     }
-    if (page->annots) return;
+    if (page->slinks) return;
 
     switch (page->type) {
     case DPDF:
+        links = page->u.pdfpage->links;
         trimctm (page->u.pdfpage, page->pdimno);
         fz_concat (&ctm,
                    &state.pagedims[page->pdimno].tctm,
                    &state.pagedims[page->pdimno].ctm);
         break;
 
+    case DXPS:
+        links = page->u.xpspage->links;
+        ctm = state.pagedims[page->pdimno].ctm;
+        break;
+
     default:
         return;
     }
 
-    for (annot = pdf_first_annot (state.u.pdf, page->u.pdfpage);
-         annot;
-         annot = pdf_next_annot (state.u.pdf, annot)) {
+    count = page->annotcount;
+    for (link = links; link; link = link->next) {
         count++;
     }
-
     if (count > 0) {
-        page->annotcount = count;
-        page->annots = calloc (count, anotsize);
-        if (!page->annots) {
-            err (1, "calloc annots %d", count);
+        int j;
+
+        page->slinkcount = count;
+        page->slinks = calloc (count, slinksize);
+        if (!page->slinks) {
+            err (1, "calloc slinks %d", count);
         }
 
-        for (annot = pdf_first_annot (state.u.pdf, page->u.pdfpage), i = 0;
-             annot;
-             annot = pdf_next_annot (state.u.pdf, annot), i++) {
+        for (i = 0, link = links; link; ++i, link = link->next) {
             fz_rect rect;
 
-            pdf_bound_annot (state.u.pdf, annot, &rect);
+            rect = link->rect;
             fz_transform_rect (&rect, &ctm);
-            page->annots[i].annot = annot;
-            fz_round_rect (&page->annots[i].bbox, &annot->pagerect);
+            page->slinks[i].tag = SLINK;
+            page->slinks[i].u.link = link;
+            fz_round_rect (&page->slinks[i].bbox, &rect);
         }
+        for (j = 0; j < page->annotcount; ++j, ++i) {
+            fz_rect rect;
+
+            rect = page->annots[j].annot->pagerect;
+            fz_transform_rect (&rect, &ctm);
+            fz_round_rect (&page->slinks[i].bbox, &rect);
+
+            page->slinks[i].tag = SANNOT;
+            page->slinks[i].u.annot = page->annots[j].annot;
+        }
+        qsort (page->slinks, count, slinksize, compareslinks);
     }
 }
 
@@ -3229,6 +3246,7 @@ CAMLprim value ml_getlink (value ptr_v, value n_v)
     struct page *page;
     struct pagedim *pdim;
     char *s = String_val (ptr_v);
+    struct slink *slink;
 
     ret_v = Val_int (0);
     if (trylock ("ml_getlink")) {
@@ -3238,8 +3256,18 @@ CAMLprim value ml_getlink (value ptr_v, value n_v)
     page = parse_pointer ("ml_getlink", s);
     ensureslinks (page);
     pdim = &state.pagedims[page->pdimno];
-    link = page->slinks[Int_val (n_v)].link;
-    LINKTOVAL;
+    slink = &page->slinks[Int_val (n_v)];
+    if (slink->tag == SLINK) {
+        link = slink->u.link;
+        LINKTOVAL;
+    }
+    else {
+        str_v = caml_copy_string (
+            pdf_annot_contents (state.u.pdf, slink->u.annot)
+            );
+        ret_v = caml_alloc_small (1, uannot);
+        Field (ret_v, 0) = str_v;
+    }
 
     unlock ("ml_getlink");
  done:
diff --git a/main.ml b/main.ml
index 14abea5..a20e10b 100644
--- a/main.ml
+++ b/main.ml
@@ -3377,115 +3377,6 @@ object (self)
     | _ -> super#key key mask
 end
 
-let gotounder under =
-  let getpath filename =
-    let path =
-      if nonemptystr filename
-      then
-        if Filename.is_relative filename
-        then
-          let dir = Filename.dirname state.path in
-          let dir =
-            if Filename.is_implicit dir
-            then Filename.concat (Sys.getcwd ()) dir
-            else dir
-          in
-          Filename.concat dir filename
-        else filename
-      else E.s
-    in
-    if Sys.file_exists path
-    then path
-    else E.s
-  in
-  match under with
-  | Ulinkgoto (pageno, top) ->
-      if pageno >= 0
-      then (
-        addnav ();
-        gotopage1 pageno top;
-      )
-
-  | Ulinkuri s ->
-      gotouri s
-
-  | Uremote (filename, pageno) ->
-      let path = getpath filename in
-      if nonemptystr path
-      then (
-        if conf.riani
-        then
-          let command = Printf.sprintf "%s -page %d %S" !selfexec pageno path in
-          try popen command []
-          with exn ->
-            Printf.eprintf "failed to execute `%s': %s\n" command (exntos exn);
-            flush stderr;
-        else
-          let anchor = getanchor () in
-          let ranchor = state.path, state.password, anchor, state.origin in
-          state.origin <- E.s;
-          state.anchor <- (pageno, 0.0, 0.0);
-          state.ranchors <- ranchor :: state.ranchors;
-          opendoc path E.s;
-      )
-      else showtext '!' ("Could not find " ^ filename)
-
-  | Uremotedest (filename, destname) ->
-      let path = getpath filename in
-      if nonemptystr path
-      then (
-        if conf.riani
-        then
-          let command = !selfexec ^ " " ^ path ^ " -dest " ^ destname in
-          try popen command []
-          with exn ->
-            Printf.eprintf
-              "failed to execute `%s': %s\n" command (exntos exn);
-            flush stderr;
-        else
-          let anchor = getanchor () in
-          let ranchor = state.path, state.password, anchor, state.origin in
-          state.origin <- E.s;
-          state.nameddest <- destname;
-          state.ranchors <- ranchor :: state.ranchors;
-          opendoc path E.s;
-      )
-      else showtext '!' ("Could not find " ^ filename)
-
-  | Uunexpected _ | Ulaunch _ | Unamed _ | Utext _ | Unone
-  | Uannotation _  -> ()
-;;
-
-let gotohist (path, (c, bookmarks, x, anchor)) =
-  Config.save leavebirdseye;
-  state.anchor <- anchor;
-  state.x <- x;
-  state.bookmarks <- bookmarks;
-  state.origin <- E.s;
-  setconf conf c;
-  let x0, y0, x1, y1 = conf.trimfuzz in
-  wcmd "trimset %d %d %d %d %d" (btod conf.trimmargins) x0 y0 x1 y1;
-  opendoc path E.s;
-;;
-
-let gotooutline (_, _, kind) =
-  match kind with
-  | Onone -> ()
-  | Oanchor anchor ->
-      let (pageno, y, _) = anchor in
-      let y = getanchory
-        (if conf.presentation then (pageno, y, 1.0) else anchor)
-      in
-      addnav ();
-      gotoghyll y
-  | Ouri uri -> gotounder (Ulinkuri uri)
-  | Olaunch cmd -> gotounder (Ulaunch cmd)
-  | Oremote remote -> gotounder (Uremote remote)
-  | Ohistory hist -> gotohist hist
-  | Oremotedest remotedest -> gotounder (Uremotedest remotedest)
-  | Oaction f -> f ()
-;;
-
 let genhistoutlines =
   let order ty (p1, c1, _, _, _) (p2, c2, _, _, _) =
     match ty with
@@ -3531,296 +3422,85 @@ let genhistoutlines =
     else E.a;
 ;;
 
-let outlinesource sourcetype =
-  (object (self)
-    inherit lvsourcebase
-    val mutable m_items = E.a
-    val mutable m_minfo = E.a
-    val mutable m_orig_items = E.a
-    val mutable m_orig_minfo = E.a
-    val mutable m_narrow_patterns = []
-    val mutable m_hadremovals = false
-    val mutable m_gen = -1
+let gotohist (path, (c, bookmarks, x, anchor)) =
+  Config.save leavebirdseye;
+  state.anchor <- anchor;
+  state.x <- x;
+  state.bookmarks <- bookmarks;
+  state.origin <- E.s;
+  setconf conf c;
+  let x0, y0, x1, y1 = conf.trimfuzz in
+  wcmd "trimset %d %d %d %d %d" (btod conf.trimmargins) x0 y0 x1 y1;
+  opendoc path E.s;
+;;
 
-    method getitemcount =
-      Array.length m_items + (if m_hadremovals then 1 else 0)
+let makecheckers () =
+  (* Based on lablGL-1.04/LablGlut/examples/lablGL/checker.ml which had
+     following to say:
+     converted by Issac Trotts.  July 25, 2002 *)
+  let image = GlPix.create `ubyte ~format:`luminance ~width:2 ~height:2 in
+  Raw.sets_string (GlPix.to_raw image) ~pos:0 "\255\200\200\255";
+  let id = GlTex.gen_texture () in
+  GlTex.bind_texture ~target:`texture_2d id;
+  GlPix.store (`unpack_alignment 1);
+  GlTex.image2d image;
+  List.iter (GlTex.parameter ~target:`texture_2d)
+    [ `mag_filter `nearest; `min_filter `nearest ];
+  id;
+;;
 
-    method getitem n =
-      if n == Array.length m_items && m_hadremovals
-      then
-        ("[Confirm removal]", 0)
-      else
-        let s, n, _ = m_items.(n) in
-        (s, n)
+let setcheckers enabled =
+  match state.checkerstexid with
+  | None ->
+      if enabled then state.checkerstexid <- Some (makecheckers ())
 
-    method exit ~uioh ~cancel ~active ~first ~pan =
-      ignore (uioh, first);
-      let confrimremoval = m_hadremovals && active = Array.length m_items in
-      let items, minfo =
-        if m_narrow_patterns = []
-        then m_orig_items, m_orig_minfo
-        else m_items, m_minfo
-      in
-      if not cancel
+  | Some checkerstexid ->
+      if not enabled
       then (
-        if not confrimremoval
-        then (
-          gotooutline m_items.(active);
-          m_items <- items;
-          m_minfo <- minfo;
-        )
-        else (
-          state.bookmarks <- Array.to_list m_items;
-          m_orig_items <- m_items;
-          m_orig_minfo <- m_minfo;
-        )
-      )
-      else (
-        m_items <- items;
-        m_minfo <- minfo;
+        GlTex.delete_texture checkerstexid;
+        state.checkerstexid <- None;
       );
-      m_pan <- pan;
-      None
+;;
 
-    method hasaction _ = true
+let describe_location () =
+  let fn = page_of_y state.y in
+  let ln = page_of_y (state.y + state.winh - hscrollh () - 1) in
+  let maxy = state.maxy - (if conf.maxhfit then state.winh else 0) in
+  let percent =
+    if maxy <= 0
+    then 100.
+    else (100. *. (float state.y /. float maxy))
+  in
+  if fn = ln
+  then
+    Printf.sprintf "page %d of %d [%.2f%%]"
+      (fn+1) state.pagecount percent
+  else
+    Printf.sprintf
+      "pages %d-%d of %d [%.2f%%]"
+      (fn+1) (ln+1) state.pagecount percent
+;;
 
-    method greetmsg =
-      if Array.length m_items != Array.length m_orig_items
-      then
-        let s =
-          match m_narrow_patterns with
-          | one :: [] -> one
-          | many -> String.concat "@Uellipsis" (List.rev many)
-        in
-        "Narrowed to " ^ s ^ " (ctrl-u to restore)"
-      else E.s
+let setpresentationmode v =
+  let n = page_of_y state.y in
+  state.anchor <- (n, 0.0, 1.0);
+  conf.presentation <- v;
+  if conf.fitmodel = FitPage
+  then reqlayout conf.angle conf.fitmodel;
+  represent ();
+;;
 
-    method statestr =
-      match m_narrow_patterns with
-      | [] -> E.s
-      | one :: [] -> one
-      | head :: _ -> "@Uellipsis" ^ head
-
-    method narrow pattern =
-      let reopt = try Some (Str.regexp_case_fold pattern) with _ -> None in
-      match reopt with
-      | None -> ()
-      | Some re ->
-          let rec loop accu minfo n =
-            if n = -1
-            then (
-              m_items <- Array.of_list accu;
-              m_minfo <- Array.of_list minfo;
-            )
-            else
-              let (s, _, t) as o = m_items.(n) in
-              let accu, minfo =
-                match t with
-                | Oaction _ -> o :: accu, (0, 0) :: minfo
-                | Onone | Oanchor _ | Ouri _ | Olaunch _
-                | Oremote _ | Oremotedest _ | Ohistory _ ->
-                    let first =
-                      try Str.search_forward re s 0
-                      with Not_found -> -1
-                    in
-                    if first >= 0
-                    then o :: accu, (first, Str.match_end ()) :: minfo
-                    else accu, minfo
-              in
-              loop accu minfo (n-1)
-          in
-          loop [] [] (Array.length m_items - 1)
-
-    method! getminfo = m_minfo
-
-    method denarrow =
-      m_orig_items <- (
-        match sourcetype with
-        | `bookmarks -> Array.of_list state.bookmarks
-        | `outlines -> state.outlines
-        | `history -> genhistoutlines !Config.historder
-      );
-      m_minfo <- m_orig_minfo;
-      m_items <- m_orig_items
-
-    method remove m =
-      if sourcetype = `bookmarks
-      then
-        if m >= 0 && m < Array.length m_items
-        then (
-          m_hadremovals <- true;
-          m_items <- Array.init (Array.length m_items - 1) (fun n ->
-            let n = if n >= m then n+1 else n in
-            m_items.(n)
-          )
-        )
-
-    method add_narrow_pattern pattern =
-      m_narrow_patterns <- pattern :: m_narrow_patterns
-
-    method del_narrow_pattern =
-      match m_narrow_patterns with
-      | _ :: rest -> m_narrow_patterns <- rest
-      | [] -> ()
-
-    method renarrow =
-      self#denarrow;
-      match m_narrow_patterns with
-      | pattern :: [] -> self#narrow pattern; pattern
-      | list ->
-          List.fold_left (fun accu pattern ->
-            self#narrow pattern;
-            pattern ^ "@Uellipsis" ^ accu) E.s list
-
-    method calcactive anchor =
-      let rely = getanchory anchor in
-      let rec loop n best bestd =
-        if n = Array.length m_items
-        then best
-        else
-          let _, _, kind = m_items.(n) in
-          match kind with
-          | Oanchor anchor ->
-              let orely = getanchory anchor in
-              let d = abs (orely - rely) in
-              if d < bestd
-              then loop (n+1) n d
-              else loop (n+1) best bestd
-          | Onone | Oremote _ | Olaunch _
-          | Oremotedest _ | Ouri _ | Ohistory _ | Oaction _ ->
-              loop (n+1) best bestd
-      in
-      loop 0 ~-1 max_int
-
-    method reset anchor items =
-      m_hadremovals <- false;
-      if state.gen != m_gen
-      then (
-        m_orig_items <- items;
-        m_items <- items;
-        m_narrow_patterns <- [];
-        m_minfo <- E.a;
-        m_orig_minfo <- E.a;
-        m_gen <- state.gen;
-      )
-      else (
-        if items != m_orig_items
-        then (
-          m_orig_items <- items;
-          if m_narrow_patterns == []
-          then m_items <- items;
-        )
-      );
-      let active = self#calcactive anchor in
-      m_active <- active;
-      m_first <- firstof m_first active
-  end)
-;;
-
-let enterselector sourcetype =
-  resetmstate ();
-  let source = outlinesource sourcetype in
-  fun errmsg ->
-    let outlines =
-      match sourcetype with
-      | `bookmarks -> Array.of_list state.bookmarks
-      | `outlines -> state.outlines
-      | `history -> genhistoutlines !Config.historder
-    in
-    if Array.length outlines = 0
-    then (
-      showtext ' ' errmsg;
-    )
-    else (
-      state.text <- source#greetmsg;
-      Wsi.setcursor Wsi.CURSOR_INHERIT;
-      let anchor = getanchor () in
-      source#reset anchor outlines;
-      state.uioh <-
-        coe (new outlinelistview ~zebra:(sourcetype=`history) ~source);
-      G.postRedisplay "enter selector";
-    )
-;;
-
-let enteroutlinemode =
-  let f = enterselector `outlines in
-  fun () -> f "Document has no outline";
-;;
-
-let enterbookmarkmode =
-  let f = enterselector `bookmarks in
-  fun () -> f "Document has no bookmarks (yet)";
-;;
-
-let enterhistmode () = enterselector `history "No history (yet)";;
-
-let makecheckers () =
-  (* Based on lablGL-1.04/LablGlut/examples/lablGL/checker.ml which had
-     following to say:
-     converted by Issac Trotts.  July 25, 2002 *)
-  let image = GlPix.create `ubyte ~format:`luminance ~width:2 ~height:2 in
-  Raw.sets_string (GlPix.to_raw image) ~pos:0 "\255\200\200\255";
-  let id = GlTex.gen_texture () in
-  GlTex.bind_texture ~target:`texture_2d id;
-  GlPix.store (`unpack_alignment 1);
-  GlTex.image2d image;
-  List.iter (GlTex.parameter ~target:`texture_2d)
-    [ `mag_filter `nearest; `min_filter `nearest ];
-  id;
-;;
-
-let setcheckers enabled =
-  match state.checkerstexid with
-  | None ->
-      if enabled then state.checkerstexid <- Some (makecheckers ())
-
-  | Some checkerstexid ->
-      if not enabled
-      then (
-        GlTex.delete_texture checkerstexid;
-        state.checkerstexid <- None;
-      );
-;;
-
-let describe_location () =
-  let fn = page_of_y state.y in
-  let ln = page_of_y (state.y + state.winh - hscrollh () - 1) in
-  let maxy = state.maxy - (if conf.maxhfit then state.winh else 0) in
-  let percent =
-    if maxy <= 0
-    then 100.
-    else (100. *. (float state.y /. float maxy))
-  in
-  if fn = ln
-  then
-    Printf.sprintf "page %d of %d [%.2f%%]"
-      (fn+1) state.pagecount percent
-  else
-    Printf.sprintf
-      "pages %d-%d of %d [%.2f%%]"
-      (fn+1) (ln+1) state.pagecount percent
-;;
-
-let setpresentationmode v =
-  let n = page_of_y state.y in
-  state.anchor <- (n, 0.0, 1.0);
-  conf.presentation <- v;
-  if conf.fitmodel = FitPage
-  then reqlayout conf.angle conf.fitmodel;
-  represent ();
-;;
-
-let enterinfomode =
-  let btos b = if b then "@Uradical" else E.s in
-  let showextended = ref false in
-  let leave mode _ =  state.mode <- mode in
-  let src =
-    (object
-      val mutable m_first_time = true
-      val mutable m_l = []
-      val mutable m_a = E.a
-      val mutable m_prev_uioh = nouioh
-      val mutable m_prev_mode = View
+let enterinfomode =
+  let btos b = if b then "@Uradical" else E.s in
+  let showextended = ref false in
+  let leave mode _ =  state.mode <- mode in
+  let src =
+    (object
+      val mutable m_first_time = true
+      val mutable m_l = []
+      val mutable m_a = E.a
+      val mutable m_prev_uioh = nouioh
+      val mutable m_prev_mode = View
 
       inherit lvsourcebase
 
@@ -4596,6 +4276,326 @@ let enterannotmode =
     G.postRedisplay "annot";
 ;;
 
+let gotounder under =
+  let getpath filename =
+    let path =
+      if nonemptystr filename
+      then
+        if Filename.is_relative filename
+        then
+          let dir = Filename.dirname state.path in
+          let dir =
+            if Filename.is_implicit dir
+            then Filename.concat (Sys.getcwd ()) dir
+            else dir
+          in
+          Filename.concat dir filename
+        else filename
+      else E.s
+    in
+    if Sys.file_exists path
+    then path
+    else E.s
+  in
+  match under with
+  | Ulinkgoto (pageno, top) ->
+      if pageno >= 0
+      then (
+        addnav ();
+        gotopage1 pageno top;
+      )
+
+  | Ulinkuri s ->
+      gotouri s
+
+  | Uremote (filename, pageno) ->
+      let path = getpath filename in
+      if nonemptystr path
+      then (
+        if conf.riani
+        then
+          let command = Printf.sprintf "%s -page %d %S" !selfexec pageno path in
+          try popen command []
+          with exn ->
+            Printf.eprintf "failed to execute `%s': %s\n" command (exntos exn);
+            flush stderr;
+        else
+          let anchor = getanchor () in
+          let ranchor = state.path, state.password, anchor, state.origin in
+          state.origin <- E.s;
+          state.anchor <- (pageno, 0.0, 0.0);
+          state.ranchors <- ranchor :: state.ranchors;
+          opendoc path E.s;
+      )
+      else showtext '!' ("Could not find " ^ filename)
+
+  | Uremotedest (filename, destname) ->
+      let path = getpath filename in
+      if nonemptystr path
+      then (
+        if conf.riani
+        then
+          let command = !selfexec ^ " " ^ path ^ " -dest " ^ destname in
+          try popen command []
+          with exn ->
+            Printf.eprintf
+              "failed to execute `%s': %s\n" command (exntos exn);
+            flush stderr;
+        else
+          let anchor = getanchor () in
+          let ranchor = state.path, state.password, anchor, state.origin in
+          state.origin <- E.s;
+          state.nameddest <- destname;
+          state.ranchors <- ranchor :: state.ranchors;
+          opendoc path E.s;
+      )
+      else showtext '!' ("Could not find " ^ filename)
+
+  | Uunexpected _ | Ulaunch _ | Unamed _ | Utext _ | Unone -> ()
+  | Uannotation annot -> enterannotmode annot
+;;
+
+let gotooutline (_, _, kind) =
+  match kind with
+  | Onone -> ()
+  | Oanchor anchor ->
+      let (pageno, y, _) = anchor in
+      let y = getanchory
+        (if conf.presentation then (pageno, y, 1.0) else anchor)
+      in
+      addnav ();
+      gotoghyll y
+  | Ouri uri -> gotounder (Ulinkuri uri)
+  | Olaunch cmd -> gotounder (Ulaunch cmd)
+  | Oremote remote -> gotounder (Uremote remote)
+  | Ohistory hist -> gotohist hist
+  | Oremotedest remotedest -> gotounder (Uremotedest remotedest)
+  | Oaction f -> f ()
+;;
+
+let outlinesource sourcetype =
+  (object (self)
+    inherit lvsourcebase
+    val mutable m_items = E.a
+    val mutable m_minfo = E.a
+    val mutable m_orig_items = E.a
+    val mutable m_orig_minfo = E.a
+    val mutable m_narrow_patterns = []
+    val mutable m_hadremovals = false
+    val mutable m_gen = -1
+
+    method getitemcount =
+      Array.length m_items + (if m_hadremovals then 1 else 0)
+
+    method getitem n =
+      if n == Array.length m_items && m_hadremovals
+      then
+        ("[Confirm removal]", 0)
+      else
+        let s, n, _ = m_items.(n) in
+        (s, n)
+
+    method exit ~uioh ~cancel ~active ~first ~pan =
+      ignore (uioh, first);
+      let confrimremoval = m_hadremovals && active = Array.length m_items in
+      let items, minfo =
+        if m_narrow_patterns = []
+        then m_orig_items, m_orig_minfo
+        else m_items, m_minfo
+      in
+      if not cancel
+      then (
+        if not confrimremoval
+        then (
+          gotooutline m_items.(active);
+          m_items <- items;
+          m_minfo <- minfo;
+        )
+        else (
+          state.bookmarks <- Array.to_list m_items;
+          m_orig_items <- m_items;
+          m_orig_minfo <- m_minfo;
+        )
+      )
+      else (
+        m_items <- items;
+        m_minfo <- minfo;
+      );
+      m_pan <- pan;
+      None
+
+    method hasaction _ = true
+
+    method greetmsg =
+      if Array.length m_items != Array.length m_orig_items
+      then
+        let s =
+          match m_narrow_patterns with
+          | one :: [] -> one
+          | many -> String.concat "@Uellipsis" (List.rev many)
+        in
+        "Narrowed to " ^ s ^ " (ctrl-u to restore)"
+      else E.s
+
+    method statestr =
+      match m_narrow_patterns with
+      | [] -> E.s
+      | one :: [] -> one
+      | head :: _ -> "@Uellipsis" ^ head
+
+    method narrow pattern =
+      let reopt = try Some (Str.regexp_case_fold pattern) with _ -> None in
+      match reopt with
+      | None -> ()
+      | Some re ->
+          let rec loop accu minfo n =
+            if n = -1
+            then (
+              m_items <- Array.of_list accu;
+              m_minfo <- Array.of_list minfo;
+            )
+            else
+              let (s, _, t) as o = m_items.(n) in
+              let accu, minfo =
+                match t with
+                | Oaction _ -> o :: accu, (0, 0) :: minfo
+                | Onone | Oanchor _ | Ouri _ | Olaunch _
+                | Oremote _ | Oremotedest _ | Ohistory _ ->
+                    let first =
+                      try Str.search_forward re s 0
+                      with Not_found -> -1
+                    in
+                    if first >= 0
+                    then o :: accu, (first, Str.match_end ()) :: minfo
+                    else accu, minfo
+              in
+              loop accu minfo (n-1)
+          in
+          loop [] [] (Array.length m_items - 1)
+
+    method! getminfo = m_minfo
+
+    method denarrow =
+      m_orig_items <- (
+        match sourcetype with
+        | `bookmarks -> Array.of_list state.bookmarks
+        | `outlines -> state.outlines
+        | `history -> genhistoutlines !Config.historder
+      );
+      m_minfo <- m_orig_minfo;
+      m_items <- m_orig_items
+
+    method remove m =
+      if sourcetype = `bookmarks
+      then
+        if m >= 0 && m < Array.length m_items
+        then (
+          m_hadremovals <- true;
+          m_items <- Array.init (Array.length m_items - 1) (fun n ->
+            let n = if n >= m then n+1 else n in
+            m_items.(n)
+          )
+        )
+
+    method add_narrow_pattern pattern =
+      m_narrow_patterns <- pattern :: m_narrow_patterns
+
+    method del_narrow_pattern =
+      match m_narrow_patterns with
+      | _ :: rest -> m_narrow_patterns <- rest
+      | [] -> ()
+
+    method renarrow =
+      self#denarrow;
+      match m_narrow_patterns with
+      | pattern :: [] -> self#narrow pattern; pattern
+      | list ->
+          List.fold_left (fun accu pattern ->
+            self#narrow pattern;
+            pattern ^ "@Uellipsis" ^ accu) E.s list
+
+    method calcactive anchor =
+      let rely = getanchory anchor in
+      let rec loop n best bestd =
+        if n = Array.length m_items
+        then best
+        else
+          let _, _, kind = m_items.(n) in
+          match kind with
+          | Oanchor anchor ->
+              let orely = getanchory anchor in
+              let d = abs (orely - rely) in
+              if d < bestd
+              then loop (n+1) n d
+              else loop (n+1) best bestd
+          | Onone | Oremote _ | Olaunch _
+          | Oremotedest _ | Ouri _ | Ohistory _ | Oaction _ ->
+              loop (n+1) best bestd
+      in
+      loop 0 ~-1 max_int
+
+    method reset anchor items =
+      m_hadremovals <- false;
+      if state.gen != m_gen
+      then (
+        m_orig_items <- items;
+        m_items <- items;
+        m_narrow_patterns <- [];
+        m_minfo <- E.a;
+        m_orig_minfo <- E.a;
+        m_gen <- state.gen;
+      )
+      else (
+        if items != m_orig_items
+        then (
+          m_orig_items <- items;
+          if m_narrow_patterns == []
+          then m_items <- items;
+        )
+      );
+      let active = self#calcactive anchor in
+      m_active <- active;
+      m_first <- firstof m_first active
+  end)
+;;
+
+let enterselector sourcetype =
+  resetmstate ();
+  let source = outlinesource sourcetype in
+  fun errmsg ->
+    let outlines =
+      match sourcetype with
+      | `bookmarks -> Array.of_list state.bookmarks
+      | `outlines -> state.outlines
+      | `history -> genhistoutlines !Config.historder
+    in
+    if Array.length outlines = 0
+    then (
+      showtext ' ' errmsg;
+    )
+    else (
+      state.text <- source#greetmsg;
+      Wsi.setcursor Wsi.CURSOR_INHERIT;
+      let anchor = getanchor () in
+      source#reset anchor outlines;
+      state.uioh <-
+        coe (new outlinelistview ~zebra:(sourcetype=`history) ~source);
+      G.postRedisplay "enter selector";
+    )
+;;
+
+let enteroutlinemode =
+  let f = enterselector `outlines in
+  fun () -> f "Document has no outline";
+;;
+
+let enterbookmarkmode =
+  let f = enterselector `bookmarks in
+  fun () -> f "Document has no bookmarks (yet)";
+;;
+
+let enterhistmode () = enterselector `history "No history (yet)";;
+
 let quickbookmark ?title () =
   match state.layout with
   | [] -> ()
-- 
2.11.4.GIT