151 lines
6.4 KiB
EmacsLisp
151 lines
6.4 KiB
EmacsLisp
;; -*- lexical-binding: t -*-
|
|
;;
|
|
;; Copyright (c) 2017 David Christiansen.
|
|
;; Released under Apache 2.0 license as described in the file LICENSE.
|
|
;;
|
|
;; Author: David Christiansen
|
|
;;
|
|
;;; Commentary:
|
|
;; This is an interface to Lean's support for holes.
|
|
;;
|
|
;; The interface consists of two components: the hole command, which
|
|
;; collects the list of completions and the message, and a handler,
|
|
;; which selects a completion.
|
|
;;
|
|
;; For now, the only handler uses completing-read, but handlers using
|
|
;; helm or company's interface would be a good addition.
|
|
;;
|
|
;;; Code:
|
|
(require 'lean4-server)
|
|
|
|
(defun lean4-hole-handler-completing-read (alternatives)
|
|
"Pick a hole replacement from ALTERNATIVES with `completing-read'."
|
|
(let* ((choices (cl-loop for alt in alternatives
|
|
collect (cons (concat (plist-get alt :code)
|
|
" — "
|
|
(plist-get alt :description))
|
|
(plist-get alt :code))))
|
|
(selection (let ((this-command 'lean4-hole))
|
|
(completing-read
|
|
"Response: "
|
|
choices
|
|
nil t nil nil nil t)))
|
|
(code (assoc selection choices)))
|
|
(if code
|
|
(cdr code)
|
|
(error "Didn't select a hole completion"))))
|
|
|
|
(defvar lean4-hole-handler-function 'lean4-hole-handler-completing-read)
|
|
|
|
(defun lean4-hole--line-col->pos (line col)
|
|
"Compute the position corresponding to LINE and COL."
|
|
(save-restriction
|
|
(widen)
|
|
(save-excursion
|
|
(goto-char (point-min))
|
|
(forward-line (1- line))
|
|
(forward-char col)
|
|
(point))))
|
|
|
|
(defun lean4-hole ()
|
|
"Ask Lean for a list of holes, then ask the user which to use."
|
|
(interactive)
|
|
(with-demoted-errors "lean hole: %s"
|
|
(lean4-server-send-command
|
|
'hole_commands (list :file_name (buffer-file-name)
|
|
:line (line-number-at-pos)
|
|
:column (lean4-line-offset))
|
|
(cl-function
|
|
(lambda (&key start end results)
|
|
(let ((start-pos (lean4-hole--line-col->pos (plist-get start :line)
|
|
(plist-get start :column)))
|
|
(end-pos (lean4-hole--line-col->pos (plist-get end :line)
|
|
(plist-get end :column))))
|
|
(let ((start-marker (make-marker))
|
|
(end-marker (make-marker)))
|
|
(set-marker start-marker start-pos (current-buffer))
|
|
(set-marker end-marker end-pos (current-buffer))
|
|
(let* ((choices
|
|
(cl-loop for res in results
|
|
collect (cons (concat (plist-get res :name)
|
|
" — "
|
|
(plist-get res :description))
|
|
(plist-get res :name))))
|
|
(selection (let ((this-command 'lean4-hole))
|
|
(completing-read
|
|
"Hole command: "
|
|
choices
|
|
nil t nil nil nil t)))
|
|
(code (assoc selection choices)))
|
|
(if code
|
|
(lean4-hole--command (cdr code) start-marker end-marker)
|
|
(error "Didn't select a hole completion"))))))))))
|
|
|
|
;; This uses markers to ensure that if the hole moves while the
|
|
;; command is running, it is still updated.
|
|
(defun lean4-hole--command (command start-marker end-marker)
|
|
"Execute COMMAND in the hole between START-MARKER and END-MARKER."
|
|
(interactive)
|
|
(with-demoted-errors "lean hole: %s"
|
|
(lean4-server-send-command
|
|
'hole (list :action command
|
|
:file_name (buffer-file-name)
|
|
:line (line-number-at-pos start-marker)
|
|
:column (lean4-line-offset start-marker))
|
|
(cl-function
|
|
(lambda (&key message replacements)
|
|
(let ((replacement-count (length (plist-get replacements :alternatives))))
|
|
(let ((selected-code
|
|
(cond ((= replacement-count 0)
|
|
nil)
|
|
((= replacement-count 1)
|
|
(plist-get (car (plist-get replacements :alternatives)) :code))
|
|
(t
|
|
(lean4-hole-handler-completing-read
|
|
(plist-get replacements :alternatives))))))
|
|
(when selected-code
|
|
(save-excursion
|
|
(goto-char start-marker)
|
|
(delete-region start-marker end-marker)
|
|
(insert selected-code)))))
|
|
(when message
|
|
(message "%s" (s-trim message)))
|
|
(set-marker start-marker nil)
|
|
(set-marker end-marker nil))))))
|
|
|
|
(defun lean4-hole-right-click ()
|
|
"Ask Lean for a list of hole commands, then ask the user which to use."
|
|
(interactive)
|
|
(let ((buf (current-buffer)))
|
|
(ignore-errors
|
|
(list
|
|
'hole_commands
|
|
(list :file_name (buffer-file-name)
|
|
:line (line-number-at-pos)
|
|
:column (lean4-line-offset))
|
|
(cl-function
|
|
(lambda (&key start end results)
|
|
(when (and start end)
|
|
(with-current-buffer buf
|
|
(let ((start-pos (lean4-hole--line-col->pos (plist-get start :line)
|
|
(plist-get start :column)))
|
|
(end-pos (lean4-hole--line-col->pos (plist-get end :line)
|
|
(plist-get end :column))))
|
|
(let ((start-marker (make-marker))
|
|
(end-marker (make-marker)))
|
|
(set-marker start-marker start-pos (current-buffer))
|
|
(set-marker end-marker (1+ end-pos) (current-buffer))
|
|
(mapcar (lambda (res)
|
|
(let ((item-name (plist-get res :name))
|
|
(item-desc (plist-get res :description)))
|
|
(list :name
|
|
(concat item-name " — " item-desc)
|
|
:action
|
|
(lambda ()
|
|
(lean4-hole--command
|
|
item-name
|
|
start-marker end-marker)))))
|
|
results)))))))))))
|
|
|
|
(provide 'lean4-hole)
|
|
;;; lean4-hole.el ends here
|