From: malc <av1474@comtv.ru>
Date: Mon, 21 Jan 2013 04:46:03 +0000 (+0400)
Subject: Preliminary synctex support
X-Git-Tag: v14~51
X-Git-Url: https://repo.or.cz/w/llpp.git/commitdiff_plain/f3f7a7fdc2abbb8c1069e9f319f50b541bf36206

Preliminary synctex support
---

diff --git a/link.c b/link.c
index d16365e..0da308c 100644
--- a/link.c
+++ b/link.c
@@ -3559,6 +3559,52 @@ CAMLprim value ml_pbo_usable (value unit_v)
     CAMLreturn (Val_bool (state.pbo_usable));
 }
 
+CAMLprim value ml_unproject (value ptr_v, value x_v, value y_v)
+{
+    CAMLparam3 (ptr_v, x_v, y_v);
+    CAMLlocal2 (ret_v, tup_v);
+    struct page *page;
+    char *s = String_val (ptr_v);
+    int x = Int_val (x_v), y = Int_val (y_v);
+    struct pagedim *pdim;
+    fz_point p;
+    fz_matrix ctm;
+
+    page = parse_pointer ("ml_unproject", s);
+    pdim = &state.pagedims[page->pdimno];
+
+    ret_v = Val_int (0);
+    if (trylock ("ml_unproject")) {
+        goto done;
+    }
+
+    switch (page->type) {
+    case DPDF:
+        ctm = trimctm (page->u.pdfpage, page->pdimno);
+        break;
+
+    default:
+        ctm = fz_identity;
+        break;
+    }
+    p.x = x;
+    p.y = y;
+
+    ctm = fz_concat (ctm, pdim->ctm);
+    ctm = fz_invert_matrix (ctm);
+    p = fz_transform_point (ctm, p);
+
+    tup_v = caml_alloc_tuple (2);
+    ret_v = caml_alloc_small (1, 1);
+    Field (tup_v, 0) = Val_int (p.x);
+    Field (tup_v, 1) = Val_int (p.y);
+    Field (ret_v, 0) = tup_v;
+
+    unlock ("ml_unproject");
+ done:
+    CAMLreturn (ret_v);
+}
+
 CAMLprim value ml_init (value pipe_v, value params_v)
 {
     CAMLparam2 (pipe_v, params_v);
diff --git a/main.ml b/main.ml
index da35c54..15ded45 100644
--- a/main.ml
+++ b/main.ml
@@ -108,6 +108,8 @@ external getpbo : width -> height -> colorspace -> string = "ml_getpbo";;
 external freepbo : string -> unit = "ml_freepbo";;
 external unmappbo : string -> unit = "ml_unmappbo";;
 external pbousable : unit -> bool = "ml_pbo_usable";;
+external unproject : opaque -> int -> int -> (int * int) option
+  = "ml_unproject";;
 
 let platform_to_string = function
   | Punknown      -> "unknown"
@@ -348,6 +350,7 @@ type conf =
     ; mutable pgscale        : float
     ; mutable usepbo         : bool
     ; mutable wheelbypage    : bool
+    ; mutable stcmd          : string
     }
 and columns =
     | Csingle of singlecolumn
@@ -554,6 +557,7 @@ let defconf =
   ; pgscale        = 1.0
   ; usepbo         = false
   ; wheelbypage    = false
+  ; stcmd          = "echo SyncTex"
   ; keyhashes      =
       let mk n = (n, Hashtbl.create 1) in
       [ mk "global"
@@ -848,7 +852,7 @@ let pagetranslatepoint l x y =
   (x, y);
 ;;
 
-let getunder x y =
+let onppundermouse g x y d =
   let rec f = function
     | l :: rest ->
         begin match getopaque l.pageno with
@@ -860,18 +864,36 @@ let getunder x y =
             if y >= y0 && y <= y1 && x >= x0 && x <= x1
             then
               let px, py = pagetranslatepoint l x y in
-              match whatsunder opaque px py with
-              | Unone -> f rest
-              | under -> under
+              match g opaque l px py with
+              | Some res -> res
+              | None -> f rest
             else f rest
         | _ ->
             f rest
         end
-    | [] -> Unone
+    | [] -> d
   in
   f state.layout
 ;;
 
+let getunder x y =
+  let g opaque _ px py =
+    match whatsunder opaque px py with
+    | Unone -> None
+    | under -> Some under
+  in
+  onppundermouse g x y Unone
+;;
+
+let unproject x y =
+  let g opaque l x y =
+    match unproject opaque x y with
+    | Some (x, y) -> Some (Some (l.pageno, x, y))
+    | None -> None
+  in
+  onppundermouse g x y None;
+;;
+
 let showtext c s =
   state.text <- Printf.sprintf "%c%s" c s;
   G.postRedisplay "showtext";
@@ -4530,6 +4552,9 @@ let enterinfomode =
       src#string "selection command"
         (fun () -> conf.selcmd)
         (fun v -> conf.selcmd <- v);
+      src#string "synctex command"
+        (fun () -> conf.stcmd)
+        (fun v -> conf.stcmd <- v);
       src#colorspace "color space"
         (fun () -> colorspace_to_string conf.colorspace)
         (fun v ->
@@ -5774,6 +5799,19 @@ let viewmouse button down x y mask =
       state.x <- state.x + (if n = 7 then -2 else 2) * conf.hscrollstep;
       gotoy_and_clear_text state.y
 
+  | 1 when Wsi.withshift mask ->
+      state.mstate <- Mnone;
+      if not down then (
+        match unproject x y with
+        | Some (pageno, ux, uy) ->
+            let cmd = Printf.sprintf
+              "%s %s %d %d %d"
+              conf.stcmd state.path pageno ux uy
+            in
+            popen cmd []
+        | None -> ()
+      )
+
   | 1 when Wsi.withctrl mask ->
       if down
       then (
@@ -6208,6 +6246,7 @@ struct
         | "birds-eye-columns" ->
             { c with beyecolumns = Some (max (int_of_string v) 2) }
         | "selection-command" -> { c with selcmd = unent v }
+        | "synctex-command" -> { c with stcmd = unent v }
         | "update-cursor" -> { c with updatecurs = bool_of_string v }
         | "hint-font-size" -> { c with hfsize = bound (int_of_string v) 5 100 }
         | "page-scroll-scale" -> { c with pgscale = float_of_string v }
@@ -6325,6 +6364,7 @@ struct
     dst.pgscale        <- src.pgscale;
     dst.usepbo         <- src.usepbo;
     dst.wheelbypage    <- src.wheelbypage;
+    dst.stcmd          <- src.stcmd;
   ;;
 
   let get s =
@@ -6730,6 +6770,7 @@ struct
     oco "columns" c.columns dc.columns;
     obeco "birds-eye-columns" c.beyecolumns dc.beyecolumns;
     os "selection-command" c.selcmd dc.selcmd;
+    os "synctex-command" c.stcmd dc.stcmd;
     ob "update-cursor" c.updatecurs dc.updatecurs;
     oi "hint-font-size" c.hfsize dc.hfsize;
     oi "horizontal-scroll-step" c.hscrollstep dc.hscrollstep;