lean2/src/emacs/lean-type.el
Soonho Kong 6973d3e7aa feat(emacs/lean-info): add goal visualization options 'lean-proofstate-display-style'
lean-proofstate-display-style:

 - 'show-all: Show all goals
        a : Prop,
        b : Prop,
        c : Prop,
        H_1 : a,
        H_2 : b,
        H_3 : c
        ⊢ id a

        a : Prop,
        b : Prop,
        c : Prop,
        H_1 : a,
        H_2 : b,
        H_3 : c
        ⊢ b ∧ c

 - 'show-first: Show only the first
        a : Prop,
        b : Prop,
        c : Prop,
        H_1 : a,
        H_2 : b,
        H_3 : c
        ⊢ id a

 - 'show-first-and-other-conclusions: Show the first goal, and the
   conclusions of all other goals (DEFAULT OPTION)
        a : Prop,
        b : Prop,
        c : Prop,
        H_1 : a,
        H_2 : b,
        H_3 : c
        ⊢ id a

        ⊢ b ∧ c

Close #279
2014-10-29 17:08:55 -07:00

123 lines
4.5 KiB
EmacsLisp

;; -*- 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)