lean2/src/emacs/lean-type.el

;; -*- lexical-binding: t; -*-
;; Copyright (c) 2014 Microsoft Corporation. All rights reserved.
;; Released under Apache 2.0 license as described in the file LICENSE.
;;
;; Author: Soonho Kong
;;

(require 'cl-lib)
(require 'dash)
(require 'dash-functional)
(require 'lean-variable)
(require 'lean-util)
(require 'lean-cmd)
(require 'lean-server)
(require 'lean-changes)
(require 'lean-debug)
(require 'flymake)

(defun lean-fill-placeholder-cont (info-record)
  "Continuation for lean-fill-placeholder"
  (let ((synth (and info-record (cl-first (lean-info-record-synth info-record)))))
    (when synth
      (let ((synth-str
             (replace-regexp-in-string "?M_[0-9]+" "_" (lean-info-synth-body-str synth))))
        (when (search " " synth-str)
          (setq synth-str (concat "(" synth-str ")")))
        (when (looking-at "_")
          (delete-forward-char 1)
          (insert synth-str))))))

(defun lean-fill-placeholder ()
  "Fill the placeholder with a synthesized expression by Lean."
  (interactive)
  (lean-get-info-record-at-point 'lean-fill-placeholder-cont))

(defconst lean-info-buffer-name "*lean-info*")
(defconst lean-info-buffer-delimiter "-------------------------------\n")

(defun lean-setup-info-buffer ()
  (unless (get-buffer lean-info-buffer-name)
    (with-current-buffer (get-buffer-create lean-info-buffer-name)
      (lean-info-mode))))

(defvar-local lean-info-prev-message nil
  "A variable storing the previous message written to *lean-info*
buffer. It's used to avoid outputting the same message")

(defun lean-output-to-lean-info-buffer (fmt args)
  (lean-setup-info-buffer)
  (let ((output (apply 'format fmt args)))
    (when (and (> (length output) 0)
               (or (not lean-info-prev-message)
                   (not (string= lean-info-prev-message output))))
      (setq lean-info-prev-message output)
      (lean-output-to-buffer lean-info-buffer-name lean-info-buffer-delimiter nil)
      (lean-output-to-buffer lean-info-buffer-name "%s\n" (list output)))))

(defun lean-eldoc-documentation-function-cont (info-record &optional add-to-kill-ring)
  "Continuation for lean-eldoc-documentation-function"
  (let* ((info-strings (lean-info-record-to-strings info-record))
         (info-string-mini-buffer (and info-strings (string-join info-strings " ")))
         (info-string-info-buffer (and info-strings (-last-item info-strings)))
         (proofstate (lean-info-record-proofstate info-record)))
    (when info-strings
      (when add-to-kill-ring
        (kill-new
         (substring-no-properties info-string-mini-buffer)))
      ;; Display on Mini-buffer
      (when (or lean-show-proofstate-in-minibuffer
                (not proofstate))
        (message "%s" info-string-mini-buffer))
      ;; Display on Info Buffer
      (when info-string-info-buffer
        (lean-output-to-lean-info-buffer "%s" (list info-string-info-buffer))))))

(defun lean-eldoc-documentation-function (&optional add-to-kill-ring)
  "Show information of lean expression at point if any"
  (interactive)
  (cond ((and lean-flycheck-use
              (or (get-char-property (point) 'flycheck-error)
                  (get-char-property (point) 'flycheck-warning)))
         nil)
        ((or (and (not (looking-at (rx white)))
                  (not (eolp)))
             (and (looking-back (rx (not white)))
                  (not (bolp))))
         (lean-get-info-record-at-point
          (lambda (info-record)
            (lean-eldoc-documentation-function-cont info-record add-to-kill-ring))))))

(defun lean-show-type ()
  "Show information of lean-expression at point if any."
  (interactive)
  (lean-eldoc-documentation-function lean-show-type-add-to-kill-ring))

;; =======================================================
;; eval
;; =======================================================

(defun lean-eval-parse-string (str)
  "Parse the output of eval command."
  (let ((str-list (split-string str "\n")))
    ;; Drop the first line "-- BEGINEVAL" and
    ;; the last line "-- ENDEVAL"
    (setq str-list
          (-take (- (length str-list) 2)
                 (-drop 1 str-list)))
    (string-join str-list "\n")))

(defun lean-eval-cmd (lean-cmd)
  "Evaluate lean command."
  (interactive "sLean CMD: ")
  (lean-server-send-cmd-async (lean-cmd-eval lean-cmd)
                              'message))

;; Clear Cache
(defun lean-clear-cache ()
  "Send CLEAR_CACHE command to lean-server"
  (interactive)
  (call-process (lean-get-executable "linja") nil 0 nil "clear-cache")
  (lean-server-send-cmd-async (lean-cmd-clear-cache)))

(provide 'lean-type)