diff --git a/README.md b/README.md index 8b2e506..99592f5 100644 --- a/README.md +++ b/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` (C-c C-p): jump to + the beginning of the previous phrase +- `ocaml-eglot-phrase-next` (C-c C-n): jump to + the beginning of the next phrase ### Find occurences diff --git a/ocaml-eglot-req.el b/ocaml-eglot-req.el index 9a32a5f..1fe51a9 100644 --- a/ocaml-eglot-req.el +++ b/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 diff --git a/ocaml-eglot-util.el b/ocaml-eglot-util.el index 702b8d5..fe74a7f 100644 --- a/ocaml-eglot-util.el +++ b/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 diff --git a/ocaml-eglot.el b/ocaml-eglot.el index 4daf076..d2560d6 100644 --- a/ocaml-eglot.el +++ b/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.")