From 83040aff5ae0778b180d6d60ce640e8085c8076e Mon Sep 17 00:00:00 2001
From: hazen2215 <haz@disroot.org>
Date: Sun, 17 Dec 2023 22:36:57 +0900
Subject: [PATCH] main.ml: add command based launch menu

---
 main.ml | 42 ++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 42 insertions(+)

diff --git a/main.ml b/main.ml
index 004dc26..c6eec5d 100644
--- a/main.ml
+++ b/main.ml
@@ -77,6 +77,20 @@ let launchpath () =
        adderrfmt "spawn" "failed to execute `%s': %s" cmd @@ exntos exn
     | _pid -> ()
 
+let launchmenu () =
+    let n =
+      match !S.layout with
+      | l :: _ -> string_of_int l.pageno
+      | _ -> E.s
+    in
+    let cmd = Str.global_replace Re.percents !S.path "llpp-menu '%s' '%p'" in
+    let cmd =
+      if nonemptystr n
+      then Str.global_replace Re.percentp n cmd
+      else cmd
+    in
+    getcmdoutput (adderrfmt cmd "failed to obrain query: %s") cmd
+
 let getopaque pageno = Hashtbl.find S.pagemap (pageno, !S.gen)
 
 let pagetranslatepoint l x y =
@@ -3381,6 +3395,34 @@ let viewkeyboard key mask =
      | None -> S.autoscroll := Some conf.autoscrollstep
      end
   | Ascii 'p' when ctrl -> launchpath ()
+  | Ascii 'm' when ctrl ->
+     let cmds = launchmenu () in
+     let cl = splitatchar cmds ' ' in
+     let scan s fmt f =
+       try Scanf.sscanf s fmt f
+       with exn -> adderrfmt "remote exec" "error processing '%S': %s\n"
+                     cmds @@ exntos exn
+     in
+     (
+     match cl with
+     | "goto", args ->
+        scan args "%u %f %f"
+          (fun pageno x y ->
+            let cmd, _ = !S.geomcmds in
+            if emptystr cmd
+            then gotopagexy pageno x y
+            else
+              let f prevf () =
+                gotopagexy pageno x y;
+                prevf ()
+              in
+              S.reprf := f !S.reprf
+          )
+     | "gotor", args -> scan args "%S" gotoremote
+     | _ ->
+        adderrfmt "remote command"
+          "error processing remote command: %S\n" cmds
+     )
   | Ascii 'P' ->
      setpresentationmode (not conf.presentation);
      showtext ' ' ("presentation mode " ^ onoffs conf.presentation)