Merge pull request #14 from tarides/type-enclosing-final

Type Enclosing Command

Author: xvw

README.md

@@ -38,6 +38,30 @@ navigating through errors:
 
 ![Error navigation example](media/error-navigation.gif)
 
+### Type Enclosings
+
+In `ocaml-eglot` one can display the type of the expression below the cursor and
+navigate the enclosing nodes while increasing or decreasing verbosity:
+
+- `ocaml-eglot-type-enclosing` (<kbd>C-c</kbd> <kbd>C-t</kbd>)
+Display the type of the selection and start a "type enclosing" session.
+
+During a "type enclosing" session the following commands are available:
+
+- `ocaml-eglot-type-enclosing-increase-verbosity` (<kbd>C-c</kbd>
+  <kbd>C-t</kbd> or <kbd>C-→</kbd>): to increase the verbosity of the
+  type observed
+- `ocaml-eglot-type-enclosing-decrease-verbosity` (<kbd>C-←</kbd>): to
+  decrease verbosity of the type observed
+- `ocaml-eglot-type-enclosing-grow` (<kbd>C-↑</kbd>): to grow the
+  expression
+- `ocaml-eglot-type-enclosing-shrink` (<kbd>C-↓</kbd>): to shrink the
+  expression
+- `ocaml-eglot-type-enclosing-copy` (<kbd>C-w</kbd>): to copy the
+  type expression to the _kill-ring_ (clipboard)
+
+![Type Enclosings example](media/type-enclosing.gif)
+
 ### Jump to definition/declaration
 
 OCaml-eglot provides a shortcut to quickly jump to the definition or

media/type-enclosing.gif

@@ -1,6 +1,6 @@
 ;;; ocaml-eglot-req.el --- LSP custom request   -*- coding: utf-8; lexical-binding: t -*-
 
-;; Copyright (C) 2024  Xavier Van de Woestyne
+;; Copyright (C) 2024-2025  Xavier Van de Woestyne
 ;; Licensed under the MIT license.
 
 ;; Author: Xavier Van de Woestyne <[email protected]>
@@ -95,6 +95,17 @@ A potential IDENTIFIER can be given and MARKUP-KIND can be parametrized."
     (if identifier (append params `(:identifier, identifier))
       params)))
 
+(defun ocaml-eglot-req--TypeEnclosingParams (at index verbosity)
+  "Compute the `TypeEnclosingParams'.
+AT is the range or the position.
+INDEX is the index of the enclosing.
+VERBOSITY is a potential verbosity index."
+  (append (list :textDocument (ocaml-eglot-req--TextDocumentIdentifier))
+          (ocaml-eglot-req--TextDocumentIdentifier)
+          `(:at, at)
+          `(:index, index)
+          `(:verbosity, verbosity)))
+
 ;;; Concrete requests
 
 (defun ocaml-eglot-req--jump ()
@@ -156,5 +167,13 @@ under the cursor.  The MARKUP-KIND can also be configured."
   (let ((params (ocaml-eglot-req--TextDocumentPositionParams)))
     (ocaml-eglot-req--send :textDocument/declaration params)))
 
+(defun ocaml-eglot-req--type-enclosings (at index verbosity)
+  "Execute the `ocamllsp/typeEnclosing' request for the current point.
+AT is the range or the position.
+INDEX is the index of the enclosing.
+VERBOSITY is a potential verbosity index."
+  (let ((params (ocaml-eglot-req--TypeEnclosingParams at index verbosity)))
+    (ocaml-eglot-req--send :ocamllsp/typeEnclosing params)))
+
 (provide 'ocaml-eglot-req)
 ;;; ocaml-eglot-req.el ends here

ocaml-eglot-req.el

@@ -0,0 +1,161 @@
+;;; ocaml-eglot-type-enclosing.el --- Type Enclosing feature   -*- coding: utf-8; lexical-binding: t -*-
+
+;; Copyright (C) 2024-2025  Xavier Van de Woestyne
+;; Licensed under the MIT license.
+
+;; Author: Xavier Van de Woestyne <[email protected]>
+;; Created: 10 January 2025
+;; SPDX-License-Identifier: MIT
+
+;;; Commentary:
+
+;; Plumbing needed to implement the primitives related to type
+;; enclosing commands.
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'ocaml-eglot-util)
+(require 'ocaml-eglot-req)
+
+;;; Customizable variables
+
+(defcustom ocaml-eglot-type-buffer-name "*ocaml-eglot-types*"
+  "The name of the buffer storing types."
+  :group 'ocaml-eglot
+  :type 'string)
+
+;;; Internal variables
+
+(defvar-local ocaml-eglot-type-enclosing-types nil
+  "Current list of enclosings related to types.")
+
+(defvar-local ocaml-eglot-type-enclosing-current-type nil
+  "Current type for the current enclosing.")
+
+(defvar-local ocaml-eglot-type-enclosing-offset 0
+  "The offset of the requested enclosings.")
+
+(defvar-local ocaml-eglot-type-enclosing-verbosity 0
+  "The verbosity of the current enclosing request.")
+
+;;; Key mapping for type enclosing
+
+(defvar ocaml-eglot-type-enclosing-map
+  (let ((keymap (make-sparse-keymap)))
+    (define-key keymap (kbd "C-<up>") #'ocaml-eglot-type-enclosing-grow)
+    (define-key keymap (kbd "C-<down>") #'ocaml-eglot-type-enclosing-shrink)
+    (define-key keymap (kbd "C-w") #'ocaml-eglot-type-enclosing-copy)
+    (define-key keymap (kbd "C-c C-t") #'ocaml-eglot-type-enclosing-increase-verbosity)
+    (define-key keymap (kbd "C-<right>") #'ocaml-eglot-type-enclosing-increase-verbosity)
+    (define-key keymap (kbd "C-<left>") #'ocaml-eglot-type-enclosing-decrease-verbosity)
+    keymap)
+  "Keymap for OCaml-eglot's type enclosing transient mode.")
+
+;;; Internal functions
+
+(defun ocaml-eglot-type-enclosing-copy ()
+  "Copy the type of the current enclosing to the Kill-ring."
+  (interactive)
+  (when ocaml-eglot-type-enclosing-current-type
+    (eglot--message "Copied `%s' to kill-ring"
+                    ocaml-eglot-type-enclosing-current-type)
+    (kill-new ocaml-eglot-type-enclosing-current-type)))
+
+(defun ocaml-eglot-type-enclosing--with-fixed-offset ()
+  "Compute the type enclosing for a dedicated offset."
+  (let* ((verbosity ocaml-eglot-type-enclosing-verbosity)
+         (index ocaml-eglot-type-enclosing-offset)
+         (at (ocaml-eglot-util--current-position-or-range))
+         (result (ocaml-eglot-req--type-enclosings at index verbosity))
+         (type (cl-getf result :type)))
+    (setq ocaml-eglot-type-enclosing-current-type type)
+    (ocaml-eglot-type-enclosing--display type t)))
+
+(defun ocaml-eglot-type-enclosing-increase-verbosity ()
+  "Increase the verbosity of the current request."
+  (interactive)
+  (setq ocaml-eglot-type-enclosing-verbosity
+        (1+ ocaml-eglot-type-enclosing-verbosity))
+  (ocaml-eglot-type-enclosing--with-fixed-offset))
+
+(defun ocaml-eglot-type-enclosing-decrease-verbosity ()
+  "Decrease the verbosity of the current request."
+  (interactive)
+  (when (> ocaml-eglot-type-enclosing-verbosity 0)
+    (setq ocaml-eglot-type-enclosing-verbosity
+          (1- ocaml-eglot-type-enclosing-verbosity)))
+  (ocaml-eglot-type-enclosing--with-fixed-offset))
+
+(defun ocaml-eglot-type-enclosing-grow ()
+  "Growing of the type enclosing."
+  (interactive)
+  (when ocaml-eglot-type-enclosing-types
+    (setq ocaml-eglot-type-enclosing-offset
+          (mod (1+ ocaml-eglot-type-enclosing-offset)
+               (length ocaml-eglot-type-enclosing-types)))
+    (ocaml-eglot-type-enclosing--with-fixed-offset)))
+
+(defun ocaml-eglot-type-enclosing-shrink ()
+  "Display the type enclosing of a smaller enclosing if possible."
+  (interactive)
+  (when ocaml-eglot-type-enclosing-types
+    (setq ocaml-eglot-type-enclosing-offset
+          (mod (1- ocaml-eglot-type-enclosing-offset)
+               (length ocaml-eglot-type-enclosing-types)))
+    (ocaml-eglot-type-enclosing--with-fixed-offset)))
+
+(defun ocaml-eglot-type-enclosing--type-buffer (type-expr)
+  "Create buffer with content TYPE-EXPR of the enclosing type buffer."
+  ; We store the current major mode to be used in the type buffer for
+  ; syntax highlighting.
+  (let ((curr-dir default-directory)
+        (current-major-mode major-mode))
+    (with-current-buffer (get-buffer-create ocaml-eglot-type-buffer-name)
+      (funcall current-major-mode)
+      (read-only-mode 0)
+      (erase-buffer)
+      (insert type-expr)
+      (goto-char (point-min))
+      (read-only-mode 1)
+      (setq default-directory curr-dir))))
+
+(defun ocaml-eglot-type-enclosing--display (type-expr &optional current)
+  "Display the type-enclosing for TYPE-EXPR in a dedicated buffer.
+If CURRENT is set, the range of the enclosing will be highlighted."
+  (ocaml-eglot-type-enclosing--type-buffer type-expr)
+  (if (ocaml-eglot-util--text-less-than type-expr 8)
+      (message "%s" (with-current-buffer ocaml-eglot-type-buffer-name
+                      (font-lock-fontify-region (point-min) (point-max))
+                      (buffer-string)))
+    (display-buffer ocaml-eglot-type-buffer-name))
+  (when (and current (> (length ocaml-eglot-type-enclosing-types) 0))
+    (let ((current (aref ocaml-eglot-type-enclosing-types
+                                   ocaml-eglot-type-enclosing-offset)))
+      (ocaml-eglot-util--highlight-range current
+                                         'ocaml-eglot-highlight-region-face))))
+
+(defun ocaml-eglot-type-enclosing--reset ()
+  "Reset local variables defined by the enclosing query."
+  (setq ocaml-eglot-type-enclosing-current-type nil)
+  (setq ocaml-eglot-type-enclosing-verbosity 0)
+  (setq ocaml-eglot-type-enclosing-types nil)
+  (setq ocaml-eglot-type-enclosing-offset 0))
+
+(defun ocaml-eglot-type-enclosing--call ()
+  "Print the type of the expression under point."
+  (ocaml-eglot-type-enclosing--reset)
+  (let* ((verbosity ocaml-eglot-type-enclosing-verbosity)
+         (index ocaml-eglot-type-enclosing-offset)
+         (at (ocaml-eglot-util--current-position-or-range))
+         (result (ocaml-eglot-req--type-enclosings at index verbosity))
+         (type (cl-getf result :type))
+         (enclosings (cl-getf result :enclosings)))
+    (setq ocaml-eglot-type-enclosing-types enclosings)
+    (setq ocaml-eglot-type-enclosing-current-type type)
+    (ocaml-eglot-type-enclosing--display type t)
+    (set-transient-map ocaml-eglot-type-enclosing-map t
+                       'ocaml-eglot-type-enclosing--reset)))
+
+(provide 'ocaml-eglot-type-enclosing)
+;;; ocaml-eglot-type-enclosing.el ends here

ocaml-eglot-type-enclosing.el

@@ -1,6 +1,6 @@
 ;;; ocaml-eglot-util.el --- Auxiliary tools   -*- coding: utf-8; lexical-binding: t -*-
 
-;; Copyright (C) 2024  Xavier Van de Woestyne
+;; Copyright (C) 2024-2025  Xavier Van de Woestyne
 ;; Licensed under the MIT license.
 
 ;; Author: Xavier Van de Woestyne <[email protected]>
@@ -21,6 +21,17 @@
 
 ;; Generic util
 
+(defun ocaml-eglot-util--text-less-than (text limit)
+  "Return non-nil if TEXT is less than LIMIT."
+  (let ((count 0)
+        (pos   0))
+    (save-match-data
+      (while (and (<= count limit)
+                  (string-match "\n" text pos))
+        (setq pos (match-end 0))
+        (setq count (1+ count))))
+    (<= count limit)))
+
 (defun ocaml-eglot-util--vec-first-or-nil (vec)
   "Return the first element of VEC or nil."
   (when (> (length vec) 0)
@@ -110,6 +121,14 @@
       (list :start start
             :end (ocaml-eglot-util--position-increase-char start "_")))))
 
+(defun ocaml-eglot-util--current-position-or-range ()
+  "Return the current position or a range if the region is active."
+  (if (region-active-p)
+      (let ((beg (eglot--pos-to-lsp-position (region-beginning)))
+            (end (eglot--pos-to-lsp-position (region-end))))
+        `(:start ,beg :end ,end))
+    (eglot--pos-to-lsp-position)))
+
 (defun ocaml-eglot-util--visit-file (strategy current-file new-file range)
   "Visits a referenced document, NEW-FILE at position  start of RANGE.
 The STRATEGY can be `'new' `'current' or `'smart'.  The later opens a
@@ -122,5 +141,15 @@ current window otherwise."
         (t (find-file-other-window new-file)))
   (ocaml-eglot-util--jump-to-range range))
 
+(defun ocaml-eglot-util--highlight-range (range face)
+  "Highlight a given RANGE using a given FACE."
+  (remove-overlays nil nil 'ocaml-eglot-highlight 'highlight)
+  (let* ((beg (eglot--lsp-position-to-point (cl-getf range :start)))
+        (end (eglot--lsp-position-to-point (cl-getf range :end)))
+        (overlay (make-overlay beg end)))
+    (overlay-put overlay 'face face)
+    (overlay-put overlay 'ocaml-eglot-highlight 'highlight)
+    (unwind-protect (sit-for 60) (delete-overlay overlay))))
+
 (provide 'ocaml-eglot-util)
 ;;; ocaml-eglot-util.el ends here

ocaml-eglot-util.el

@@ -1,6 +1,6 @@
 ;;; ocaml-eglot.el --- An OCaml companion for Eglot   -*- coding: utf-8; lexical-binding: t -*-
 
-;; Copyright (C) 2024  The OCaml-eglot Project Contributors
+;; Copyright (C) 2024-2025  The OCaml-eglot Project Contributors
 ;; Licensed under the MIT license.
 
 ;; Author: Xavier Van de Woestyne <[email protected]>
@@ -33,10 +33,10 @@
 ;;; Code:
 
 (require 'flymake)
-(require 'xref)
 (require 'cl-lib)
 (require 'ocaml-eglot-util)
 (require 'ocaml-eglot-req)
+(require 'ocaml-eglot-type-enclosing)
 (require 'eglot)
 
 (defgroup ocaml-eglot nil
@@ -93,6 +93,10 @@ Otherwise, `merlin-construct' only includes constructors."
   "Face describing the doc of values (used for search for example)."
   :group 'ocaml-eglot)
 
+(defface ocaml-eglot-highlight-region-face
+  '((t (:inherit highlight)))
+  "Face used when highlighting a region.")
+
 ;;; Features
 
 ;; Jump to errors
@@ -446,6 +450,14 @@ It use the ARG to use local values or not."
   (interactive "sIdentifier: ")
   (ocaml-eglot--document-aux identifier))
 
+;; Type Enclosings
+
+(defun ocaml-eglot-type-enclosing ()
+  "Print the type of the expression under point (or of the region, if it exists).
+If called repeatedly, increase the verbosity of the type shown."
+  (interactive)
+  (ocaml-eglot-type-enclosing--call))
+
 ;;; Mode
 
 (defvar ocaml-eglot-map
@@ -456,6 +468,7 @@ It use the ARG to use local values or not."
     (define-key ocaml-eglot-keymap (kbd "C-c C-i") #'ocaml-eglot-find-declaration)
     (define-key ocaml-eglot-keymap (kbd "C-c C-a") #'ocaml-eglot-alternate-file)
     (define-key ocaml-eglot-keymap (kbd "C-c C-d") #'ocaml-eglot-document)
+    (define-key ocaml-eglot-keymap (kbd "C-c C-t") #'ocaml-eglot-type-enclosing)
     ocaml-eglot-keymap)
   "Keymap for OCaml-eglot minor mode.")