Merge pull request #20 from tarides/phrase-prev-and-next-using-tunneling

Add `ocaml-eglot-phrase-prev/next` (using merlinCall)

README.md

@@ -100,6 +100,10 @@ provided:
 
 - `ocaml-eglot-find-type-definition-in-new-window`
 - `ocaml-eglot-find-type-definition-in-current-window`
+- `ocaml-eglot-phrase-prev` (<kbd>C-c</kbd> <kbd>C-p</kbd>): jump to
+  the beginning of the previous phrase
+- `ocaml-eglot-phrase-next` (<kbd>C-c</kbd> <kbd>C-n</kbd>): jump to
+  the beginning of the next phrase
 
 ### Find occurences
 

ocaml-eglot-req.el

@@ -184,5 +184,22 @@ VERBOSITY is a potential verbosity index."
   (let ((action-kind "destruct (enumerate cases)"))
     (ocaml-eglot-req--call-code-action action-kind)))
 
+(defun ocaml-eglot-req--merlin-call (command argv)
+  "Use tunneling `ocamllsp/merlinCallCompatible'.
+COMMAND is the command of the Merlin Protocol.
+ARGV is the list of arguments."
+  (let ((params (append (ocaml-eglot-req--TextDocumentIdentifier)
+                        `(:command, command)
+                        `(:resultAsSexp, :json-false)
+                        `(:args, argv))))
+    (ocaml-eglot-req--send :ocamllsp/merlinCallCompatible params)))
+
+(defun ocaml-eglot-req--phrase (target)
+  "Compute the beginning of the phrase referenced by TARGET."
+  ; TODO: use a dedicated custom request instead of tunneling
+  (let ((argv (vector "-position" (ocaml-eglot-util-point-as-arg (point))
+                      "-target" target)))
+    (ocaml-eglot-req--merlin-call "phrase" argv)))
+
 (provide 'ocaml-eglot-req)
 ;;; ocaml-eglot-req.el ends here

ocaml-eglot-util.el

@@ -16,11 +16,19 @@
 
 ;;; Code:
 
+(require 'json)
 (require 'eglot)
 (require 'cl-lib)
 
 ;; Generic util
 
+(defun ocaml-eglot-util--goto-char (target)
+  "Goto the point TARGET."
+  (when (or (< target (point-min))
+            (> target (point-max)))
+    (widen))
+  (goto-char target))
+
 (defun ocaml-eglot-util--text-less-than (text limit)
   "Return non-nil if TEXT is less than LIMIT."
   (let ((count 0)
@@ -48,21 +56,44 @@
           (switch-to-buffer buf)
           t)))))
 
+(defun ocaml-eglot-util-point-as-arg (point)
+  "Compute POINT as a valid Merlin position."
+  (save-excursion
+    (save-restriction
+      (widen)
+      (goto-char point)
+      (let ((line (line-number-at-pos))
+            (column (- (position-bytes (point))
+                       (position-bytes (line-beginning-position)))))
+        (format "%d:%d" line column)))))
+
+(defun ocaml-eglot-util--point-by-pos (line col)
+  "Compute LINE and COL as a point."
+  (save-excursion
+    (save-restriction
+      (widen)
+      (goto-char (point-min))
+      (forward-line (1- line))
+      (let* ((offset-l (position-bytes (point)))
+             (offset-c (max 0 col))
+             (target (+ offset-l offset-c)))
+        (byte-to-position target)))))
+
 (defun ocaml-eglot-util--replace-region (range content)
   "Replace a LSP region (RANGE) by a given CONTENT."
   (pcase-let ((`(,beg . ,end) (eglot--range-region range)))
     (delete-region beg end)
-    (goto-char beg)
+    (ocaml-eglot-util--goto-char beg)
     (insert content)))
 
 (defun ocaml-eglot-util--jump-to (position)
   "Move the cursor to a POSITION calculated by LSP."
-  (goto-char (eglot--lsp-position-to-point position)))
+  (ocaml-eglot-util--goto-char (eglot--lsp-position-to-point position)))
 
 (defun ocaml-eglot-util--jump-to-range (range)
   "Move the cursor to the start of a RANGE calculated by LSP."
   (let ((start (cl-getf range :start)))
-    (goto-char (eglot--lsp-position-to-point start))))
+    (ocaml-eglot-util--goto-char (eglot--lsp-position-to-point start))))
 
 (defun ocaml-eglot-util--compare-position (a b)
   "Comparison between two LSP positions, A and B."
@@ -151,5 +182,18 @@ current window otherwise."
     (overlay-put overlay 'ocaml-eglot-highlight 'highlight)
     (unwind-protect (sit-for 60) (delete-overlay overlay))))
 
+(defun ocaml-eglot-util--as-json (str)
+  "Parse a string STR as a Json object."
+  (json-parse-string str :object-type 'plist))
+
+(defun ocaml-eglot-util--merlin-call-result (result)
+  "Extract the RESULT of a Merlin Call Compatible request."
+  (let* ((result (cl-getf result :result))
+         (json-result (ocaml-eglot-util--as-json result))
+         (result-class (cl-getf json-result :class)))
+    (if (string= result-class "return")
+        (cl-getf json-result :value)
+      (eglot--error "Invalid result class %s" result-class))))
+
 (provide 'ocaml-eglot-util)
 ;;; ocaml-eglot-util.el ends here

ocaml-eglot.el

@@ -326,6 +326,27 @@ If there is no available holes, it returns the first one of HOLES."
           (ocaml-eglot-util--jump-to position)
         (eglot--error "Target not found")))))
 
+(defun ocaml-eglot--phrase (direction)
+  "Move to the next or previous phrase using DIRECTION."
+  (let* ((result (ocaml-eglot-req--phrase direction))
+         (json-result (ocaml-eglot-util--merlin-call-result result))
+         (pos (cl-getf json-result :pos)))
+    (when pos
+      (let* ((line (cl-getf pos :line))
+             (col (cl-getf pos :col))
+             (target (ocaml-eglot-util--point-by-pos line col)))
+        (ocaml-eglot-util--goto-char target)))))
+
+(defun ocaml-eglot-phrase-next ()
+  "Go to the beginning of the next phrase."
+  (interactive)
+  (ocaml-eglot--phrase "next"))
+
+(defun ocaml-eglot-phrase-prev ()
+  "Go to the beginning of the previous phrase."
+  (interactive)
+  (ocaml-eglot--phrase "prev"))
+
 ;; Search by type or polarity
 
 (defun ocaml-eglot--search-as-key (value-name value-type value-doc)
@@ -485,6 +506,8 @@ If called repeatedly, increase the verbosity of the type shown."
     (define-key ocaml-eglot-keymap (kbd "C-c C-t") #'ocaml-eglot-type-enclosing)
     (define-key ocaml-eglot-keymap (kbd "C-c |") #'ocaml-eglot-destruct)
     (define-key ocaml-eglot-keymap (kbd "C-c \\") #'ocaml-eglot-construct)
+    (define-key ocaml-eglot-keymap (kbd "C-c C-p") #'ocaml-eglot-phrase-prev)
+    (define-key ocaml-eglot-keymap (kbd "C-c C-n") #'ocaml-eglot-phrase-next)
     ocaml-eglot-keymap)
   "Keymap for OCaml-eglot minor mode.")