forked from tarides/ocaml-eglot
-
Notifications
You must be signed in to change notification settings - Fork 0
Expand file tree
/
Copy pathocaml-eglot-type-enclosing.el
More file actions
194 lines (166 loc) · 8.11 KB
/
Copy pathocaml-eglot-type-enclosing.el
File metadata and controls
194 lines (166 loc) · 8.11 KB
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
;;; ocaml-eglot-type-enclosing.el --- Type Enclosing feature -*- coding: utf-8; lexical-binding: t -*-
;; Copyright (C) 2024-2026 Xavier Van de Woestyne
;; Licensed under the MIT license.
;; Author: Xavier Van de Woestyne <xaviervdw@gmail.com>
;; 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)
(define-key keymap (kbd "C-;") #'ocaml-eglot-type-enclosing-annotate)
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 (&optional prev-verb)
"Compute the type enclosing for a dedicated offset.
If PREV-VERB is given, the verbosity change ensure that the type is different."
(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)))
(when (and prev-verb
(string= type ocaml-eglot-type-enclosing-current-type))
(setq ocaml-eglot-type-enclosing-verbosity prev-verb))
(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)
(let ((prev-verbosity ocaml-eglot-type-enclosing-verbosity))
(setq ocaml-eglot-type-enclosing-verbosity
(1+ ocaml-eglot-type-enclosing-verbosity))
(ocaml-eglot-type-enclosing--with-fixed-offset prev-verbosity)))
(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 use the current major mode in the type buffer for syntax
;; highlighting, but only switch if it has changed.
(let ((curr-dir default-directory)
(current-major-mode major-mode))
(with-current-buffer (get-buffer-create ocaml-eglot-type-buffer-name)
(read-only-mode 0)
(unless (eq major-mode current-major-mode)
(funcall current-major-mode))
(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 (not (equal [] ocaml-eglot-type-enclosing-types)))
(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)))
(defun ocaml-eglot-type-enclosing-annotate ()
"Type annotate the expression of the current enclosing with its type."
(interactive)
;; TODO: Currently, the type annotation can reach invalid situation,
;; like annotating invalid node (like record field or sum parameter).
;; We should improve the situation using a dedicated request.
;; Currently, the LSP code action is not sufficient because it is
;; always based on the first enclosing under the point.
(when-let* ((result (ocaml-eglot-req--type-enclosings
(ocaml-eglot-util--current-position-or-range)
ocaml-eglot-type-enclosing-offset
;; We use verbosity as 0 in order to always reach
;; a proper type abbreviation.
0))
(enclosing (aref (cl-getf result :enclosings)
ocaml-eglot-type-enclosing-offset))
(type (cl-getf result :type))
(beg (eglot--lsp-position-to-point (cl-getf enclosing :start)))
(end (eglot--lsp-position-to-point (cl-getf enclosing :end))))
(progn
(save-excursion
(goto-char beg)
(insert ?\())
(goto-char (+ 1 end))
(insert " : " type ")"))))
(provide 'ocaml-eglot-type-enclosing)
;;; ocaml-eglot-type-enclosing.el ends here