├── .gitignore ├── LICENSE ├── README.md ├── company-lean.el ├── helm-lean.el ├── lean-debug.el ├── lean-dev.el ├── lean-eri.el ├── lean-flycheck.el ├── lean-hole.el ├── lean-info.el ├── lean-input.el ├── lean-leanpkg.el ├── lean-message-boxes.el ├── lean-mode.el ├── lean-right-click.el ├── lean-server.el ├── lean-settings.el ├── lean-syntax.el ├── lean-type.el └── lean-util.el /.gitignore: -------------------------------------------------------------------------------- 1 | .cask 2 | *.elc 3 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Apache License 2 | Version 2.0, January 2004 3 | http://www.apache.org/licenses/ 4 | 5 | TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION 6 | 7 | 1. Definitions. 8 | 9 | "License" shall mean the terms and conditions for use, reproduction, 10 | and distribution as defined by Sections 1 through 9 of this document. 11 | 12 | "Licensor" shall mean the copyright owner or entity authorized by 13 | the copyright owner that is granting the License. 14 | 15 | "Legal Entity" shall mean the union of the acting entity and all 16 | other entities that control, are controlled by, or are under common 17 | control with that entity. For the purposes of this definition, 18 | "control" means (i) the power, direct or indirect, to cause the 19 | direction or management of such entity, whether by contract or 20 | otherwise, or (ii) ownership of fifty percent (50%) or more of the 21 | outstanding shares, or (iii) beneficial ownership of such entity. 22 | 23 | "You" (or "Your") shall mean an individual or Legal Entity 24 | exercising permissions granted by this License. 25 | 26 | "Source" form shall mean the preferred form for making modifications, 27 | including but not limited to software source code, documentation 28 | source, and configuration files. 29 | 30 | "Object" form shall mean any form resulting from mechanical 31 | transformation or translation of a Source form, including but 32 | not limited to compiled object code, generated documentation, 33 | and conversions to other media types. 34 | 35 | "Work" shall mean the work of authorship, whether in Source or 36 | Object form, made available under the License, as indicated by a 37 | copyright notice that is included in or attached to the work 38 | (an example is provided in the Appendix below). 39 | 40 | "Derivative Works" shall mean any work, whether in Source or Object 41 | form, that is based on (or derived from) the Work and for which the 42 | editorial revisions, annotations, elaborations, or other modifications 43 | represent, as a whole, an original work of authorship. For the purposes 44 | of this License, Derivative Works shall not include works that remain 45 | separable from, or merely link (or bind by name) to the interfaces of, 46 | the Work and Derivative Works thereof. 47 | 48 | "Contribution" shall mean any work of authorship, including 49 | the original version of the Work and any modifications or additions 50 | to that Work or Derivative Works thereof, that is intentionally 51 | submitted to Licensor for inclusion in the Work by the copyright owner 52 | or by an individual or Legal Entity authorized to submit on behalf of 53 | the copyright owner. For the purposes of this definition, "submitted" 54 | means any form of electronic, verbal, or written communication sent 55 | to the Licensor or its representatives, including but not limited to 56 | communication on electronic mailing lists, source code control systems, 57 | and issue tracking systems that are managed by, or on behalf of, the 58 | Licensor for the purpose of discussing and improving the Work, but 59 | excluding communication that is conspicuously marked or otherwise 60 | designated in writing by the copyright owner as "Not a Contribution." 61 | 62 | "Contributor" shall mean Licensor and any individual or Legal Entity 63 | on behalf of whom a Contribution has been received by Licensor and 64 | subsequently incorporated within the Work. 65 | 66 | 2. Grant of Copyright License. Subject to the terms and conditions of 67 | this License, each Contributor hereby grants to You a perpetual, 68 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 69 | copyright license to reproduce, prepare Derivative Works of, 70 | publicly display, publicly perform, sublicense, and distribute the 71 | Work and such Derivative Works in Source or Object form. 72 | 73 | 3. Grant of Patent License. Subject to the terms and conditions of 74 | this License, each Contributor hereby grants to You a perpetual, 75 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 76 | (except as stated in this section) patent license to make, have made, 77 | use, offer to sell, sell, import, and otherwise transfer the Work, 78 | where such license applies only to those patent claims licensable 79 | by such Contributor that are necessarily infringed by their 80 | Contribution(s) alone or by combination of their Contribution(s) 81 | with the Work to which such Contribution(s) was submitted. If You 82 | institute patent litigation against any entity (including a 83 | cross-claim or counterclaim in a lawsuit) alleging that the Work 84 | or a Contribution incorporated within the Work constitutes direct 85 | or contributory patent infringement, then any patent licenses 86 | granted to You under this License for that Work shall terminate 87 | as of the date such litigation is filed. 88 | 89 | 4. Redistribution. You may reproduce and distribute copies of the 90 | Work or Derivative Works thereof in any medium, with or without 91 | modifications, and in Source or Object form, provided that You 92 | meet the following conditions: 93 | 94 | (a) You must give any other recipients of the Work or 95 | Derivative Works a copy of this License; and 96 | 97 | (b) You must cause any modified files to carry prominent notices 98 | stating that You changed the files; and 99 | 100 | (c) You must retain, in the Source form of any Derivative Works 101 | that You distribute, all copyright, patent, trademark, and 102 | attribution notices from the Source form of the Work, 103 | excluding those notices that do not pertain to any part of 104 | the Derivative Works; and 105 | 106 | (d) If the Work includes a "NOTICE" text file as part of its 107 | distribution, then any Derivative Works that You distribute must 108 | include a readable copy of the attribution notices contained 109 | within such NOTICE file, excluding those notices that do not 110 | pertain to any part of the Derivative Works, in at least one 111 | of the following places: within a NOTICE text file distributed 112 | as part of the Derivative Works; within the Source form or 113 | documentation, if provided along with the Derivative Works; or, 114 | within a display generated by the Derivative Works, if and 115 | wherever such third-party notices normally appear. The contents 116 | of the NOTICE file are for informational purposes only and 117 | do not modify the License. You may add Your own attribution 118 | notices within Derivative Works that You distribute, alongside 119 | or as an addendum to the NOTICE text from the Work, provided 120 | that such additional attribution notices cannot be construed 121 | as modifying the License. 122 | 123 | You may add Your own copyright statement to Your modifications and 124 | may provide additional or different license terms and conditions 125 | for use, reproduction, or distribution of Your modifications, or 126 | for any such Derivative Works as a whole, provided Your use, 127 | reproduction, and distribution of the Work otherwise complies with 128 | the conditions stated in this License. 129 | 130 | 5. Submission of Contributions. Unless You explicitly state otherwise, 131 | any Contribution intentionally submitted for inclusion in the Work 132 | by You to the Licensor shall be under the terms and conditions of 133 | this License, without any additional terms or conditions. 134 | Notwithstanding the above, nothing herein shall supersede or modify 135 | the terms of any separate license agreement you may have executed 136 | with Licensor regarding such Contributions. 137 | 138 | 6. Trademarks. This License does not grant permission to use the trade 139 | names, trademarks, service marks, or product names of the Licensor, 140 | except as required for reasonable and customary use in describing the 141 | origin of the Work and reproducing the content of the NOTICE file. 142 | 143 | 7. Disclaimer of Warranty. Unless required by applicable law or 144 | agreed to in writing, Licensor provides the Work (and each 145 | Contributor provides its Contributions) on an "AS IS" BASIS, 146 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or 147 | implied, including, without limitation, any warranties or conditions 148 | of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A 149 | PARTICULAR PURPOSE. You are solely responsible for determining the 150 | appropriateness of using or redistributing the Work and assume any 151 | risks associated with Your exercise of permissions under this License. 152 | 153 | 8. Limitation of Liability. In no event and under no legal theory, 154 | whether in tort (including negligence), contract, or otherwise, 155 | unless required by applicable law (such as deliberate and grossly 156 | negligent acts) or agreed to in writing, shall any Contributor be 157 | liable to You for damages, including any direct, indirect, special, 158 | incidental, or consequential damages of any character arising as a 159 | result of this License or out of the use or inability to use the 160 | Work (including but not limited to damages for loss of goodwill, 161 | work stoppage, computer failure or malfunction, or any and all 162 | other commercial damages or losses), even if such Contributor 163 | has been advised of the possibility of such damages. 164 | 165 | 9. Accepting Warranty or Additional Liability. While redistributing 166 | the Work or Derivative Works thereof, You may choose to offer, 167 | and charge a fee for, acceptance of support, warranty, indemnity, 168 | or other liability obligations and/or rights consistent with this 169 | License. However, in accepting such obligations, You may act only 170 | on Your own behalf and on Your sole responsibility, not on behalf 171 | of any other Contributor, and only if You agree to indemnify, 172 | defend, and hold each Contributor harmless for any liability 173 | incurred by, or claims asserted against, such Contributor by reason 174 | of your accepting any such warranty or additional liability. 175 | 176 | END OF TERMS AND CONDITIONS 177 | 178 | APPENDIX: How to apply the Apache License to your work. 179 | 180 | To apply the Apache License to your work, attach the following 181 | boilerplate notice, with the fields enclosed by brackets "{}" 182 | replaced with your own identifying information. (Don't include 183 | the brackets!) The text should be enclosed in the appropriate 184 | comment syntax for the file format. We also recommend that a 185 | file or class name and description of purpose be included on the 186 | same "printed page" as the copyright notice for easier 187 | identification within third-party archives. 188 | 189 | Copyright {yyyy} {name of copyright owner} 190 | 191 | Licensed under the Apache License, Version 2.0 (the "License"); 192 | you may not use this file except in compliance with the License. 193 | You may obtain a copy of the License at 194 | 195 | http://www.apache.org/licenses/LICENSE-2.0 196 | 197 | Unless required by applicable law or agreed to in writing, software 198 | distributed under the License is distributed on an "AS IS" BASIS, 199 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 200 | See the License for the specific language governing permissions and 201 | limitations under the License. 202 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | This is the Emacs mode for the [Lean 3 theorem prover][lean]. 2 | 3 | [lean]: https://github.com/leanprover/lean 4 | 5 | Installation 6 | ============ 7 | 8 | `lean-mode` requires GNU Emacs 24.3 or newer. The recommended way to install it is via [MELPA](https://melpa.org). If you have not already configured MELPA, put the following code in your Emacs init file (typically `~/.emacs.d/init.el`): 9 | ```elisp 10 | (require 'package) ; You might already have this line 11 | (add-to-list 'package-archives '("melpa" . "http://melpa.org/packages/")) 12 | (package-initialize) ; You might already have this line 13 | ``` 14 | See also [MELPA: Getting Started](https://melpa.org/#/getting-started). 15 | 16 | With MELPA configured, you can `M-x package-install` the packages `lean-mode` and `company-lean`. The latter package gives you auto completion and is strongly recommended. There is a third package, `helm-lean`, which provides a searchable list of declarations on `C-c C-d` using the Helm interface. `helm-lean` requires Emacs 24.4 or newer. 17 | 18 | For `company-lean`, you should also bind a key to trigger completion, if you have not already done so: 19 | 20 | ```elisp 21 | ;; Trigger completion on Shift-Space 22 | (global-set-key (kbd "S-SPC") #'company-complete) 23 | ``` 24 | 25 | Updating 26 | -------- 27 | 28 | For updating the Lean MELPA packages, use `package-list-packages`. See the section "Updating Packages" on [MELPA: Getting Started](https://melpa.org/#/getting-started) for details. 29 | 30 | Trying It Out 31 | ============= 32 | 33 | If things are working correctly, you should see the word ``Lean`` in the 34 | Emacs mode line when you open a file with extension `.lean`. If you type 35 | ```lean 36 | #check id 37 | ``` 38 | the word ``#check`` will be underlined, and hovering over it will show 39 | you the type of ``id``. The mode line will show ``FlyC:0/1``, indicating 40 | that there are no errors and one piece of information displayed. 41 | 42 | Key Bindings and Commands 43 | ========================= 44 | 45 | | Key | Function | 46 | |--------------------|---------------------------------------------------------------------------------| 47 | | M-. | jump to definition in source file (`lean-find-definition`) | 48 | | M-, | jump back to position before M-. (`xref-pop-marker-stack`) | 49 | | C-c C-k | shows the keystroke needed to input the symbol under the cursor | 50 | | C-c C-x | execute lean in stand-alone mode (`lean-std-exe`) | 51 | | C-c SPC | run a command on the hole at point (`lean-hole`) | 52 | | C-c C-d | show a searchable list of definitions (`helm-lean-definitions`) | 53 | | C-c C-g | toggle showing current tactic proof goal (`lean-toggle-show-goal`) | 54 | | C-c C-n | toggle showing next error in dedicated buffer (`lean-toggle-next-error`) | 55 | | C-c C-b | toggle showing output in inline boxes (`lean-message-boxes-toggle`) | 56 | | C-c C-r | restart the lean server (`lean-server-restart`) | 57 | | C-c C-s | switch to a different Lean version via [elan](https://github.com/Kha/elan) (`lean-server-switch-version`) | 58 | | C-c ! n | flycheck: go to next error | 59 | | C-c ! p | flycheck: go to previous error | 60 | | C-c ! l | flycheck: show list of errors | 61 | 62 | In the default configuration, the Flycheck annotation `FlyC:n/n` indicates the 63 | number of errors / responses from Lean; clicking on `FlyC` opens the Flycheck menu. 64 | 65 | 66 | Message Boxes 67 | ================ 68 | To view the output of commands such as `check` and `print` in boxes in the buffer, enable the feature using C-c C-b. 69 | If you then type 70 | ```lean 71 | #check id 72 | ``` 73 | a box appears after the line showing the type of `id`. Customize `lean-message-boxes-enabled-captions` to choose categories of boxes. 74 | In particular, add `"trace output"` to the list to see proof states and other traces in the buffer. 75 | 76 | Known Issues and Possible Solutions 77 | =================================== 78 | 79 | Unicode 80 | ------- 81 | 82 | If you experience a problem rendering unicode symbols on emacs, 83 | please download the following fonts and install them on your machine: 84 | 85 | - [Quivira.ttf](http://www.quivira-font.com/files/Quivira.ttf) 86 | - [Dejavu Fonts](http://sourceforge.net/projects/dejavu/files/dejavu/2.35/dejavu-fonts-ttf-2.35.tar.bz2) 87 | - [NotoSans](https://github.com/googlei18n/noto-fonts/blob/master/hinted/NotoSans-Regular.ttc?raw=true) 88 | - [NotoSansSymbols](https://github.com/googlei18n/noto-fonts/blob/master/unhinted/NotoSansSymbols-Regular.ttf?raw=true) 89 | 90 | Then, have the following lines in your emacs setup to use `DejaVu Sans Mono` font: 91 | 92 | ```elisp 93 | (when (member "DejaVu Sans Mono" (font-family-list)) 94 | (set-face-attribute 'default nil :font "DejaVu Sans Mono-11")) 95 | ``` 96 | 97 | You may also need to install the [emacs-unicode-fonts](https://github.com/rolandwalker/unicode-fonts) package, after which you should add the following lines to your emacs setup: 98 | 99 | ```elisp 100 | (require 'unicode-fonts) 101 | (unicode-fonts-setup) 102 | ``` 103 | 104 | Contributions 105 | ============= 106 | 107 | Contributions are welcome! 108 | 109 | Building from Source 110 | -------------------- 111 | 112 | When working on `lean-mode` itself, it is much easier to just `require` the sources than repeatedly building the MELPA packages: 113 | 114 | ```elisp 115 | (add-to-list 'load-path "~/path/to/lean-mode/") 116 | (require 'lean-mode) 117 | (require 'company-lean) 118 | (require 'helm-lean) 119 | ``` 120 | 121 | Make sure you have the packages' dependencies listed on MELPA installed -- the easiest way to do this may be to just install the official Lean MELPA packages and making sure the `require` commands above are execute before `package-initialize`. 122 | -------------------------------------------------------------------------------- /company-lean.el: -------------------------------------------------------------------------------- 1 | ;;; company-lean.el --- A company backend for lean-mode -*- lexical-binding: t -*- 2 | 3 | ;; Copyright (c) 2014 Microsoft Corporation. All rights reserved. 4 | 5 | ;; Author: Leonardo de Moura 6 | ;; Soonho Kong 7 | ;; Gabriel Ebner 8 | ;; Sebastian Ullrich 9 | ;; Maintainer: Sebastian Ullrich 10 | ;; Created: Jan 09, 2014 11 | ;; Keywords: languages 12 | ;; Package-Requires: ((emacs "24.3") (dash "2.18.0") (s "1.10.0") (f "0.19.0") (company "0.9.3") (lean-mode "3.3.0")) 13 | ;; URL: https://github.com/leanprover/lean-mode 14 | 15 | ;; Released under Apache 2.0 license as described in the file LICENSE. 16 | 17 | ;;; Commentary: 18 | 19 | ;; Provides context-sensitive auto completion for lean-mode. 20 | 21 | ;;; Code: 22 | 23 | (require 'company) 24 | (require 'company-etags) 25 | (require 'dash) 26 | (require 'f) 27 | (require 's) 28 | (require 'cl-lib) 29 | (require 'lean-util) 30 | (require 'lean-server) 31 | 32 | (defcustom company-lean-type-foreground (face-foreground 'font-lock-keyword-face) 33 | "Color of type parameter in auto-complete candidates" 34 | :group 'lean 35 | :type 'color) 36 | 37 | ;;;###autoload 38 | (defun company-lean-hook () 39 | (set (make-local-variable 'company-backends) '(company-lean)) 40 | (setq-local company-tooltip-limit 20) ; bigger popup window 41 | (setq-local company-minimum-prefix-length 5) 42 | (setq-local company-idle-delay nil) ; decrease delay before autocompletion popup shows 43 | ;(setq-local company-echo-delay 0) ; remove annoying blinking 44 | (setq-local company-begin-commands '(self-insert-command)) ; start autocompletion only after typing 45 | (company-mode t)) 46 | 47 | (cl-defun company-lean--make-candidate (prefix &key text type (tactic_params 'empty) doc source &allow-other-keys) 48 | (cl-destructuring-bind (&key file line _column) source 49 | (let ((source (cond 50 | (file (cons file line)) 51 | (line (cons (current-buffer) (lean-pos-at-line-col line 0)))))) 52 | (propertize text 53 | 'type type 54 | 'tactic_params tactic_params 55 | 'doc doc 56 | 'source source 57 | 'prefix prefix)))) 58 | 59 | (defun company-lean--handle-singleton-candidate (prefix candidates) 60 | "Handle singleton candidate. If the candidate does not start 61 | with prefix, we add prefix itself as a candidate to prevent 62 | from auto-completion." 63 | (let ((candidate (car candidates))) 64 | (cond ((s-prefix? prefix candidate) candidates) 65 | (t `(,candidate ,prefix))))) 66 | 67 | (cl-defun company-lean--exec (&key skip-completions) 68 | "Synchronously queries completions for the current point from server and returns a plist with keys :prefix and :candidates., or nil if no completion should be triggered." 69 | (lean-server-sync) 70 | (let* ((col (lean-line-offset)) 71 | (response (lean-server-send-synchronous-command 72 | 'complete (list :file_name (buffer-file-name) 73 | :line (line-number-at-pos) 74 | :column col 75 | :skip_completions (or skip-completions :json-false)))) 76 | (candidates (plist-get response :completions)) 77 | (prefix (plist-get response :prefix))) 78 | (when candidates 79 | (setq candidates 80 | (--map (apply 'company-lean--make-candidate prefix it) 81 | candidates)) 82 | (when (= (length candidates) 1) 83 | (setq candidates 84 | (company-lean--handle-singleton-candidate prefix candidates)))) 85 | (when (plist-member response :prefix) 86 | (list :prefix prefix :candidates candidates)))) 87 | 88 | (defun company-lean--annotation (candidate) 89 | (let ((type (get-text-property 0 'type candidate)) 90 | (tactic_params (get-text-property 0 'tactic_params candidate))) 91 | (when type 92 | (let* ((annotation-str (if (not (eq tactic_params 'empty)) 93 | (format " %s" (mapconcat 'identity tactic_params " ")) 94 | (format " : %s" type))) 95 | (annotation-len (length annotation-str)) 96 | (candidate-len (length candidate)) 97 | (entry-width (+ candidate-len 98 | annotation-len)) 99 | (allowed-width (truncate (* 0.90 (window-body-width))))) 100 | (when (> entry-width allowed-width) 101 | (setq annotation-str 102 | (concat 103 | (substring-no-properties annotation-str 104 | 0 105 | (- allowed-width candidate-len 3)) 106 | "..."))) 107 | annotation-str)))) 108 | 109 | (defun company-lean--location (arg) 110 | (get-text-property 0 'source arg)) 111 | 112 | (defun company-lean--match (arg) 113 | "Return the end of matched region" 114 | (let ((prefix (get-text-property 0 'prefix arg))) 115 | (when (and prefix (eq (s-index-of prefix arg) 0)) 116 | (length prefix)))) 117 | 118 | (defun company-lean--meta (arg) 119 | (get-text-property 0 'doc arg)) 120 | 121 | (defun company-lean (command &optional arg &rest ignored) 122 | (cl-case command 123 | (prefix (plist-get (company-lean--exec :skip-completions t) :prefix)) 124 | (candidates (plist-get (company-lean--exec) :candidates)) 125 | (annotation (company-lean--annotation arg)) 126 | (location (company-lean--location arg)) 127 | (match (company-lean--match arg)) 128 | (meta (company-lean--meta arg)) 129 | (no-cache t) 130 | (require-match 'never) 131 | (sorted t))) 132 | 133 | ;; ADVICES 134 | ;; ======= 135 | 136 | (defadvice company--window-width 137 | (after company-lean--window-width activate) 138 | (when (eq major-mode 'lean-mode) 139 | (setq ad-return-value (truncate (* 0.95 (window-body-width)))))) 140 | 141 | (defun company-lean--replace-regex-return-position (regex rep string &optional start) 142 | "Find regex and replace with rep on string. 143 | 144 | Return replaced string and start and end positions of replacement." 145 | (let* ((start (or start 0)) 146 | (m-start (string-match regex string start)) 147 | (m-end (match-end 0)) 148 | pre-string post-string matched-string replaced-string result) 149 | (cond (m-start 150 | (setq pre-string (substring string 0 m-start)) 151 | (setq matched-string (substring string m-start m-end)) 152 | (setq post-string (substring string m-end)) 153 | (string-match regex matched-string) 154 | (setq replaced-string 155 | (replace-match rep nil nil matched-string)) 156 | (setq result (concat pre-string 157 | replaced-string 158 | post-string)) 159 | `(,result ,m-start ,(+ m-start (length replaced-string))) 160 | )))) 161 | 162 | (defun company-lean--replace-regex-add-properties-all (regex rep string properties) 163 | "Find all occurrences of regex in string, and replace them with 164 | rep. Then, add text-properties on the replaced region." 165 | (let ((replace-result-items (company-lean--replace-regex-return-position regex rep string)) 166 | (result string)) 167 | (while replace-result-items 168 | (pcase replace-result-items 169 | (`(,replaced-string ,m-start ,m-end) 170 | (setq result replaced-string) 171 | (add-text-properties m-start m-end properties result) 172 | (setq replace-result-items 173 | (company-lean--replace-regex-return-position regex rep result m-end))))) 174 | result)) 175 | 176 | (eval-after-load 'company 177 | '(defadvice company-fill-propertize 178 | (after company-lean-fill-propertize activate) 179 | (when (eq major-mode 'lean-mode) 180 | (let* ((selected (ad-get-arg 3)) 181 | (foreground-color company-lean-type-foreground) 182 | (background-color (if selected (face-background 'company-tooltip-selection) 183 | (face-background 'company-tooltip))) 184 | (face-attrs 185 | (cond (background-color `(:foreground ,foreground-color 186 | :background ,background-color)) 187 | (t `(:foreground ,foreground-color)))) 188 | (properties `(face ,face-attrs 189 | mouse-face company-tooltip)) 190 | (old-return ad-return-value) 191 | (old-len (length old-return)) 192 | new-return new-len) 193 | (setq new-return 194 | (company-lean--replace-regex-add-properties-all 195 | (rx "?" word-start (group (+ (not white))) word-end) 196 | "\\1" 197 | ad-return-value 198 | properties)) 199 | (setq new-len (length new-return)) 200 | (while (< (length new-return) old-len) 201 | (setq new-return 202 | (concat new-return " "))) 203 | (when background-color 204 | (add-text-properties new-len old-len properties new-return)) 205 | (setq ad-return-value new-return))))) 206 | 207 | ;;;###autoload 208 | (add-hook 'lean-mode-hook #'company-lean-hook) 209 | 210 | (provide 'company-lean) 211 | ;;; company-lean.el ends here 212 | -------------------------------------------------------------------------------- /helm-lean.el: -------------------------------------------------------------------------------- 1 | ;;; helm-lean.el --- Helm interfaces for lean-mode -*- lexical-binding: t -*- 2 | 3 | ;; Copyright (c) 2014 Microsoft Corporation. All rights reserved. 4 | 5 | ;; Author: Leonardo de Moura 6 | ;; Soonho Kong 7 | ;; Gabriel Ebner 8 | ;; Sebastian Ullrich 9 | ;; Maintainer: Sebastian Ullrich 10 | ;; Created: Jan 09, 2014 11 | ;; Keywords: languages 12 | ;; Package-Requires: ((emacs "24.3") (dash "2.18.0") (helm "2.8.0") (lean-mode "3.3.0")) 13 | ;; URL: https://github.com/leanprover/lean-mode 14 | 15 | ;; Released under Apache 2.0 license as described in the file LICENSE. 16 | 17 | ;;; Commentary: 18 | 19 | ;; Currently provides an interface for looking up Lean definitions by name 20 | 21 | ;;; Code: 22 | 23 | (require 'dash) 24 | (require 'helm) 25 | (require 'lean-server) 26 | 27 | (defcustom helm-lean-keybinding-helm-lean-definitions (kbd "C-c C-d") 28 | "Lean Keybinding for helm-lean-definitions" 29 | :group 'lean-keybinding :type 'key-sequence) 30 | 31 | (defun helm-lean-definitions-format-candidate (c) 32 | `(,(format "%s : %s %s" 33 | (propertize (plist-get c :text) 'face font-lock-variable-name-face) 34 | (plist-get c :type) 35 | (propertize (plist-get (plist-get c :source) :file) 'face font-lock-comment-face)) 36 | . ,c)) 37 | 38 | (defun helm-lean-definitions-candidates () 39 | (with-helm-current-buffer 40 | (let* ((response (lean-server-send-synchronous-command 'search (list :query helm-pattern))) 41 | (results (plist-get response :results)) 42 | (results (-filter (lambda (c) (plist-get c :source)) results)) 43 | (candidates (-map 'helm-lean-definitions-format-candidate results))) 44 | candidates))) 45 | 46 | ;;;###autoload 47 | (defun helm-lean-definitions () 48 | "Open a 'helm' interface for searching Lean definitions." 49 | (interactive) 50 | (require 'helm) 51 | (helm :sources (helm-build-sync-source "helm-source-lean-definitions" 52 | :requires-pattern 1 53 | :candidates 'helm-lean-definitions-candidates 54 | :volatile t 55 | :match 'identity 56 | :action '(("Go to" . (lambda (c) (with-helm-current-buffer 57 | (apply 'lean-find-definition-cont (plist-get c :source))))))) 58 | :buffer "*helm Lean definitions*")) 59 | 60 | ;;;###autoload 61 | (defun helm-lean-hook () 62 | "Set up helm-lean for current buffer" 63 | (local-set-key helm-lean-keybinding-helm-lean-definitions #'helm-lean-definitions)) 64 | 65 | ;;;###autoload 66 | (add-hook 'lean-mode-hook #'helm-lean-hook) 67 | 68 | (provide 'helm-lean) 69 | ;;; helm-lean.el ends here 70 | -------------------------------------------------------------------------------- /lean-debug.el: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) 2014 Microsoft Corporation. All rights reserved. 2 | ;; Released under Apache 2.0 license as described in the file LICENSE. 3 | ;; 4 | ;; Author: Soonho Kong 5 | ;; 6 | (require 'cl-lib) 7 | 8 | (defvar lean-debug-mode nil) 9 | 10 | (defvar lean-debug-buffer-name "*lean-debug*") 11 | 12 | (defun lean-turn-on-debug-mode (&optional print-msg) 13 | (interactive) 14 | (when (or (called-interactively-p 'any) print-msg) 15 | (message "lean: turn on debug mode")) 16 | (get-buffer-create lean-debug-buffer-name) 17 | (buffer-disable-undo lean-debug-buffer-name) 18 | (display-buffer lean-debug-buffer-name 'display-buffer-reuse-window 19 | '((reusable-frames . t))) 20 | (setq lean-debug-mode t)) 21 | 22 | (defun lean-turn-off-debug-mode (&optional print-msg) 23 | (interactive) 24 | (when (eq major-mode 'lean-mode) 25 | (when (or (called-interactively-p 'any) print-msg) 26 | (message "lean: turn off debug mode")) 27 | (setq lean-debug-mode nil))) 28 | 29 | (defun lean-output-to-buffer (buffer-name format-string args) 30 | (with-current-buffer 31 | (get-buffer-create buffer-name) 32 | (save-selected-window 33 | (ignore-errors 34 | (select-window (get-buffer-window buffer-name t))) 35 | (goto-char (point-max)) 36 | (insert (apply 'format format-string args))))) 37 | 38 | (defun lean-debug (format-string &rest args) 39 | "Display a message at the bottom of the *lean-debug* buffer." 40 | (when lean-debug-mode 41 | (let ((time-str (format-time-string "%H:%M:%S.%3N" (current-time)))) 42 | (lean-output-to-buffer lean-debug-buffer-name 43 | (concat "%s -- " format-string "\n") 44 | (cons (propertize time-str 'face 'font-lock-keyword-face) 45 | args))))) 46 | 47 | (provide 'lean-debug) 48 | -------------------------------------------------------------------------------- /lean-dev.el: -------------------------------------------------------------------------------- 1 | ;; -*- lexical-binding: t -*- 2 | ;; 3 | ;; Copyright (c) 2017 Microsoft Corporation. All rights reserved. 4 | ;; Released under Apache 2.0 license as described in the file LICENSE. 5 | ;; 6 | ;; Author: Sebastian Ullrich 7 | ;; 8 | 9 | (require 'f) 10 | (require 'lean-util) 11 | 12 | (defun lean-diff-test-file () 13 | "Use interactive ./test_input.sh on file of current buffer" 14 | (interactive) 15 | (message (shell-command-to-string (format "yes | ./test_single.sh \"%s\" \"%s\" yes" 16 | (lean-get-executable "lean") 17 | (f-filename (buffer-file-name)))))) 18 | 19 | (provide 'lean-dev) 20 | -------------------------------------------------------------------------------- /lean-eri.el: -------------------------------------------------------------------------------- 1 | ;;; lean-eri.el --- Enhanced relative indentation (eri) 2 | 3 | ;;; Commentary: 4 | 5 | ;; Adapted from agda-mode (https://github.com/agda/agda/blob/master/src/data/emacs-mode/eri.el) 6 | 7 | ;;; Code: 8 | 9 | (require 'cl-lib) 10 | 11 | (defun lean-eri-current-line-length nil 12 | "Calculate length of current line." 13 | (- (line-end-position) (line-beginning-position))) 14 | 15 | (defun lean-eri-current-line-empty nil 16 | "Return non-nil if the current line is empty (not counting white space)." 17 | (equal (current-indentation) 18 | (lean-eri-current-line-length))) 19 | 20 | (defun lean-eri-maximum (xs) 21 | "Calculate maximum element in XS. 22 | Returns nil if the list is empty." 23 | (if xs (apply 'max xs))) 24 | 25 | (defun lean-eri-take (n xs) 26 | "Return the first N elements of XS." 27 | (butlast xs (- (length xs) n))) 28 | 29 | (defun lean-eri-split (x xs) 30 | "Return a pair of lists (XS1 . XS2). 31 | If XS is sorted, then XS = (append XS1 XS2), and all elements in 32 | XS1 are <= X, whereas all elements in XS2 are > X." 33 | (let* ((pos (or (cl-position-if (lambda (y) (> y x)) xs) (length xs))) 34 | (xs1 (lean-eri-take pos xs)) 35 | (xs2 (nthcdr pos xs))) 36 | (cons xs1 xs2))) 37 | 38 | (defun lean-eri-calculate-indentation-points-on-line (max) 39 | "Calculate indentation points on current line. 40 | Only points left of column number MAX are included. If MAX is 41 | nil, then all points are included. Points are returned in 42 | ascending order. 43 | 44 | Example (positions marked with ^ are returned): 45 | 46 | f x y = g 3 (Just y) 5 4 47 | ^ ^ ^ ^ ^ ^ ^ ^ | 48 | | 49 | MAX" 50 | (let ((result)) 51 | (save-excursion 52 | (save-restriction 53 | (beginning-of-line) 54 | ; To make \\` work in the regexp below: 55 | (narrow-to-region (line-beginning-position) (line-end-position)) 56 | (while 57 | (progn 58 | (let ((pos (and (search-forward-regexp 59 | "\\(?:\\s-\\|\\`\\)\\(\\S-\\)" nil t) 60 | (match-beginning 1)))) 61 | (when (not (null pos)) 62 | (let ((pos1 (- pos (line-beginning-position)))) 63 | (when (or (null max) (< pos1 max)) 64 | (add-to-list 'result pos1)))) 65 | (and pos 66 | (< (point) (line-end-position)) 67 | (or (null max) (< (current-column) max)))))) 68 | (nreverse result) ; Destructive operation. 69 | )))) 70 | 71 | (defun lean-eri-new-indentation-points () 72 | "Calculate new indentation points. 73 | Returns a singleton list containing the column number two steps 74 | in from the indentation of the first non-empty line (white space 75 | excluded) above the current line. If there is no such line, 76 | then the empty list is returned." 77 | (let ((start (line-beginning-position))) 78 | (save-excursion 79 | ; Find a non-empty line above the current one, if any. 80 | (while 81 | (progn 82 | (forward-line -1) 83 | (not (or (bobp) 84 | (not (lean-eri-current-line-empty)))))) 85 | (if (or (equal (point) start) 86 | (lean-eri-current-line-empty)) 87 | nil 88 | (list (+ 2 (current-indentation))))))) 89 | 90 | (defun lean-eri-calculate-indentation-points (reverse) 91 | "Calculate points used to indent the current line. 92 | The points are given in reverse order if REVERSE is non-nil. See 93 | `lean-eri-indent' for a description of how the indentation points are 94 | calculated; note that the current indentation is not included in 95 | the returned list." 96 | ;; First find a bunch of indentations used above the current line. 97 | (let ((points) 98 | (max) 99 | (start (line-beginning-position))) 100 | (save-excursion 101 | (while 102 | (progn 103 | (forward-line -1) 104 | ; Skip the line we started from and lines with nothing but 105 | ; white space. 106 | (unless (or (equal (point) start) 107 | (lean-eri-current-line-empty)) 108 | (setq points 109 | (append 110 | (lean-eri-calculate-indentation-points-on-line max) 111 | points)) 112 | (setq max (car points))) 113 | ;; Stop after hitting the beginning of the buffer or a 114 | ;; non-empty, non-indented line. 115 | (not (or (bobp) 116 | (and (equal (current-indentation) 0) 117 | (> (lean-eri-current-line-length) 0))))))) 118 | ;; Add new indentation points, but remove the current indentation. 119 | ;; Sort the indentations. Rearrange the points so that the next 120 | ;; point is the one after the current one. Reverse if necessary. 121 | ;; 122 | ;; Note: sort and nreverse are destructive. 123 | (let* ((ps0 (remove (current-indentation) 124 | (append (lean-eri-new-indentation-points) points))) 125 | (ps1 (lean-eri-split (current-indentation) (sort ps0 '<))) 126 | (ps2 (append (cdr ps1) (car ps1)))) 127 | (if reverse 128 | (nreverse ps2) 129 | ps2)))) 130 | 131 | (defun lean-eri-indent (&optional reverse) 132 | "Cycle between some possible indentation points. 133 | With prefix argument REVERSE, cycle in reverse order. 134 | 135 | Assume that a file contains the following lines of code, with 136 | point on the line with three dots: 137 | 138 | frob = loooooooooooooooooooooooooong identifier 139 | foo = f a b 140 | where 141 | f (Foo x) y = let bar = x 142 | baz = 3 + 5 143 | 144 | ... 145 | 146 | ^ ^ ^ ^ ^ ^ ^ ^ ^ * ^ ^ ^ ^ 147 | 148 | Then the ^'s and the * mark the indentation points that this 149 | function cycles through. The indentation points are selected as 150 | follows: 151 | 152 | * All lines before the current one, up to and including the 153 | first non-indented line (or the beginning of the buffer) are 154 | considered. 155 | 156 | foo = f a b 157 | where 158 | f (Foo x) y = let bar = x 159 | baz = 3 + 5 160 | 161 | * On these lines, erase all characters that stand to the right 162 | of some non-white space character on a lower line. 163 | 164 | foo 165 | whe 166 | f (Foo x) y = let b 167 | baz = 3 + 5 168 | 169 | * Also erase all characters not immediately preceded by white 170 | space. 171 | 172 | f 173 | w 174 | f ( x y = l b 175 | b = 3 + 5 176 | 177 | * The columns of all remaining characters are indentation 178 | points. 179 | 180 | f w f ( x y = l b = 3 + 5 181 | ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ 182 | 183 | * A new indentation point is also added, two steps in from the 184 | indentation of the first non-empty line (white space 185 | excluded) above the current line (if there is such a line). 186 | 187 | f w f ( x y = l b = 3 + 5 188 | ^ ^ ^ ^ ^ ^ ^ ^ ^ * ^ ^ ^ ^" 189 | (interactive "P") 190 | (let* ((points (lean-eri-calculate-indentation-points reverse)) 191 | (remaining-points (cdr (member (current-indentation) points))) 192 | (indentation (if remaining-points 193 | (car remaining-points) 194 | (car points)))) 195 | (when indentation 196 | (save-excursion (indent-line-to indentation)) 197 | (if (< (current-column) indentation) 198 | (indent-line-to indentation))))) 199 | 200 | (defun lean-eri-indent-reverse nil 201 | "Cycle between some possible indentation points (in reverse order). 202 | See `lean-eri-indent' for a description of how the indentation points 203 | are calculated." 204 | (interactive) 205 | (lean-eri-indent t)) 206 | 207 | (provide 'lean-eri) 208 | ;;; lean-eri.el ends here 209 | -------------------------------------------------------------------------------- /lean-flycheck.el: -------------------------------------------------------------------------------- 1 | ;; -*- lexical-binding: t -*- 2 | ;; 3 | ;; Copyright (c) 2014 Microsoft Corporation. All rights reserved. 4 | ;; Released under Apache 2.0 license as described in the file LICENSE. 5 | ;; 6 | ;; Author: Soonho Kong 7 | ;; 8 | (require 'cl-lib) 9 | (require 'flycheck) 10 | (require 'lean-settings) 11 | (require 'lean-server) 12 | (require 'lean-info) 13 | 14 | (defun lean-toggle-flycheck-mode () 15 | "Toggle flycheck-mode" 16 | (interactive) 17 | (cond 18 | (flycheck-mode (flycheck-mode -1)) 19 | (t (flycheck-mode 1)))) 20 | 21 | (cl-defun lean-flycheck-parse-task (checker buffer cur-file-name 22 | &key pos_line pos_col desc file_name &allow-other-keys) 23 | (if (equal cur-file-name file_name) 24 | (flycheck-error-new-at pos_line (1+ pos_col) 25 | 'info 26 | (format "still running: %s" desc) 27 | :filename file_name 28 | :checker checker :buffer buffer) 29 | (flycheck-error-new-at 1 1 30 | 'info 31 | (format "still running: %s" desc) 32 | :filename cur-file-name 33 | :checker checker :buffer buffer))) 34 | 35 | (defun lean-flycheck-mk-task-msgs (checker buffer sess) 36 | (if (and sess (lean-server-session-tasks sess) 37 | (plist-get (lean-server-session-tasks sess) :is_running)) 38 | (let* ((cur-fn (buffer-file-name)) 39 | (tasks (lean-server-session-tasks sess)) 40 | (cur-task (plist-get tasks :cur_task)) 41 | (tasks-for-cur-file (cl-remove-if-not (lambda (task) (equal cur-fn (plist-get task :file_name))) 42 | (plist-get tasks :tasks))) 43 | (display-tasks)) 44 | ;; do not display tasks for current file when highlighting is enabled 45 | (when (not lean-server-show-pending-tasks) 46 | (setq display-tasks tasks-for-cur-file)) 47 | ;; show current task when not in current file 48 | (when (and cur-task 49 | (not (equal cur-fn (plist-get cur-task :file_name)))) 50 | (setq display-tasks (cons cur-task display-tasks))) 51 | (mapcar (lambda (task) (apply #'lean-flycheck-parse-task checker buffer cur-fn task)) 52 | display-tasks)))) 53 | 54 | (defun lean-info-fontify-string (str) 55 | (lean-ensure-info-buffer "*lean-fontify*") 56 | (with-current-buffer "*lean-fontify*" 57 | (erase-buffer) 58 | (insert str) 59 | (font-lock-fontify-region (point-min) (point-max) nil) 60 | (buffer-string))) 61 | 62 | (cl-defun lean-flycheck-parse-error (checker buffer &key pos_line pos_col severity text file_name &allow-other-keys) 63 | (flycheck-error-new-at pos_line (1+ pos_col) 64 | (pcase severity 65 | ("error" 'error) 66 | ("warning" 'warning) 67 | ("information" 'info) 68 | (_ 'info)) 69 | (lean-info-fontify-string text) 70 | :filename file_name 71 | :checker checker :buffer buffer)) 72 | 73 | (defun lean-flycheck-start (checker callback) 74 | (let ((cur-fn (buffer-file-name)) 75 | (buffer (current-buffer))) 76 | (funcall callback 'finished 77 | (if lean-server-session 78 | (append 79 | (lean-flycheck-mk-task-msgs checker buffer lean-server-session) 80 | (mapcar (lambda (msg) (apply #'lean-flycheck-parse-error checker buffer msg)) 81 | (cl-remove-if-not (lambda (msg) (equal cur-fn (plist-get msg :file_name))) 82 | (lean-server-session-messages lean-server-session)))))))) 83 | 84 | (defun lean-flycheck-init () 85 | "Initialize lean-flycheck checker" 86 | (flycheck-define-generic-checker 'lean-checker 87 | "A Lean syntax checker." 88 | :start #'lean-flycheck-start 89 | :modes '(lean-mode)) 90 | (add-to-list 'flycheck-checkers 'lean-checker)) 91 | 92 | (defun lean-flycheck-turn-on () 93 | (flycheck-mode t)) 94 | 95 | (defconst lean-next-error-buffer-name "*Lean Next Error*") 96 | 97 | (defun lean-next-error--handler () 98 | (when (lean-info-buffer-active lean-next-error-buffer-name) 99 | (let ((deactivate-mark) ; keep transient mark 100 | (errors (or 101 | ;; prefer error of current position, if any 102 | (flycheck-overlay-errors-at (point)) 103 | ;; try errors in current line next 104 | (sort (flycheck-overlay-errors-in (line-beginning-position) (line-end-position)) 105 | #'flycheck-error-<) 106 | ;; fall back to next error position 107 | (-if-let* ((pos (flycheck-next-error-pos 1))) 108 | (flycheck-overlay-errors-at pos))))) 109 | (lean-with-info-output-to-buffer lean-next-error-buffer-name 110 | (dolist (e errors) 111 | (princ (format "%d:%d: " (flycheck-error-line e) (flycheck-error-column e))) 112 | (princ (flycheck-error-message e)) 113 | (princ "\n\n")) 114 | (when flycheck-current-errors 115 | (princ (format "(%d more messages above...)" (length flycheck-current-errors)))))))) 116 | 117 | (defun lean-toggle-next-error () 118 | (interactive) 119 | (lean-toggle-info-buffer lean-next-error-buffer-name) 120 | (lean-next-error--handler)) 121 | 122 | (provide 'lean-flycheck) 123 | -------------------------------------------------------------------------------- /lean-hole.el: -------------------------------------------------------------------------------- 1 | ;; -*- lexical-binding: t -*- 2 | ;; 3 | ;; Copyright (c) 2017 David Christiansen. 4 | ;; Released under Apache 2.0 license as described in the file LICENSE. 5 | ;; 6 | ;; Author: David Christiansen 7 | ;; 8 | ;;; Commentary: 9 | ;; This is an interface to Lean's support for holes. 10 | ;; 11 | ;; The interface consists of two components: the hole command, which 12 | ;; collects the list of completions and the message, and a handler, 13 | ;; which selects a completion. 14 | ;; 15 | ;; For now, the only handler uses completing-read, but handlers using 16 | ;; helm or company's interface would be a good addition. 17 | ;; 18 | ;;; Code: 19 | (require 'lean-server) 20 | 21 | (defun lean-hole-handler-completing-read (alternatives) 22 | "Pick a hole replacement from ALTERNATIVES with `completing-read'." 23 | (let* ((choices (cl-loop for alt in alternatives 24 | collect (cons (concat (plist-get alt :code) 25 | " — " 26 | (plist-get alt :description)) 27 | (plist-get alt :code)))) 28 | (selection (let ((this-command 'lean-hole)) 29 | (completing-read 30 | "Response: " 31 | choices 32 | nil t nil nil nil t))) 33 | (code (assoc selection choices))) 34 | (if code 35 | (cdr code) 36 | (error "Didn't select a hole completion")))) 37 | 38 | (defvar lean-hole-handler-function 'lean-hole-handler-completing-read) 39 | 40 | (defun lean-hole--line-col->pos (line col) 41 | "Compute the position corresponding to LINE and COL." 42 | (save-restriction 43 | (widen) 44 | (save-excursion 45 | (goto-char (point-min)) 46 | (forward-line (1- line)) 47 | (forward-char col) 48 | (point)))) 49 | 50 | (defun lean-hole () 51 | "Ask Lean for a list of holes, then ask the user which to use." 52 | (interactive) 53 | (with-demoted-errors "lean hole: %s" 54 | (lean-server-send-command 55 | 'hole_commands (list :file_name (buffer-file-name) 56 | :line (line-number-at-pos) 57 | :column (lean-line-offset)) 58 | (cl-function 59 | (lambda (&key start end results) 60 | (let ((start-pos (lean-hole--line-col->pos (plist-get start :line) 61 | (plist-get start :column))) 62 | (end-pos (lean-hole--line-col->pos (plist-get end :line) 63 | (plist-get end :column)))) 64 | (let ((start-marker (make-marker)) 65 | (end-marker (make-marker))) 66 | (set-marker start-marker start-pos (current-buffer)) 67 | (set-marker end-marker end-pos (current-buffer)) 68 | (let* ((choices 69 | (cl-loop for res in results 70 | collect (cons (concat (plist-get res :name) 71 | " — " 72 | (plist-get res :description)) 73 | (plist-get res :name)))) 74 | (selection (let ((this-command 'lean-hole)) 75 | (completing-read 76 | "Hole command: " 77 | choices 78 | nil t nil nil nil t))) 79 | (code (assoc selection choices))) 80 | (if code 81 | (lean-hole--command (cdr code) start-marker end-marker) 82 | (error "Didn't select a hole completion")))))))))) 83 | 84 | ;; This uses markers to ensure that if the hole moves while the 85 | ;; command is running, it is still updated. 86 | (defun lean-hole--command (command start-marker end-marker) 87 | "Execute COMMAND in the hole between START-MARKER and END-MARKER." 88 | (interactive) 89 | (with-demoted-errors "lean hole: %s" 90 | (lean-server-send-command 91 | 'hole (list :action command 92 | :file_name (buffer-file-name) 93 | :line (line-number-at-pos start-marker) 94 | :column (lean-line-offset start-marker)) 95 | (cl-function 96 | (lambda (&key message replacements) 97 | (let ((replacement-count (length (plist-get replacements :alternatives)))) 98 | (let ((selected-code 99 | (cond ((= replacement-count 0) 100 | nil) 101 | ((= replacement-count 1) 102 | (plist-get (car (plist-get replacements :alternatives)) :code)) 103 | (t 104 | (lean-hole-handler-completing-read 105 | (plist-get replacements :alternatives)))))) 106 | (when selected-code 107 | (save-excursion 108 | (goto-char start-marker) 109 | (delete-region start-marker end-marker) 110 | (insert selected-code))))) 111 | (when message 112 | (message "%s" (s-trim message))) 113 | (set-marker start-marker nil) 114 | (set-marker end-marker nil)))))) 115 | 116 | (defun lean-hole-right-click () 117 | "Ask Lean for a list of hole commands, then ask the user which to use." 118 | (interactive) 119 | (let ((buf (current-buffer))) 120 | (ignore-errors 121 | (list 122 | 'hole_commands 123 | (list :file_name (buffer-file-name) 124 | :line (line-number-at-pos) 125 | :column (lean-line-offset)) 126 | (cl-function 127 | (lambda (&key start end results) 128 | (when (and start end) 129 | (with-current-buffer buf 130 | (let ((start-pos (lean-hole--line-col->pos (plist-get start :line) 131 | (plist-get start :column))) 132 | (end-pos (lean-hole--line-col->pos (plist-get end :line) 133 | (plist-get end :column)))) 134 | (let ((start-marker (make-marker)) 135 | (end-marker (make-marker))) 136 | (set-marker start-marker start-pos (current-buffer)) 137 | (set-marker end-marker (1+ end-pos) (current-buffer)) 138 | (mapcar (lambda (res) 139 | (let ((item-name (plist-get res :name)) 140 | (item-desc (plist-get res :description))) 141 | (list :name 142 | (concat item-name " — " item-desc) 143 | :action 144 | (lambda () 145 | (lean-hole--command 146 | item-name 147 | start-marker end-marker))))) 148 | results))))))))))) 149 | 150 | (provide 'lean-hole) 151 | ;;; lean-hole.el ends here 152 | -------------------------------------------------------------------------------- /lean-info.el: -------------------------------------------------------------------------------- 1 | ;; -*- lexical-binding: t -*- 2 | ;; 3 | ;;; lean-info.el --- Emacs mode for Lean theorem prover 4 | ;; 5 | ;; Copyright (c) 2016 Gabriel Ebner. All rights reserved. 6 | ;; 7 | ;; Author: Gabriel Ebner 8 | ;; Maintainer: Gabriel Ebner 9 | ;; Created: Oct 29, 2016 10 | ;; Keywords: languages 11 | ;; Version: 0.1 12 | ;; URL: https://github.com/leanprover/lean/blob/master/src/emacs 13 | ;; 14 | ;; Released under Apache 2.0 license as described in the file LICENSE. 15 | ;; 16 | 17 | (require 'cl-lib) 18 | (require 'lean-syntax) 19 | 20 | ;; Lean Info Mode (for "*lean-info*" buffer) 21 | ;; Automode List 22 | ;;;###autoload 23 | (define-derived-mode lean-info-mode prog-mode "Lean-Info" 24 | "Major mode for Lean Info Buffer" 25 | :syntax-table lean-syntax-table 26 | :group 'lean 27 | (set (make-local-variable 'font-lock-defaults) lean-info-font-lock-defaults) 28 | (set (make-local-variable 'indent-tabs-mode) nil) 29 | (set 'compilation-mode-font-lock-keywords '()) 30 | (set-input-method "Lean") 31 | (set (make-local-variable 'lisp-indent-function) 32 | 'common-lisp-indent-function)) 33 | 34 | (cl-defmacro lean-with-info-output-to-buffer (buffer &rest body) 35 | `(let ((buf (get-buffer ,buffer))) 36 | (with-current-buffer buf 37 | (setq buffer-read-only nil) 38 | (erase-buffer) 39 | (setq standard-output buf) 40 | . ,body))) 41 | 42 | (defvar lean-info-buffer-names '() 43 | "These are the buffer names that `lean-toggle-info-buffer` will 44 | look to see if have an open window, and if so, replace that 45 | window's buffer.") 46 | 47 | (defun lean-ensure-info-buffer (buffer) 48 | (if (stringp buffer) 49 | (add-to-list 'lean-info-buffer-names buffer)) 50 | (let ((buf (get-buffer buffer))) 51 | (unless buf 52 | (setq buf (get-buffer-create buffer)) 53 | (with-current-buffer buf 54 | (buffer-disable-undo) 55 | (lean-info-mode))) 56 | buf)) 57 | 58 | (defun lean-locate-info-window () 59 | "Finds a window containing a buffer from 60 | `lean-info-buffer-names`, or nil if one does not exist" 61 | (let (window) 62 | (dolist (buffer lean-info-buffer-names window) 63 | (setq window (or window (get-buffer-window buffer)))))) 64 | 65 | (defun lean-toggle-info-buffer (buffer) 66 | "If there is an info window and it corresponds to the given 67 | buffer, delete the window. Otherwise, switch the info window to 68 | the given buffer, creating an info window if it does not already 69 | exist." 70 | (let* ((buf (lean-ensure-info-buffer buffer)) 71 | (window (or (get-buffer-window buf) (lean-locate-info-window)))) 72 | (cond 73 | ((and window (eq (window-buffer window) buf)) 74 | (delete-window window)) 75 | (window 76 | (with-selected-window window 77 | (switch-to-buffer buf))) 78 | (t 79 | (display-buffer buf))))) 80 | 81 | (defun lean-info-buffer-active (buffer) 82 | "Checks whether the given info buffer should show info for the current buffer" 83 | (and 84 | ;; info buffer visible 85 | (get-buffer-window buffer 'visible) 86 | ;; current window of current buffer is selected (i.e., in focus) 87 | (eq (current-buffer) (window-buffer)))) 88 | 89 | (defun lean-get-info-record-at-point (cont) 90 | "Get info-record at the current point" 91 | (with-demoted-errors "lean get info: %s" 92 | (lean-server-send-command 93 | 'info (list :file_name (buffer-file-name) 94 | :line (line-number-at-pos) 95 | :column (lean-line-offset)) 96 | (cl-function 97 | (lambda (&key record) 98 | (funcall cont record)))))) 99 | 100 | (defun lean-info-right-click-find-definition () 101 | "Offer to jump to definition of right-click target." 102 | (interactive) 103 | (list 'info 104 | (list :file_name (buffer-file-name) 105 | :line (line-number-at-pos) 106 | :column (lean-line-offset)) 107 | (cl-function 108 | (lambda (&key record) 109 | (let ((source-record (plist-get record :source))) 110 | (if source-record 111 | (let ((full-name (plist-get record :full-id))) 112 | (list 113 | (list :name (if full-name 114 | (concat "Find definition of " full-name) 115 | "Find definition") 116 | :action (lambda () 117 | (apply #'lean-find-definition-cont source-record))))) 118 | (list))))))) 119 | 120 | (cl-defun lean-find-definition-cont (&key file line column) 121 | (when (fboundp 'xref-push-marker-stack) (xref-push-marker-stack)) 122 | (when file 123 | (find-file file)) 124 | (goto-char (point-min)) 125 | (forward-line (1- line)) 126 | (forward-char column)) 127 | 128 | 129 | (defun lean-find-definition () 130 | "Jump to definition of thing at point" 131 | (interactive) 132 | (setq lean-show-goal--handler-mask t) ; avoid the current request to the Lean server to by 133 | ; interrupted by requests made for `lean-show-goal` 134 | (lean-get-info-record-at-point 135 | (lambda (info-record) 136 | (-if-let (source-record (plist-get info-record :source)) 137 | (apply #'lean-find-definition-cont source-record) 138 | (-if-let (id (plist-get info-record :full-id)) 139 | (message "no source location available for %s" id) 140 | (message "unknown thing at point")))))) 141 | 142 | (provide 'lean-info) 143 | -------------------------------------------------------------------------------- /lean-input.el: -------------------------------------------------------------------------------- 1 | ;;; lean-input.el --- The Lean input method (based/copied from Agda) 2 | ;;; 3 | ;;; DISCLAIMER: This file is based on agda-input.el provided with the Agda language. 4 | ;;; We did minor modifications 5 | ;; 6 | ;;; Commentary: 7 | ;; 8 | ;;;; A highly customisable input method which can inherit from other 9 | ;; Quail input methods. By default the input method is geared towards 10 | ;; the input of mathematical and other symbols in Lean programs. 11 | ;; 12 | ;; Use M-x customize-group lean-input to customise this input method. 13 | ;; Note that the functions defined under "Functions used to tweak 14 | ;; translation pairs" below can be used to tweak both the key 15 | ;; translations inherited from other input methods as well as the 16 | ;; ones added specifically for this one. 17 | ;; 18 | ;; Use lean-input-show-translations to see all the characters which 19 | ;; can be typed using this input method (except for those 20 | ;; corresponding to ASCII characters). 21 | 22 | ;;; Code: 23 | 24 | (require 'quail) 25 | 26 | (eval-when-compile 27 | (require 'cl)) 28 | ;; Quail is quite stateful, so be careful when editing this code. Note 29 | ;; that with-temp-buffer is used below whenever buffer-local state is 30 | ;; modified. 31 | 32 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 33 | ;; Utility functions 34 | 35 | (defun lean-input-concat-map (f xs) 36 | "Concat (map F XS)." 37 | (apply 'append (mapcar f xs))) 38 | 39 | (defun lean-input-to-string-list (s) 40 | "Convert a string S to a list of one-character strings, after 41 | removing all space and newline characters." 42 | (lean-input-concat-map 43 | (lambda (c) (if (member c (string-to-list " \n")) 44 | nil 45 | (list (string c)))) 46 | (string-to-list s))) 47 | 48 | (defun lean-input-character-range (from to) 49 | "A string consisting of the characters from FROM to TO." 50 | (let (seq) 51 | (dotimes (i (1+ (- to from))) 52 | (setq seq (cons (+ from i) seq))) 53 | (concat (nreverse seq)))) 54 | 55 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 56 | ;; Functions used to tweak translation pairs 57 | 58 | ;; lexical-let is used since Elisp lacks lexical scoping. 59 | 60 | (defun lean-input-compose (f g) 61 | "λx -> concatMap F (G x)" 62 | (lexical-let ((f1 f) (g1 g)) 63 | (lambda (x) (lean-input-concat-map f1 (funcall g1 x))))) 64 | 65 | (defun lean-input-or (f g) 66 | "λx -> F x ++ G x" 67 | (lexical-let ((f1 f) (g1 g)) 68 | (lambda (x) (append (funcall f1 x) (funcall g1 x))))) 69 | 70 | (defun lean-input-nonempty () 71 | "Only keep pairs with a non-empty first component." 72 | (lambda (x) (if (> (length (car x)) 0) (list x)))) 73 | 74 | (defun lean-input-prepend (prefix) 75 | "Prepend PREFIX to all key sequences." 76 | (lexical-let ((prefix1 prefix)) 77 | (lambda (x) `((,(concat prefix1 (car x)) . ,(cdr x)))))) 78 | 79 | (defun lean-input-prefix (prefix) 80 | "Only keep pairs whose key sequence starts with PREFIX." 81 | (lexical-let ((prefix1 prefix)) 82 | (lambda (x) 83 | (if (equal (substring (car x) 0 (length prefix1)) prefix1) 84 | (list x))))) 85 | 86 | (defun lean-input-suffix (suffix) 87 | "Only keep pairs whose key sequence ends with SUFFIX." 88 | (lexical-let ((suffix1 suffix)) 89 | (lambda (x) 90 | (if (equal (substring (car x) 91 | (- (length (car x)) (length suffix1))) 92 | suffix1) 93 | (list x))))) 94 | 95 | (defun lean-input-drop (ss) 96 | "Drop pairs matching one of the given key sequences. 97 | SS should be a list of strings." 98 | (lexical-let ((ss1 ss)) 99 | (lambda (x) (unless (member (car x) ss1) (list x))))) 100 | 101 | (defun lean-input-drop-beginning (n) 102 | "Drop N characters from the beginning of each key sequence." 103 | (lexical-let ((n1 n)) 104 | (lambda (x) `((,(substring (car x) n1) . ,(cdr x)))))) 105 | 106 | (defun lean-input-drop-end (n) 107 | "Drop N characters from the end of each key sequence." 108 | (lexical-let ((n1 n)) 109 | (lambda (x) 110 | `((,(substring (car x) 0 (- (length (car x)) n1)) . 111 | ,(cdr x)))))) 112 | 113 | (defun lean-input-drop-prefix (prefix) 114 | "Only keep pairs whose key sequence starts with PREFIX. 115 | This prefix is dropped." 116 | (lean-input-compose 117 | (lean-input-drop-beginning (length prefix)) 118 | (lean-input-prefix prefix))) 119 | 120 | (defun lean-input-drop-suffix (suffix) 121 | "Only keep pairs whose key sequence ends with SUFFIX. 122 | This suffix is dropped." 123 | (lexical-let ((suffix1 suffix)) 124 | (lean-input-compose 125 | (lean-input-drop-end (length suffix1)) 126 | (lean-input-suffix suffix1)))) 127 | 128 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 129 | ;; Customization 130 | 131 | ;; The :set keyword is set to 'lean-input-incorporate-changed-setting 132 | ;; so that the input method gets updated immediately when users 133 | ;; customize it. However, the setup functions cannot be run before all 134 | ;; variables have been defined. Hence the :initialize keyword is set to 135 | ;; 'custom-initialize-default to ensure that the setup is not performed 136 | ;; until lean-input-setup is called at the end of this file. 137 | 138 | (defgroup lean-input nil 139 | "The Lean input method. 140 | After tweaking these settings you may want to inspect the resulting 141 | translations using `lean-input-show-translations'." 142 | :group 'lean 143 | :group 'leim) 144 | 145 | (defcustom lean-input-tweak-all 146 | '(lean-input-compose 147 | (lean-input-prepend "\\") 148 | (lean-input-nonempty)) 149 | "An expression yielding a function which can be used to tweak 150 | all translations before they are included in the input method. 151 | The resulting function (if non-nil) is applied to every 152 | \(KEY-SEQUENCE . TRANSLATION) pair and should return a list of such 153 | pairs. (Note that the translations can be anything accepted by 154 | `quail-defrule'.) 155 | 156 | If you change this setting manually (without using the 157 | customization buffer) you need to call `lean-input-setup' in 158 | order for the change to take effect." 159 | :group 'lean-input 160 | :set 'lean-input-incorporate-changed-setting 161 | :initialize 'custom-initialize-default 162 | :type 'sexp) 163 | 164 | (defcustom lean-input-inherit 165 | `(("TeX" . (lean-input-compose 166 | (lean-input-drop '("geq" "leq" "bullet" "qed" "par")) 167 | (lean-input-or 168 | (lean-input-drop-prefix "\\") 169 | (lean-input-or 170 | (lean-input-compose 171 | (lean-input-drop '("^o")) 172 | (lean-input-prefix "^")) 173 | (lean-input-prefix "_"))))) 174 | ) 175 | "A list of Quail input methods whose translations should be 176 | inherited by the Lean input method (with the exception of 177 | translations corresponding to ASCII characters). 178 | 179 | The list consists of pairs (qp . tweak), where qp is the name of 180 | a Quail package, and tweak is an expression of the same kind as 181 | `lean-input-tweak-all' which is used to tweak the translation 182 | pairs of the input method. 183 | 184 | The inherited translation pairs are added last, after 185 | `lean-input-user-translations' and `lean-input-translations'. 186 | 187 | If you change this setting manually (without using the 188 | customization buffer) you need to call `lean-input-setup' in 189 | order for the change to take effect." 190 | :group 'lean-input 191 | :set 'lean-input-incorporate-changed-setting 192 | :initialize 'custom-initialize-default 193 | :type '(repeat (cons (string :tag "Quail package") 194 | (sexp :tag "Tweaking function")))) 195 | 196 | (defcustom lean-input-translations 197 | (let ((max-lisp-eval-depth 2800)) `( 198 | 199 | ;; Negation 200 | 201 | ("not" . ("¬")) 202 | 203 | ;; Equality and similar symbols. 204 | 205 | ("eq" . ,(lean-input-to-string-list "=∼∽≈≋∻∾∿≀≃⋍≂≅ ≌≊≡≣≐≑≒≓≔≕≖≗≘≙≚≛≜≝≞≟≍≎≏≬⋕")) 206 | ("eqn" . ,(lean-input-to-string-list "≠≁ ≉ ≄ ≇≆ ≢ ≭ ")) 207 | ("equiv" . ,(lean-input-to-string-list "≃⋍")) 208 | ("iso" . ,(lean-input-to-string-list "≅≌")) 209 | 210 | ("=n" . ("≠")) 211 | ("~" . ("∼")) ("~n" . ("≁")) ("homotopy" . ("∼")) 212 | ("~~" . ("≈")) ("~~n" . ("≉")) 213 | ("~~~" . ("≋")) 214 | (":~" . ("∻")) 215 | ("~-" . ("≃")) ("~-n" . ("≄")) 216 | ("-~" . ("≂")) 217 | ("~=" . ("≅")) ("~=n" . ("≇")) 218 | ("~~-" . ("≊")) 219 | ("==" . ("≡")) ("==n" . ("≢")) 220 | ("===" . ("≣")) 221 | (".=" . ("≐")) (".=." . ("≑")) 222 | (":=" . ("≔")) ("=:" . ("≕")) 223 | ("=o" . ("≗")) 224 | ("(=" . ("≘")) 225 | ("and=" . ("≙")) ("or=" . ("≚")) 226 | ("*=" . ("≛")) 227 | ("t=" . ("≜")) 228 | ("def=" . ("≝")) 229 | ("m=" . ("≞")) 230 | ("?=" . ("≟")) 231 | 232 | ("pr" . ("↣")) 233 | 234 | ("1" . ("₁")) 235 | ("2" . ("₂")) 236 | ("3" . ("₃")) 237 | ("4" . ("₄")) 238 | ("5" . ("₅")) 239 | ("6" . ("₆")) 240 | ("7" . ("₇")) 241 | ("8" . ("₈")) 242 | ("9" . ("₉")) 243 | ("0" . ("₀")) 244 | 245 | ;; Inequality and similar symbols. 246 | 247 | ("leq" . ,(lean-input-to-string-list "≤≦≲<≪⋘ ≶≺≼≾⊂⊆ ⋐⊏⊑ ⊰⊲⊴⋖⋚⋜⋞")) 248 | ("leqn" . ,(lean-input-to-string-list "≰≨≮≴⋦ ≸⊀ ⋨⊄⊈⊊ ⋢⋤ ⋪⋬ ⋠")) 249 | ("geq" . ,(lean-input-to-string-list "≥≧≳>≫⋙ ≷≻≽≿⊃⊇ ⋑⊐⊒ ⊱⊳⊵⋗⋛⋝⋟")) 250 | ("geqn" . ,(lean-input-to-string-list "≱≩≯≵⋧ ≹ ⊁ ⋩⊅⊉⊋ ⋣⋥ ⋫⋭ ⋡")) 251 | 252 | ("<=" . ("≤")) (">=" . ("≥")) 253 | ("<=n" . ("≰")) (">=n" . ("≱")) 254 | ("len" . ("≰")) ("gen" . ("≱")) 255 | ("n" . ("≯")) 256 | ("<~" . ("≲")) (">~" . ("≳")) 257 | ("<~n" . ("⋦")) (">~n" . ("⋧")) 258 | ("<~nn" . ("≴")) (">~nn" . ("≵")) 259 | ("<:" . ("⋖")) (":>" . ("⋗")) 260 | ("<=:" . ("⩿")) (":>=" . ("⪀")) 261 | ("covby" . ("⋖")) 262 | ("covers" . ("⋖")) 263 | ("wcovby" . ("⩿")) 264 | ("wcovers" . ("⩿")) 265 | 266 | ("ssub" . ("⊂")) ("ssup" . ("⊃")) 267 | ("ssubn" . ("⊄")) ("ssupn" . ("⊅")) 268 | ("sub" . ("⊆")) ("sup" . ("⊇")) 269 | ("subn" . ("⊈")) ("supn" . ("⊉")) 270 | ("ssqub" . ("⊏")) ("ssqup" . ("⊐")) 271 | ("squb" . ("⊑")) ("squp" . ("⊒")) 272 | ("squbn" . ("⋢")) ("squpn" . ("⋣")) 273 | 274 | ;; Set membership etc. 275 | 276 | ("member" . ,(lean-input-to-string-list "∈∉∊∋∌∍⋲⋳⋴⋵⋶⋷⋸⋹⋺⋻⋼⋽⋾⋿")) 277 | ("mem" . ("∈")) 278 | 279 | ("inn" . ("∉")) 280 | ("nin" . ("∌")) 281 | 282 | ;; Types 283 | 284 | ("T1" . ("Type₁")) 285 | ("T2" . ("Type₂")) 286 | ("T+" . ("Type₊")) 287 | 288 | ;; Intersections, unions etc. 289 | 290 | ("intersection" . ,(lean-input-to-string-list "∩⋂∧⋀⋏⨇⊓⨅⋒∏ ⊼ ⨉")) 291 | ("union" . ,(lean-input-to-string-list "∪⋃∨⋁⋎⨈⊔⨆⋓∐⨿⊽⊻⊍⨃⊎⨄⊌∑⅀")) 292 | 293 | ("and" . ("∧")) ("or" . ("∨")) 294 | ("And" . ("⋀")) ("Or" . ("⋁")) 295 | ("i" . ("∩")) ("un" . ("∪")) ("u+" . ("⊎")) ("u." . ("⊍")) 296 | ("I" . ("⋂")) ("Un" . ("⋃")) ("U+" . ("⨄")) ("U." . ("⨃")) 297 | ("glb" . ("⊓")) ("lub" . ("⊔")) 298 | ("Glb" . ("⨅")) ("Lub" . ("⨆")) 299 | 300 | ;; Entailment etc. 301 | 302 | ("entails" . ,(lean-input-to-string-list "⊢⊣⊤⊥⊦⊧⊨⊩⊪⊫⊬⊭⊮⊯")) 303 | 304 | ("|-" . ("⊢")) ("|-n" . ("⊬")) 305 | ("-|" . ("⊣")) 306 | ("|=" . ("⊨")) ("|=n" . ("⊭")) 307 | ("||-" . ("⊩")) ("||-n" . ("⊮")) 308 | ("||=" . ("⊫")) ("||=n" . ("⊯")) 309 | ("|||-" . ("⊪")) 310 | 311 | ;; Divisibility, parallelity. 312 | 313 | ("|" . ("∣")) ("|n" . ("∤")) 314 | ("||" . ("∥")) ("||n" . ("∦")) 315 | 316 | ;; Some symbols from logic and set theory. 317 | 318 | ("all" . ("∀")) 319 | ("ex" . ("∃")) 320 | ("exn" . ("∄")) 321 | ("0" . ("∅")) 322 | ("empty" . ("∅")) 323 | ("C" . ("∁")) 324 | ("powerset" . ("𝒫")) 325 | 326 | ;; Corners, ceilings and floors. 327 | 328 | ("c" . ,(lean-input-to-string-list "⌜⌝⌞⌟⌈⌉⌊⌋")) 329 | ("cu" . ,(lean-input-to-string-list "⌜⌝ ⌈⌉ ")) 330 | ("cl" . ,(lean-input-to-string-list " ⌞⌟ ⌊⌋")) 331 | 332 | ("cul" . ("⌜")) ("cuL" . ("⌈")) 333 | ("cur" . ("⌝")) ("cuR" . ("⌉")) 334 | ("cll" . ("⌞")) ("clL" . ("⌊")) 335 | ("clr" . ("⌟")) ("clR" . ("⌋")) 336 | 337 | ;; Various operators/symbols. 338 | ("tr" . ,(lean-input-to-string-list "⬝▹")) 339 | ("trans" . ,(lean-input-to-string-list "▹⬝")) 340 | ("transport" . ("▹")) 341 | ("con" . ("⬝")) 342 | ("cdot" . ("⬝")) 343 | ("dot" . ("⬝")) 344 | ("sy" . ("⁻¹")) 345 | ("inv" . ("⁻¹")) 346 | ("-1" . ("⁻¹" "₋₁")) 347 | ("^-1" . ("⁻¹")) 348 | ("-2" . ("⁻²" "₋₂")) 349 | ("-3" . ("⁻³")) 350 | ("qed" . ("∎")) 351 | ("x" . ("×")) 352 | ("o" . ("∘")) 353 | ("comp" . ("∘")) 354 | ("." . ("∙")) 355 | ("*" . ("⋆")) 356 | (".+" . ("∔")) 357 | (".-" . ("∸")) 358 | (":" . ("∶")) 359 | ("::" . ("∷")) 360 | ("::-" . ("∺")) 361 | ("-:" . ("∹")) 362 | ("+ " . ("⊹")) 363 | ("surd3" . ("∛")) 364 | ("surd4" . ("∜")) 365 | ("increment" . ("∆")) 366 | ("inf" . ("∞")) 367 | ("&" . ("⅋")) 368 | ("od" . ("ᵒᵈ")) 369 | ("aop" . ("ᵃᵒᵖ")) 370 | ("mop" . ("ᵐᵒᵖ")) 371 | ("op" . ("ᵒᵖ")) 372 | 373 | ;; Circled operators. 374 | 375 | ("o+" . ("⊕")) 376 | ("o--" . ("⊖")) 377 | ("ox" . ("⊗")) 378 | ("o/" . ("⊘")) 379 | ("o." . ("⊙")) 380 | ("oo" . ("⊚")) 381 | ("o*" . ("∘*" "⊛")) 382 | ("o=" . ("⊜")) 383 | ("o-" . ("⊝")) 384 | 385 | ("O+" . ("⨁")) 386 | ("Ox" . ("⨂")) 387 | ("O." . ("⨀")) 388 | ("O*" . ("⍟")) 389 | 390 | ;; Boxed operators. 391 | 392 | ("b+" . ("⊞")) 393 | ("b-" . ("⊟")) 394 | ("bx" . ("⊠")) 395 | ("b." . ("⊡")) 396 | 397 | ;; Various symbols. 398 | 399 | ("integral" . ,(lean-input-to-string-list "∫∬∭∮∯∰∱∲∳")) 400 | ("angle" . ,(lean-input-to-string-list "∟∡∢⊾⊿")) 401 | ("join" . ,(lean-input-to-string-list "⋈⋉⋊⋋⋌⨝⟕⟖⟗")) 402 | 403 | ;; Arrows. 404 | ("iff" . ("↔")) ("imp" . ("→")) 405 | ("l" . ,(lean-input-to-string-list "←⇐⇚⇇⇆↤⇦↞↼↽⇠⇺↜⇽⟵⟸↚⇍⇷ ↹ ↢↩↫⇋⇜⇤⟻⟽⤆↶↺⟲ ")) 406 | ("r" . ,(lean-input-to-string-list "→⇒⇛⇉⇄↦⇨↠⇀⇁⇢⇻↝⇾⟶⟹↛⇏⇸⇶ ↴ ↣↪↬⇌⇝⇥⟼⟾⤇↷↻⟳⇰⇴⟴⟿ ➵➸➙➔➛➜➝➞➟➠➡➢➣➤➧➨➩➪➫➬➭➮➯➱➲➳➺➻➼➽➾⊸")) 407 | ("u" . ,(lean-input-to-string-list "↑⇑⟰⇈⇅↥⇧↟↿↾⇡⇞ ↰↱➦ ⇪⇫⇬⇭⇮⇯ ")) 408 | ("d" . ,(lean-input-to-string-list "↓⇓⟱⇊⇵↧⇩↡⇃⇂⇣⇟ ↵↲↳➥ ↯ ")) 409 | ("ud" . ,(lean-input-to-string-list "↕⇕ ↨⇳ ")) 410 | ("lr" . ,(lean-input-to-string-list "↔⇔ ⇼↭⇿⟷⟺↮⇎⇹ ")) 411 | ("ul" . ,(lean-input-to-string-list "↖⇖ ⇱↸ ")) 412 | ("ur" . ,(lean-input-to-string-list "↗⇗ ➶➹➚ ")) 413 | ("dr" . ,(lean-input-to-string-list "↘⇘ ⇲ ➴➷➘ ")) 414 | ("dl" . ,(lean-input-to-string-list "↙⇙ ")) 415 | ("==>" . ("⟹")) ("nattrans" . ("⟹")) ("nat_trans" . ("⟹")) 416 | 417 | ("l-" . ("←")) ("<-" . ("←")) ("l=" . ("⇐")) 418 | ("r-" . ("→")) ("->" . ("→")) ("r=" . ("⇒")) ("=>" . ("⇒")) ("functor" . ("⥤")) 419 | ("u-" . ("↑")) ("u=" . ("⇑")) 420 | ("d-" . ("↓")) ("d=" . ("⇓")) 421 | ("ud-" . ("↕")) ("ud=" . ("⇕")) 422 | ("lr-" . ("↔")) ("<->" . ("↔")) ("lr=" . ("⇔")) ("<=>" . ("⇔")) 423 | ("ul-" . ("↖")) ("ul=" . ("⇖")) 424 | ("ur-" . ("↗")) ("ur=" . ("⇗")) 425 | ("dr-" . ("↘")) ("dr=" . ("⇘")) 426 | ("dl-" . ("↙")) ("dl=" . ("⇙")) 427 | 428 | ("l==" . ("⇚")) ("l-2" . ("⇇")) ("l-r-" . ("⇆")) 429 | ("r==" . ("⇛")) ("r-2" . ("⇉")) ("r-3" . ("⇶")) ("r-l-" . ("⇄")) 430 | ("u==" . ("⟰")) ("u-2" . ("⇈")) ("u-d-" . ("⇅")) 431 | ("d==" . ("⟱")) ("d-2" . ("⇊")) ("d-u-" . ("⇵")) 432 | 433 | ("l--" . ("⟵")) ("<--" . ("⟵")) ("l~" . ("↜" "⇜")) 434 | ("r--" . ("⟶")) ("-->" . ("⟶")) ("r~" . ("↝" "⇝" "⟿")) ("hom" . ("⟶")) 435 | ("lr--" . ("⟷")) ("<-->" . ("⟷")) ("lr~" . ("↭")) 436 | 437 | ("l-n" . ("↚")) ("<-n" . ("↚")) ("l=n" . ("⇍")) 438 | ("r-n" . ("↛")) ("->n" . ("↛")) ("r=n" . ("⇏")) ("=>n" . ("⇏")) 439 | ("lr-n" . ("↮")) ("<->n" . ("↮")) ("lr=n" . ("⇎")) ("<=>n" . ("⇎")) 440 | 441 | ("l-|" . ("↤")) ("ll-" . ("↞")) 442 | ("r-|" . ("↦")) ("rr-" . ("↠")) 443 | ("u-|" . ("↥")) ("uu-" . ("↟")) 444 | ("d-|" . ("↧")) ("dd-" . ("↡")) 445 | ("ud-|" . ("↨")) 446 | 447 | ("l->" . ("↢")) 448 | ("r->" . ("↣")) 449 | 450 | ("r-o" . ("⊸")) ("-o" . ("⊸")) 451 | 452 | ("dz" . ("↯")) 453 | 454 | ;; Ellipsis. 455 | 456 | ("..." . ,(lean-input-to-string-list "⋯⋮⋰⋱")) 457 | 458 | ;; Box-drawing characters. 459 | 460 | ("---" . ,(lean-input-to-string-list "─│┌┐└┘├┤┬┼┴╴╵╶╷╭╮╯╰╱╲╳")) 461 | ("--=" . ,(lean-input-to-string-list "═║╔╗╚╝╠╣╦╬╩ ╒╕╘╛╞╡╤╪╧ ╓╖╙╜╟╢╥╫╨")) 462 | ("--_" . ,(lean-input-to-string-list "━┃┏┓┗┛┣┫┳╋┻╸╹╺╻ 463 | ┍┯┑┕┷┙┝┿┥┎┰┒┖┸┚┠╂┨┞╀┦┟╁┧┢╈┪┡╇┩ 464 | ┮┭┶┵┾┽┲┱┺┹╊╉╆╅╄╃ ╿╽╼╾")) 465 | ("--." . ,(lean-input-to-string-list "╌╎┄┆┈┊ 466 | ╍╏┅┇┉┋")) 467 | 468 | ;; Triangles. 469 | 470 | ;; Big/small, black/white. 471 | 472 | ("t" . ,(lean-input-to-string-list "▸▹►▻◂◃◄◅▴▵▾▿◢◿◣◺◤◸◥◹")) 473 | ("Tr" . ,(lean-input-to-string-list "◀◁▶▷▲△▼▽◬◭◮")) 474 | 475 | ("tb" . ,(lean-input-to-string-list "◂▸▴▾◄►◢◣◤◥")) 476 | ("tw" . ,(lean-input-to-string-list "◃▹▵▿◅▻◿◺◸◹")) 477 | 478 | ("Tb" . ,(lean-input-to-string-list "◀▶▲▼")) 479 | ("Tw" . ,(lean-input-to-string-list "◁▷△▽")) 480 | 481 | ;; Squares. 482 | 483 | ("sq" . ,(lean-input-to-string-list "◾◽■□◼◻▣▢▤▥▦▧▨▩◧◨◩◪◫◰◱◲◳")) 484 | ("sqb" . ,(lean-input-to-string-list "■◼◾")) 485 | ("sqw" . ,(lean-input-to-string-list "□◻◽")) 486 | ("sq." . ("▣")) 487 | ("sqo" . ("▢")) 488 | 489 | ;; Rectangles. 490 | 491 | ("re" . ,(lean-input-to-string-list "▬▭▮▯")) 492 | ("reb" . ,(lean-input-to-string-list "▬▮")) 493 | ("rew" . ,(lean-input-to-string-list "▭▯")) 494 | 495 | ;; Parallelograms. 496 | 497 | ("pa" . ,(lean-input-to-string-list "▰▱")) 498 | ("pab" . ("▰")) 499 | ("paw" . ("▱")) 500 | 501 | ;; Diamonds. 502 | 503 | ("di" . ,(lean-input-to-string-list "◆◇◈")) 504 | ("dib" . ("◆")) 505 | ("diw" . ("◇")) 506 | ("di." . ("◈")) 507 | 508 | ;; Circles. 509 | 510 | ("ci" . ,(lean-input-to-string-list "●○◎◌◯◍◐◑◒◓◔◕◖◗◠◡◴◵◶◷⚆⚇⚈⚉")) 511 | ("cib" . ("●")) 512 | ("ciw" . ("○")) 513 | ("ci." . ("◎")) 514 | ("ci.." . ("◌")) 515 | ("ciO" . ("◯")) 516 | 517 | ;; Stars. 518 | 519 | ("st" . ,(lean-input-to-string-list "⋆✦✧✶✴✹ ★☆✪✫✯✰✵✷✸")) 520 | ("st4" . ,(lean-input-to-string-list "✦✧")) 521 | ("st6" . ("✶")) 522 | ("st8" . ("✴")) 523 | ("st12" . ("✹")) 524 | 525 | ;; Blackboard bold letters. 526 | 527 | ("bn" . ("ℕ")) 528 | ("bz" . ("ℤ")) 529 | ("bq" . ("ℚ")) 530 | ("br" . ("ℝ")) 531 | ("bc" . ("ℂ")) 532 | ("bp" . ("ℙ")) 533 | ("bb" . ("𝔹")) 534 | ("bsum" . ("⅀")) 535 | ("bbA" . ("𝔸")) 536 | ("bbB" . ("𝔹")) 537 | ("bbC" . ("ℂ")) 538 | ("bbD" . ("𝔻")) 539 | ("bbE" . ("𝔼")) 540 | ("bbF" . ("𝔽")) 541 | ("bbG" . ("𝔾")) 542 | ("bbH" . ("ℍ")) 543 | ("bbI" . ("𝕀")) 544 | ("bbJ" . ("𝕁")) 545 | ("bbK" . ("𝕂")) 546 | ("bbL" . ("𝕃")) 547 | ("bbM" . ("𝕄")) 548 | ("bbN" . ("ℕ")) 549 | ("bbO" . ("𝕆")) 550 | ("bbP" . ("ℙ")) 551 | ("bbQ" . ("ℚ")) 552 | ("bbR" . ("ℝ")) 553 | ("bbS" . ("𝕊")) 554 | ("bbT" . ("𝕋")) 555 | ("bbU" . ("𝕌")) 556 | ("bbV" . ("𝕍")) 557 | ("bbW" . ("𝕎")) 558 | ("bbX" . ("𝕏")) 559 | ("bbY" . ("𝕐")) 560 | ("bbZ" . ("ℤ")) 561 | ("bba" . ("𝕒")) 562 | ("bbb" . ("𝕓")) 563 | ("bbc" . ("𝕔")) 564 | ("bbd" . ("𝕕")) 565 | ("bbe" . ("𝕖")) 566 | ("bbf" . ("𝕗")) 567 | ("bbg" . ("𝕘")) 568 | ("bbh" . ("𝕙")) 569 | ("bbi" . ("𝕚")) 570 | ("bbj" . ("𝕛")) 571 | ("bbk" . ("𝕜")) 572 | ("bbl" . ("𝕝")) 573 | ("bbm" . ("𝕞")) 574 | ("bbn" . ("𝕟")) 575 | ("bbo" . ("𝕠")) 576 | ("bbp" . ("𝕡")) 577 | ("bbq" . ("𝕢")) 578 | ("bbr" . ("𝕣")) 579 | ("bbs" . ("𝕤")) 580 | ("bbt" . ("𝕥")) 581 | ("bbu" . ("𝕦")) 582 | ("bbv" . ("𝕧")) 583 | ("bbw" . ("𝕨")) 584 | ("bbx" . ("𝕩")) 585 | ("bby" . ("𝕪")) 586 | ("bbz" . ("𝕫")) 587 | 588 | ;; Blackboard bold numbers. 589 | 590 | ("b0" . ("𝟘")) 591 | ("b1" . ("𝟙")) 592 | ("b2" . ("𝟚")) 593 | ("b3" . ("𝟛")) 594 | ("b4" . ("𝟜")) 595 | ("b5" . ("𝟝")) 596 | ("b6" . ("𝟞")) 597 | ("b7" . ("𝟟")) 598 | ("b8" . ("𝟠")) 599 | ("b9" . ("𝟡")) 600 | 601 | ;; Parentheses. 602 | 603 | ("(" . ,(lean-input-to-string-list "([{⁅⁽₍〈⎴⟅⟦⟨⟪⦃〈《‹«「『【〔〖〚︵︷︹︻︽︿﹁﹃﹙﹛﹝（［｛｢")) 604 | (")" . ,(lean-input-to-string-list ")]}⁆⁾₎〉⎵⟆⟧⟩⟫⦄〉》›»」』】〕〗〛︶︸︺︼︾﹀﹂﹄﹚﹜﹞）］｝｣")) 605 | 606 | ("[[" . ("⟦")) 607 | ("]]" . ("⟧")) 608 | ("<" . ("⟨")) 609 | (">" . ("⟩")) 610 | ("<<" . ("⟪")) 611 | (">>" . ("⟫")) 612 | ("f<" . ("‹")) 613 | ("f>" . ("›")) 614 | ("f<<" . ("«")) 615 | ("f>>" . ("»")) 616 | ("{{" . ("⦃")) 617 | ("}}" . ("⦄")) 618 | 619 | ("(b" . ("⟅")) 620 | (")b" . ("⟆")) 621 | 622 | ("lbag" . ("⟅")) 623 | ("rbag" . ("⟆")) 624 | 625 | ;; lambda 626 | 627 | ("fun" . ("λ")) 628 | ("lam" . ("λ")) 629 | 630 | ("X" . ("⨯")) 631 | 632 | ;; Primes. 633 | 634 | ("'" . ,(lean-input-to-string-list "′″‴⁗")) 635 | ("`" . ,(lean-input-to-string-list "‵‶‷")) 636 | 637 | ;; Fractions. 638 | 639 | ("frac" . ,(lean-input-to-string-list "¼½¾⅓⅔⅕⅖⅗⅘⅙⅚⅛⅜⅝⅞⅟")) 640 | 641 | ;; Bullets. 642 | 643 | ("bu" . ,(lean-input-to-string-list "•◦‣⁌⁍")) 644 | ("bub" . ("•")) 645 | ("buw" . ("◦")) 646 | ("but" . ("‣")) 647 | 648 | ;; Types 649 | ("nat" . ("ℕ")) 650 | ("Nat" . ("ℕ")) 651 | ("N" . ("ℕ")) 652 | ("int" . ("ℤ")) 653 | ("Int" . ("ℤ")) 654 | ("Z" . ("ℤ")) 655 | ("rat" . ("ℚ")) 656 | ("Rat" . ("ℚ")) 657 | ("Q" . ("ℚ")) 658 | ("real" . ("ℝ")) 659 | ("Real" . ("ℝ")) 660 | ("R" . ("ℝ")) 661 | ("Com" . ("ℂ")) 662 | ("com" . ("ℂ")) 663 | ("C" . ("ℂ")) 664 | ("A" . ("𝔸")) 665 | ("F" . ("𝔽")) 666 | ("H" . ("ℍ")) 667 | ("K" . ("𝕂")) 668 | 669 | ("a" . ("α")) 670 | ("b" . ("β")) 671 | ("g" . ("γ")) 672 | 673 | ;; Musical symbols. 674 | 675 | ("note" . ,(lean-input-to-string-list "♩♪♫♬")) 676 | ("flat" . ("♭")) 677 | ("#" . ("♯")) 678 | 679 | ;; Other punctuation and symbols. 680 | 681 | ("\\" . ("\\")) 682 | ("en" . ("–")) 683 | ("em" . ("—")) 684 | ("^i" . ("ⁱ")) 685 | ("^o" . ("ᵒ")) 686 | ("!!" . ("‼")) 687 | ("??" . ("⁇")) 688 | ("?!" . ("‽" "⁈")) 689 | ("!?" . ("⁉")) 690 | ("die" . ,(lean-input-to-string-list "⚀⚁⚂⚃⚄⚅")) 691 | ("asterisk" . ,(lean-input-to-string-list "⁎⁑⁂✢✣✤✥✱✲✳✺✻✼✽❃❉❊❋")) 692 | ("8<" . ("✂" "✄")) 693 | ("tie" . ("⁀")) 694 | ("undertie" . ("‿")) 695 | ("apl" . ,(lean-input-to-string-list "⌶⌷⌸⌹⌺⌻⌼⌽⌾⌿⍀⍁⍂⍃⍄⍅⍆⍇⍈ 696 | ⍉⍊⍋⍌⍍⍎⍏⍐⍑⍒⍓⍔⍕⍖⍗⍘⍙⍚⍛ 697 | ⍜⍝⍞⍟⍠⍡⍢⍣⍤⍥⍦⍧⍨⍩⍪⍫⍬⍭⍮ 698 | ⍯⍰⍱⍲⍳⍴⍵⍶⍷⍸⍹⍺⎕")) 699 | ("/" . ("⧸")) 700 | ("quot" . ("⧸")) 701 | 702 | ;; Some combining characters. 703 | ;; 704 | ;; The following combining characters also have (other) 705 | ;; translations: 706 | ;; ̀ ́ ̂ ̃ ̄ ̆ ̇ ̈ ̋ ̌ ̣ ̧ ̱ 707 | 708 | ("^--" . ,(lean-input-to-string-list"̅̿")) 709 | ("_--" . ,(lean-input-to-string-list"̲̳")) 710 | ("^~" . ,(lean-input-to-string-list"̃͌")) 711 | ("_~" . ( "̰")) 712 | ("^." . ,(lean-input-to-string-list"̇̈⃛⃜")) 713 | ("_." . ,(lean-input-to-string-list"̣̤")) 714 | ("^l" . ,(lean-input-to-string-list"⃖⃐⃔")) 715 | ("^l-" . ( "⃖")) 716 | ("^r" . ,(lean-input-to-string-list"⃗⃑⃕")) 717 | ("^r-" . ( "⃗")) 718 | ("^lr" . ( "⃡")) 719 | ("_lr" . ( "͍")) 720 | ("^^" . ,(lean-input-to-string-list"̂̑͆")) 721 | ("_^" . ,(lean-input-to-string-list"̭̯̪")) 722 | ("^v" . ,(lean-input-to-string-list"̌̆")) 723 | ("_v" . ,(lean-input-to-string-list"̬̮̺")) 724 | 725 | ;; Shorter forms of many greek letters plus ƛ. 726 | 727 | ("Ga" . ("α")) ("GA" . ("Α")) 728 | ("Gb" . ("β")) ("GB" . ("Β")) 729 | ("Gg" . ("γ")) ("GG" . ("Γ")) 730 | ("Gd" . ("δ")) ("GD" . ("Δ")) 731 | ("Ge" . ("ε")) ("GE" . ("Ε")) ("eps" . ("ε")) 732 | ("Gz" . ("ζ")) ("GZ" . ("Ζ")) 733 | ;; \eta \Eta 734 | ("Gth" . ("θ")) ("GTH" . ("Θ")) ("th" . ("θ")) 735 | ("Gi" . ("ι")) ("GI" . ("Ι")) 736 | ("Gk" . ("κ")) ("GK" . ("Κ")) 737 | ("Gl" . ("λ")) ("GL" . ("Λ")) ("Gl-" . ("ƛ")) 738 | ("Gm" . ("μ")) ("GM" . ("Μ")) 739 | ("Gn" . ("ν")) ("GN" . ("Ν")) 740 | ("Gx" . ("ξ")) ("GX" . ("Ξ")) 741 | ;; \omicron \Omicron 742 | ;; \pi \Pi 743 | ("Gr" . ("ρ")) ("GR" . ("Ρ")) 744 | ("Gs" . ("σ")) ("GS" . ("Σ")) 745 | ("Gt" . ("τ")) ("GT" . ("Τ")) 746 | ("Gu" . ("υ")) ("GU" . ("Υ")) 747 | ("Gf" . ("φ")) ("GF" . ("Φ")) 748 | ("Gc" . ("χ")) ("GC" . ("Χ")) 749 | ("Gp" . ("ψ")) ("GP" . ("Ψ")) 750 | ("Go" . ("ω")) ("GO" . ("Ω")) 751 | ;; even shorter versions for central type constructors 752 | ("S" . ("Σ")) ("P" . ("Π")) 753 | 754 | ;; Mathematical characters 755 | 756 | ("MiA" . ("𝐴")) 757 | ("MiB" . ("𝐵")) 758 | ("MiC" . ("𝐶")) 759 | ("MiD" . ("𝐷")) 760 | ("MiE" . ("𝐸")) 761 | ("MiF" . ("𝐹")) 762 | ("MiG" . ("𝐺")) 763 | ("MiH" . ("𝐻")) 764 | ("MiI" . ("𝐼")) 765 | ("MiJ" . ("𝐽")) 766 | ("MiK" . ("𝐾")) 767 | ("MiL" . ("𝐿")) 768 | ("MiM" . ("𝑀")) 769 | ("MiN" . ("𝑁")) 770 | ("MiO" . ("𝑂")) 771 | ("MiP" . ("𝑃")) 772 | ("MiQ" . ("𝑄")) 773 | ("MiR" . ("𝑅")) 774 | ("MiS" . ("𝑆")) 775 | ("MiT" . ("𝑇")) 776 | ("MiU" . ("𝑈")) 777 | ("MiV" . ("𝑉")) 778 | ("MiW" . ("𝑊")) 779 | ("MiX" . ("𝑋")) 780 | ("MiY" . ("𝑌")) 781 | ("MiZ" . ("𝑍")) 782 | ("Mia" . ("𝑎")) 783 | ("Mib" . ("𝑏")) 784 | ("Mic" . ("𝑐")) 785 | ("Mid" . ("𝑑")) 786 | ("Mie" . ("𝑒")) 787 | ("Mif" . ("𝑓")) 788 | ("Mig" . ("𝑔")) 789 | ("Mii" . ("𝑖")) 790 | ("Mij" . ("𝑗")) 791 | ("Mik" . ("𝑘")) 792 | ("Mil" . ("𝑙")) 793 | ("Mim" . ("𝑚")) 794 | ("Min" . ("𝑛")) 795 | ("Mio" . ("𝑜")) 796 | ("Mip" . ("𝑝")) 797 | ("Miq" . ("𝑞")) 798 | ("Mir" . ("𝑟")) 799 | ("Mis" . ("𝑠")) 800 | ("Mit" . ("𝑡")) 801 | ("Miu" . ("𝑢")) 802 | ("Miv" . ("𝑣")) 803 | ("Miw" . ("𝑤")) 804 | ("Mix" . ("𝑥")) 805 | ("Miy" . ("𝑦")) 806 | ("Miz" . ("𝑧")) 807 | ("MIA" . ("𝑨")) 808 | ("MIB" . ("𝑩")) 809 | ("MIC" . ("𝑪")) 810 | ("MID" . ("𝑫")) 811 | ("MIE" . ("𝑬")) 812 | ("MIF" . ("𝑭")) 813 | ("MIG" . ("𝑮")) 814 | ("MIH" . ("𝑯")) 815 | ("MII" . ("𝑰")) 816 | ("MIJ" . ("𝑱")) 817 | ("MIK" . ("𝑲")) 818 | ("MIL" . ("𝑳")) 819 | ("MIM" . ("𝑴")) 820 | ("MIN" . ("𝑵")) 821 | ("MIO" . ("𝑶")) 822 | ("MIP" . ("𝑷")) 823 | ("MIQ" . ("𝑸")) 824 | ("MIR" . ("𝑹")) 825 | ("MIS" . ("𝑺")) 826 | ("MIT" . ("𝑻")) 827 | ("MIU" . ("𝑼")) 828 | ("MIV" . ("𝑽")) 829 | ("MIW" . ("𝑾")) 830 | ("MIX" . ("𝑿")) 831 | ("MIY" . ("𝒀")) 832 | ("MIZ" . ("𝒁")) 833 | ("MIa" . ("𝒂")) 834 | ("MIb" . ("𝒃")) 835 | ("MIc" . ("𝒄")) 836 | ("MId" . ("𝒅")) 837 | ("MIe" . ("𝒆")) 838 | ("MIf" . ("𝒇")) 839 | ("MIg" . ("𝒈")) 840 | ("MIh" . ("𝒉")) 841 | ("MIi" . ("𝒊")) 842 | ("MIj" . ("𝒋")) 843 | ("MIk" . ("𝒌")) 844 | ("MIl" . ("𝒍")) 845 | ("MIm" . ("𝒎")) 846 | ("MIn" . ("𝒏")) 847 | ("MIo" . ("𝒐")) 848 | ("MIp" . ("𝒑")) 849 | ("MIq" . ("𝒒")) 850 | ("MIr" . ("𝒓")) 851 | ("MIs" . ("𝒔")) 852 | ("MIt" . ("𝒕")) 853 | ("MIu" . ("𝒖")) 854 | ("MIv" . ("𝒗")) 855 | ("MIw" . ("𝒘")) 856 | ("MIx" . ("𝒙")) 857 | ("MIy" . ("𝒚")) 858 | ("MIz" . ("𝒛")) 859 | ("McA" . ("𝒜")) 860 | ("McC" . ("𝒞")) 861 | ("McD" . ("𝒟")) 862 | ("McG" . ("𝒢")) 863 | ("McJ" . ("𝒥")) 864 | ("McK" . ("𝒦")) 865 | ("McN" . ("𝒩")) 866 | ("McO" . ("𝒪")) 867 | ("McP" . ("𝒫")) 868 | ("McQ" . ("𝒬")) 869 | ("McS" . ("𝒮")) 870 | ("McT" . ("𝒯")) 871 | ("McU" . ("𝒰")) 872 | ("McV" . ("𝒱")) 873 | ("McW" . ("𝒲")) 874 | ("McX" . ("𝒳")) 875 | ("McY" . ("𝒴")) 876 | ("McZ" . ("𝒵")) 877 | ("Mca" . ("𝒶")) 878 | ("Mcb" . ("𝒷")) 879 | ("Mcc" . ("𝒸")) 880 | ("Mcd" . ("𝒹")) 881 | ("Mcf" . ("𝒻")) 882 | ("Mch" . ("𝒽")) 883 | ("Mci" . ("𝒾")) 884 | ("Mcj" . ("𝒿")) 885 | ("Mck" . ("𝓀")) 886 | ("Mcl" . ("𝓁")) 887 | ("Mcm" . ("𝓂")) 888 | ("Mcn" . ("𝓃")) 889 | ("Mcp" . ("𝓅")) 890 | ("Mcq" . ("𝓆")) 891 | ("Mcr" . ("𝓇")) 892 | ("Mcs" . ("𝓈")) 893 | ("Mct" . ("𝓉")) 894 | ("Mcu" . ("𝓊")) 895 | ("Mcv" . ("𝓋")) 896 | ("Mcw" . ("𝓌")) 897 | ("Mcx" . ("𝓍")) 898 | ("Mcy" . ("𝓎")) 899 | ("Mcz" . ("𝓏")) 900 | ("MCA" . ("𝓐")) 901 | ("MCB" . ("𝓑")) 902 | ("MCC" . ("𝓒")) 903 | ("MCD" . ("𝓓")) 904 | ("MCE" . ("𝓔")) 905 | ("MCF" . ("𝓕")) 906 | ("MCG" . ("𝓖")) 907 | ("MCH" . ("𝓗")) 908 | ("MCI" . ("𝓘")) 909 | ("MCJ" . ("𝓙")) 910 | ("MCK" . ("𝓚")) 911 | ("MCL" . ("𝓛")) 912 | ("MCM" . ("𝓜")) 913 | ("MCN" . ("𝓝")) 914 | ("MCO" . ("𝓞")) 915 | ("MCP" . ("𝓟")) 916 | ("MCQ" . ("𝓠")) 917 | ("MCR" . ("𝓡")) 918 | ("MCS" . ("𝓢")) 919 | ("MCT" . ("𝓣")) 920 | ("MCU" . ("𝓤")) 921 | ("MCV" . ("𝓥")) 922 | ("MCW" . ("𝓦")) 923 | ("MCX" . ("𝓧")) 924 | ("MCY" . ("𝓨")) 925 | ("MCZ" . ("𝓩")) 926 | ("MCa" . ("𝓪")) 927 | ("MCb" . ("𝓫")) 928 | ("MCc" . ("𝓬")) 929 | ("MCd" . ("𝓭")) 930 | ("MCe" . ("𝓮")) 931 | ("MCf" . ("𝓯")) 932 | ("MCg" . ("𝓰")) 933 | ("MCh" . ("𝓱")) 934 | ("MCi" . ("𝓲")) 935 | ("MCj" . ("𝓳")) 936 | ("MCk" . ("𝓴")) 937 | ("MCl" . ("𝓵")) 938 | ("MCm" . ("𝓶")) 939 | ("MCn" . ("𝓷")) 940 | ("MCo" . ("𝓸")) 941 | ("MCp" . ("𝓹")) 942 | ("MCq" . ("𝓺")) 943 | ("MCr" . ("𝓻")) 944 | ("MCs" . ("𝓼")) 945 | ("MCt" . ("𝓽")) 946 | ("MCu" . ("𝓾")) 947 | ("MCv" . ("𝓿")) 948 | ("MCw" . ("𝔀")) 949 | ("MCx" . ("𝔁")) 950 | ("MCy" . ("𝔂")) 951 | ("MCz" . ("𝔃")) 952 | ("MfA" . ("𝔄")) 953 | ("MfB" . ("𝔅")) 954 | ("MfD" . ("𝔇")) 955 | ("MfE" . ("𝔈")) 956 | ("MfF" . ("𝔉")) 957 | ("MfG" . ("𝔊")) 958 | ("MfJ" . ("𝔍")) 959 | ("MfK" . ("𝔎")) 960 | ("MfL" . ("𝔏")) 961 | ("MfM" . ("𝔐")) 962 | ("MfN" . ("𝔑")) 963 | ("MfO" . ("𝔒")) 964 | ("MfP" . ("𝔓")) 965 | ("MfQ" . ("𝔔")) 966 | ("MfS" . ("𝔖")) 967 | ("MfT" . ("𝔗")) 968 | ("MfU" . ("𝔘")) 969 | ("MfV" . ("𝔙")) 970 | ("MfW" . ("𝔚")) 971 | ("MfX" . ("𝔛")) 972 | ("MfY" . ("𝔜")) 973 | ("Mfa" . ("𝔞")) 974 | ("Mfb" . ("𝔟")) 975 | ("Mfc" . ("𝔠")) 976 | ("Mfd" . ("𝔡")) 977 | ("Mfe" . ("𝔢")) 978 | ("Mff" . ("𝔣")) 979 | ("Mfg" . ("𝔤")) 980 | ("Mfh" . ("𝔥")) 981 | ("Mfi" . ("𝔦")) 982 | ("Mfj" . ("𝔧")) 983 | ("Mfk" . ("𝔨")) 984 | ("Mfl" . ("𝔩")) 985 | ("Mfm" . ("𝔪")) 986 | ("Mfn" . ("𝔫")) 987 | ("Mfo" . ("𝔬")) 988 | ("Mfp" . ("𝔭")) 989 | ("Mfq" . ("𝔮")) 990 | ("Mfr" . ("𝔯")) 991 | ("Mfs" . ("𝔰")) 992 | ("Mft" . ("𝔱")) 993 | ("Mfu" . ("𝔲")) 994 | ("Mfv" . ("𝔳")) 995 | ("Mfw" . ("𝔴")) 996 | ("Mfx" . ("𝔵")) 997 | ("Mfy" . ("𝔶")) 998 | ("Mfz" . ("𝔷")) 999 | 1000 | ;; Some ISO8859-1 characters. 1001 | 1002 | (" " . (" ")) 1003 | ("!" . ("¡")) 1004 | ("cent" . ("¢")) 1005 | ("brokenbar" . ("¦")) 1006 | ("degree" . ("°")) 1007 | ("?" . ("¿")) 1008 | ("^a_" . ("ª")) 1009 | ("^o_" . ("º")) 1010 | 1011 | ;; Circled, parenthesised etc. numbers and letters. 1012 | 1013 | ( "(0)" . ,(lean-input-to-string-list " ⓪")) 1014 | ( "(1)" . ,(lean-input-to-string-list "⑴①⒈❶➀➊")) 1015 | ( "(2)" . ,(lean-input-to-string-list "⑵②⒉❷➁➋")) 1016 | ( "(3)" . ,(lean-input-to-string-list "⑶③⒊❸➂➌")) 1017 | ( "(4)" . ,(lean-input-to-string-list "⑷④⒋❹➃➍")) 1018 | ( "(5)" . ,(lean-input-to-string-list "⑸⑤⒌❺➄➎")) 1019 | ( "(6)" . ,(lean-input-to-string-list "⑹⑥⒍❻➅➏")) 1020 | ( "(7)" . ,(lean-input-to-string-list "⑺⑦⒎❼➆➐")) 1021 | ( "(8)" . ,(lean-input-to-string-list "⑻⑧⒏❽➇➑")) 1022 | ( "(9)" . ,(lean-input-to-string-list "⑼⑨⒐❾➈➒")) 1023 | ("(10)" . ,(lean-input-to-string-list "⑽⑩⒑❿➉➓")) 1024 | ("(11)" . ,(lean-input-to-string-list "⑾⑪⒒")) 1025 | ("(12)" . ,(lean-input-to-string-list "⑿⑫⒓")) 1026 | ("(13)" . ,(lean-input-to-string-list "⒀⑬⒔")) 1027 | ("(14)" . ,(lean-input-to-string-list "⒁⑭⒕")) 1028 | ("(15)" . ,(lean-input-to-string-list "⒂⑮⒖")) 1029 | ("(16)" . ,(lean-input-to-string-list "⒃⑯⒗")) 1030 | ("(17)" . ,(lean-input-to-string-list "⒄⑰⒘")) 1031 | ("(18)" . ,(lean-input-to-string-list "⒅⑱⒙")) 1032 | ("(19)" . ,(lean-input-to-string-list "⒆⑲⒚")) 1033 | ("(20)" . ,(lean-input-to-string-list "⒇⑳⒛")) 1034 | 1035 | ("(a)" . ,(lean-input-to-string-list "⒜Ⓐⓐ")) 1036 | ("(b)" . ,(lean-input-to-string-list "⒝Ⓑⓑ")) 1037 | ("(c)" . ,(lean-input-to-string-list "⒞Ⓒⓒ")) 1038 | ("(d)" . ,(lean-input-to-string-list "⒟Ⓓⓓ")) 1039 | ("(e)" . ,(lean-input-to-string-list "⒠Ⓔⓔ")) 1040 | ("(f)" . ,(lean-input-to-string-list "⒡Ⓕⓕ")) 1041 | ("(g)" . ,(lean-input-to-string-list "⒢Ⓖⓖ")) 1042 | ("(h)" . ,(lean-input-to-string-list "⒣Ⓗⓗ")) 1043 | ("(i)" . ,(lean-input-to-string-list "⒤Ⓘⓘ")) 1044 | ("(j)" . ,(lean-input-to-string-list "⒥Ⓙⓙ")) 1045 | ("(k)" . ,(lean-input-to-string-list "⒦Ⓚⓚ")) 1046 | ("(l)" . ,(lean-input-to-string-list "⒧Ⓛⓛ")) 1047 | ("(m)" . ,(lean-input-to-string-list "⒨Ⓜⓜ")) 1048 | ("(n)" . ,(lean-input-to-string-list "⒩Ⓝⓝ")) 1049 | ("(o)" . ,(lean-input-to-string-list "⒪Ⓞⓞ")) 1050 | ("(p)" . ,(lean-input-to-string-list "⒫Ⓟⓟ")) 1051 | ("(q)" . ,(lean-input-to-string-list "⒬Ⓠⓠ")) 1052 | ("(r)" . ,(lean-input-to-string-list "⒭Ⓡⓡ")) 1053 | ("(s)" . ,(lean-input-to-string-list "⒮Ⓢⓢ")) 1054 | ("(t)" . ,(lean-input-to-string-list "⒯Ⓣⓣ")) 1055 | ("(u)" . ,(lean-input-to-string-list "⒰Ⓤⓤ")) 1056 | ("(v)" . ,(lean-input-to-string-list "⒱Ⓥⓥ")) 1057 | ("(w)" . ,(lean-input-to-string-list "⒲Ⓦⓦ")) 1058 | ("(x)" . ,(lean-input-to-string-list "⒳Ⓧⓧ")) 1059 | ("(y)" . ,(lean-input-to-string-list "⒴Ⓨⓨ")) 1060 | ("(z)" . ,(lean-input-to-string-list "⒵Ⓩⓩ")) 1061 | ("y" . ("ɏ")) 1062 | 1063 | ;; Mathlib-specific (combinations of) characters. 1064 | 1065 | ("allf" . ("∀ᶠ")) 1066 | ("all^f" . ("∀ᶠ")) 1067 | ("allm" . ("∀ₘ")) 1068 | ("all_m" . ("∀ₘ")) 1069 | ("Pi0" . ("Π₀")) 1070 | ("P0" . ("Π₀")) 1071 | ("Pi_0" . ("Π₀")) 1072 | ("P_0" . ("Π₀")) 1073 | ("to0" . ("→₀")) 1074 | ("r0" . ("→₀")) 1075 | ("to_0" . ("→₀")) 1076 | ("r_0" . ("→₀")) 1077 | ("finsupp" . ("→₀")) 1078 | ("to1" . ("→₁")) 1079 | ("r1" . ("→₁")) 1080 | ("to_1" . ("→₁")) 1081 | ("r_1" . ("→₁")) 1082 | ("l1" . ("→₁")) 1083 | ("to1s" . ("→₁ₛ")) 1084 | ("r1s" . ("→₁ₛ")) 1085 | ("to_1s" . ("→₁ₛ")) 1086 | ("r_1s" . ("→₁ₛ")) 1087 | ("l1simplefunc" . ("→₁ₛ")) 1088 | ("toa" . ("→ₐ")) 1089 | ("ra" . ("→ₐ")) 1090 | ("to_a" . ("→ₐ")) 1091 | ("r_a" . ("→ₐ")) 1092 | ("alghom" . ("→ₐ")) 1093 | ("tob" . ("→ᵇ")) 1094 | ("rb" . ("→ᵇ")) 1095 | ("to^b" . ("→ᵇ")) 1096 | ("r^b" . ("→ᵇ")) 1097 | ("boundedcontinuousfunction" . ("→ᵇ")) 1098 | ("tol" . ("→ₗ")) 1099 | ("rl" . ("→ₗ")) 1100 | ("to_l" . ("→ₗ")) 1101 | ("r_l" . ("→ₗ")) 1102 | ("linearmap" . ("→ₗ")) 1103 | ("tom" . ("→ₘ")) 1104 | ("rm" . ("→ₘ")) 1105 | ("to_m" . ("→ₘ")) 1106 | ("r_m" . ("→ₘ")) 1107 | ("aeeqfun" . ("→ₘ")) 1108 | ("rp" . ("→ₚ")) 1109 | ("to_p" . ("→ₚ")) 1110 | ("r_p" . ("→ₚ")) 1111 | ("dfinsupp" . ("→ₚ")) 1112 | ("tos" . ("→ₛ")) 1113 | ("rs" . ("→ₛ")) 1114 | ("to_s" . ("→ₛ")) 1115 | ("r_s" . ("→ₛ")) 1116 | ("simplefunc" . ("→ₛ")) 1117 | ("root" . ("√")) 1118 | ("sqrt" . ("√")) 1119 | ("boxmid" . ("◫")) 1120 | ("hcomp" . ("◫")) 1121 | ("Rge0" . ("ℝ≥0")) 1122 | ("R>=0" . ("ℝ≥0")) 1123 | ("nnreal" . ("ℝ≥0")) 1124 | ("Zsqrt" . ("ℤ√")) 1125 | ("zsqrtd" . ("ℤ√")) 1126 | ("liel" . ("⁅")) 1127 | ("[-" . ("⁅")) 1128 | ("bracketl" . ("⁅")) 1129 | ("lier" . ("⁆")) 1130 | ("-]" . ("⁆")) 1131 | ("bracketr" . ("⁆")) 1132 | ("nhds" . ("𝓝")) 1133 | ("nbhds" . ("𝓝")) 1134 | ("X" . ("×")) 1135 | ("vectorproduct" . ("⨯")) 1136 | ("crossproduct" . ("⨯")) 1137 | ("coprod" . ("⨿")) 1138 | ("sigmaobj" . ("∐")) 1139 | ("bigcoprod" . ("∐")) 1140 | ("xf" . ("×ᶠ")) 1141 | ("exf" . ("∃ᶠ")) 1142 | ("specializes" . ("⤳")) 1143 | )) 1144 | "A list of translations specific to the Lean input method. 1145 | Each element is a pair (KEY-SEQUENCE-STRING . LIST-OF-TRANSLATION-STRINGS). 1146 | All the translation strings are possible translations 1147 | of the given key sequence; if there is more than one you can choose 1148 | between them using the arrow keys. 1149 | 1150 | Note that if you customize this setting you will not 1151 | automatically benefit (or suffer) from modifications to its 1152 | default value when the library is updated. If you just want to 1153 | add some bindings it is probably a better idea to customize 1154 | `lean-input-user-translations'. 1155 | 1156 | These translation pairs are included after those in 1157 | `lean-input-user-translations', but before the ones inherited 1158 | from other input methods (see `lean-input-inherit'). 1159 | 1160 | If you change this setting manually (without using the 1161 | customization buffer) you need to call `lean-input-setup' in 1162 | order for the change to take effect." 1163 | :group 'lean-input 1164 | :set 'lean-input-incorporate-changed-setting 1165 | :initialize 'custom-initialize-default 1166 | :type '(repeat (cons (string :tag "Key sequence") 1167 | (repeat :tag "Translations" string)))) 1168 | 1169 | (defcustom lean-input-user-translations nil 1170 | "Like `lean-input-translations', but more suitable for user 1171 | customizations since by default it is empty. 1172 | 1173 | These translation pairs are included first, before those in 1174 | `lean-input-translations' and the ones inherited from other input 1175 | methods." 1176 | :group 'lean-input 1177 | :set 'lean-input-incorporate-changed-setting 1178 | :initialize 'custom-initialize-default 1179 | :type '(repeat (cons (string :tag "Key sequence") 1180 | (repeat :tag "Translations" string)))) 1181 | 1182 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 1183 | ;; Inspecting and modifying translation maps 1184 | 1185 | (defun lean-input-get-translations (qp) 1186 | "Return a list containing all translations from the Quail 1187 | package QP (except for those corresponding to ASCII). 1188 | Each pair in the list has the form (KEY-SEQUENCE . TRANSLATION)." 1189 | (with-temp-buffer 1190 | (activate-input-method qp) ; To make sure that the package is loaded. 1191 | (unless (quail-package qp) 1192 | (error "%s is not a Quail package." qp)) 1193 | (let ((decode-map (list 'decode-map))) 1194 | (quail-build-decode-map (list (quail-map)) "" decode-map 0) 1195 | (cdr decode-map)))) 1196 | 1197 | (defun lean-input-show-translations (qp) 1198 | "Display all translations used by the Quail package QP (a string). 1199 | \(Except for those corresponding to ASCII)." 1200 | (interactive (list (read-input-method-name 1201 | "Quail input method (default %s): " "Lean"))) 1202 | (let ((buf (concat "*" qp " input method translations*"))) 1203 | (with-output-to-temp-buffer buf 1204 | (with-current-buffer buf 1205 | (quail-insert-decode-map 1206 | (cons 'decode-map (lean-input-get-translations qp))))))) 1207 | 1208 | (defun lean-input-add-translations (trans) 1209 | "Add the given translations TRANS to the Lean input method. 1210 | TRANS is a list of pairs (KEY-SEQUENCE . TRANSLATION). The 1211 | translations are appended to the current translations." 1212 | (with-temp-buffer 1213 | (dolist (tr (lean-input-concat-map (eval lean-input-tweak-all) trans)) 1214 | (quail-defrule (car tr) (cdr tr) "Lean" t)))) 1215 | 1216 | (defun lean-input-inherit-package (qp &optional fun) 1217 | "Let the Lean input method inherit the translations from the 1218 | Quail package QP (except for those corresponding to ASCII). 1219 | 1220 | The optional function FUN can be used to modify the translations. 1221 | It is given a pair (KEY-SEQUENCE . TRANSLATION) and should return 1222 | a list of such pairs." 1223 | (let ((trans (lean-input-get-translations qp))) 1224 | (lean-input-add-translations 1225 | (if fun (lean-input-concat-map fun trans) 1226 | trans)))) 1227 | 1228 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 1229 | ;; Setting up the input method 1230 | 1231 | (defun lean-input-setup () 1232 | "Set up the Lean input method based on the customisable 1233 | variables and underlying input methods." 1234 | 1235 | ;; Create (or reset) the input method. 1236 | (with-temp-buffer 1237 | (quail-define-package "Lean" "UTF-8" "∏" t ; guidance 1238 | "Lean input method. 1239 | The purpose of this input method is to edit Lean programs, but 1240 | since it is highly customisable it can be made useful for other 1241 | tasks as well." 1242 | nil nil nil nil nil nil t ; maximum-shortest 1243 | )) 1244 | 1245 | (lean-input-add-translations 1246 | (mapcar (lambda (tr) (cons (car tr) (vconcat (cdr tr)))) 1247 | (append lean-input-user-translations 1248 | lean-input-translations))) 1249 | (dolist (def lean-input-inherit) 1250 | (lean-input-inherit-package (car def) 1251 | (eval (cdr def))))) 1252 | 1253 | (defun lean-input-incorporate-changed-setting (sym val) 1254 | "Update the Lean input method based on the customisable 1255 | variables and underlying input methods. 1256 | Suitable for use in the :set field of `defcustom'." 1257 | (set-default sym val) 1258 | (lean-input-setup)) 1259 | 1260 | ;; Set up the input method. 1261 | 1262 | (lean-input-setup) 1263 | 1264 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 1265 | ;; Administrative details 1266 | 1267 | (provide 'lean-input) 1268 | ;;; lean-input.el ends here 1269 | 1270 | (require 'dash) 1271 | 1272 | (defun lean-input-export-translations () 1273 | "Export the current translation, (input, output) pairs for 1274 | input-method, in a javascript format. It can be copy-pasted to 1275 | leanprover.github.io/tutorial/js/input-method.js" 1276 | (interactive) 1277 | (with-current-buffer 1278 | (get-buffer-create "*lean-translations*") 1279 | (let ((exclude-list '("\\newline"))) 1280 | (insert "var corrections = {") 1281 | (--each 1282 | (--filter (not (member (car it) exclude-list)) 1283 | (lean-input-get-translations "Lean")) 1284 | (let* ((input (substring (car it) 1)) 1285 | (outputs (cdr it))) 1286 | (insert (format "%s:\"" (prin1-to-string input))) 1287 | (cond ((vectorp outputs) 1288 | (insert (elt outputs 0))) 1289 | (t (insert-char outputs))) 1290 | (insert (format "\",\n" input)))) 1291 | (insert "};")))) 1292 | 1293 | (defun lean-input-export-translations-to-stdout () 1294 | (lean-input-export-translations) 1295 | (with-current-buffer "*lean-translations*" 1296 | (princ (buffer-string)))) 1297 | -------------------------------------------------------------------------------- /lean-leanpkg.el: -------------------------------------------------------------------------------- 1 | ;; -*- lexical-binding: t -*- 2 | ;; 3 | ;; Copyright (c) 2017 Microsoft Corporation. All rights reserved. 4 | ;; Released under Apache 2.0 license as described in the file LICENSE. 5 | ;; 6 | ;; Author: Gabriel Ebner 7 | ;; 8 | 9 | (require 's) 10 | (require 'json) 11 | (require 'lean-util) 12 | 13 | (defun lean-leanpkg-find-dir-in (dir) 14 | (when dir 15 | (or (lean-leanpkg-find-dir-in (f-parent dir)) 16 | (when (f-exists? (f-join dir "leanpkg.toml")) dir)))) 17 | 18 | (defun lean-leanpkg-find-dir () 19 | (and (buffer-file-name) 20 | (lean-leanpkg-find-dir-in (f-dirname (buffer-file-name))))) 21 | 22 | (defun lean-leanpkg-find-dir-safe () 23 | (or (lean-leanpkg-find-dir) 24 | (error (format "cannot find leanpkg.toml for %s" (buffer-file-name))))) 25 | 26 | (defun lean-leanpkg-executable () 27 | (lean-get-executable "leanpkg")) 28 | 29 | (defvar lean-leanpkg-running nil) 30 | (defvar-local lean-leanpkg-configure-prompt-shown nil) 31 | 32 | (defun lean-leanpkg-run (cmd &optional restart-lean-server) 33 | "Call `leanpkg $cmd`" 34 | (let ((dir (file-name-as-directory (lean-leanpkg-find-dir-safe))) 35 | (orig-buf (current-buffer))) 36 | (with-current-buffer (get-buffer-create "*leanpkg*") 37 | (let ((inhibit-read-only t)) (erase-buffer)) 38 | (switch-to-buffer-other-window (current-buffer)) 39 | (redisplay) 40 | (insert (format "> leanpkg %s\n" cmd)) 41 | (setq lean-leanpkg-running t) 42 | (let* ((default-directory dir) 43 | (out-buf (current-buffer)) 44 | (proc (start-process "leanpkg" (current-buffer) 45 | (lean-leanpkg-executable) cmd))) 46 | (comint-mode) 47 | (set-process-filter proc #'comint-output-filter) 48 | (set-process-sentinel 49 | proc (lambda (_p _e) 50 | (setq lean-leanpkg-running nil) 51 | (when restart-lean-server 52 | (with-current-buffer out-buf 53 | (insert "; restarting lean server\n")) 54 | (with-current-buffer orig-buf 55 | (lean-server-restart))) 56 | (with-current-buffer out-buf 57 | (insert "; done")))))))) 58 | 59 | (defun lean-leanpkg-configure () 60 | "Call leanpkg configure" 61 | (interactive) 62 | (lean-leanpkg-run "configure" 't)) 63 | 64 | (defun lean-leanpkg-build () 65 | "Call leanpkg build" 66 | (interactive) 67 | (lean-leanpkg-run "build")) 68 | 69 | (defun lean-leanpkg-test () 70 | "Call leanpkg test" 71 | (interactive) 72 | (lean-leanpkg-run "test")) 73 | 74 | (defun lean-leanpkg-find-path-file () 75 | (let* ((json-object-type 'plist) (json-array-type 'list) (json-false nil) 76 | (path-json (shell-command-to-string 77 | (concat (shell-quote-argument (lean-get-executable lean-executable-name)) 78 | " -p"))) 79 | (path-out (json-read-from-string path-json))) 80 | (when (and (eq major-mode 'lean-mode) 81 | (plist-get path-out :is_user_leanpkg_path) 82 | (not lean-leanpkg-running) 83 | (not lean-leanpkg-configure-prompt-shown) 84 | (setq lean-leanpkg-configure-prompt-shown t) 85 | (lean-leanpkg-find-dir) 86 | (y-or-n-p (format "Found leanpkg.toml in %s, call leanpkg configure?" (lean-leanpkg-find-dir)))) 87 | (save-match-data ; running in timer so that we don't mess up the window layout 88 | (run-at-time nil nil 89 | (lambda (buf) 90 | (with-current-buffer buf 91 | (lean-leanpkg-configure))) 92 | (current-buffer)))) 93 | (setq lean-leanpkg-configure-prompt-shown t) 94 | (plist-get path-out :leanpkg_path_file))) 95 | 96 | (provide 'lean-leanpkg) 97 | -------------------------------------------------------------------------------- /lean-message-boxes.el: -------------------------------------------------------------------------------- 1 | ;; -*- lexical-binding: t -*- 2 | ;; 3 | ;; Copyright (c) 2016 David Christiansen. 4 | ;; Released under Apache 2.0 license as described in the file LICENSE. 5 | ;; 6 | ;; Author: David Christiansen 7 | ;; 8 | ;;; Code: 9 | 10 | (require 'cl-lib) 11 | (require 's) 12 | (require 'lean-server) 13 | 14 | (defface lean-message-boxes-content-face 15 | '((t :inherit font-lock-doc-face)) 16 | "Face for Lean message box contents." 17 | :group 'lean) 18 | 19 | (defcustom lean-message-boxes-enabled-captions '("check result" "eval result" "print result" "reduce result") 20 | "Which captions should result in boxes?" 21 | :group 'lean 22 | :type '(repeat (choice (const "check result") 23 | (const "eval result") 24 | (const "print result") 25 | (const "reduce result") 26 | (const "trace output")))) 27 | 28 | (defcustom lean-message-boxes-enabledp nil 29 | "Whether or not to display message boxes." 30 | :group 'lean 31 | :type 'boolean) 32 | (make-variable-buffer-local 'lean-message-boxes-enabledp) 33 | 34 | (defun lean-message-boxes--ask-for-messages () 35 | "Get the current messages out of the Lean server session." 36 | (let ((buf (current-buffer))) 37 | (if lean-server-session 38 | (cl-remove-if-not (lambda (msg) 39 | (equal (buffer-file-name buf) 40 | (plist-get msg :file_name))) 41 | (lean-server-session-messages lean-server-session)) 42 | '()))) 43 | 44 | (defun lean-message-boxes--set-enabledp (enabledp) 45 | "Enable the boxes if ENABLEDP is non-nil." 46 | (setq lean-message-boxes-enabledp enabledp) 47 | (lean-message-boxes-display (lean-message-boxes--ask-for-messages))) 48 | 49 | (defun lean-message-boxes-toggle () 50 | "Toggle the display of message boxes." 51 | (interactive) 52 | (lean-message-boxes--set-enabledp (not lean-message-boxes-enabledp))) 53 | 54 | (defun lean-message-boxes-enable () 55 | "Enable the display of message boxes." 56 | (interactive) 57 | (lean-message-boxes--set-enabledp t)) 58 | 59 | (defun lean-message-boxes-disable () 60 | "Disable the display of message boxes." 61 | (interactive) 62 | (lean-message-boxes--set-enabledp nil)) 63 | 64 | (defun lean-message-boxes--kill-overlays () 65 | "Delete all Lean message overlays in the current buffer." 66 | (remove-overlays nil nil 'category 'lean-output)) 67 | 68 | (defun lean-message-boxes--pad-to (str width) 69 | "Pad the string STR to a particular WIDTH." 70 | (concat str (make-string (max 0 (- width (length str))) ?\ ))) 71 | 72 | (defun lean-message-boxes-display (msgs) 73 | "Show the messages MSGS in the Lean buffer as boxes when `lean-message-boxes-enabledp' is non-nil." 74 | (lean-message-boxes--kill-overlays) 75 | (when lean-message-boxes-enabledp 76 | (dolist (msg msgs) 77 | (let ((end-line (plist-get msg :end_pos_line)) 78 | (end-col (plist-get msg :end_pos_col)) 79 | (caption (plist-get msg :caption)) 80 | (text (plist-get msg :text))) 81 | (when (member caption lean-message-boxes-enabled-captions) 82 | (lean-message-boxes--make-overlay 83 | end-line end-col 84 | caption text)))))) 85 | 86 | (defun lean-message-boxes--as-string (caption str) 87 | "Construct a propertized string representing CAPTION and STR." 88 | (let* ((str-copy (s-trim str))) 89 | (put-text-property 0 (length str-copy) 90 | 'face 'lean-message-boxes-content-face 91 | str-copy) 92 | (let* ((lines (s-lines str-copy)) 93 | (w (apply #'max (mapcar #'length (cons caption lines))))) 94 | (s-join "\n" 95 | (mapcar 96 | (lambda (l) (concat "│ " (lean-message-boxes--pad-to l w))) 97 | lines))))) 98 | 99 | (defun lean-message-boxes--in-comment (pos) 100 | "Use the faces set by `font-lock-mode` to deduce whether the 101 | character at the given position is contained within a comment." 102 | (let ((faces (get-text-property pos 'face)) 103 | result) 104 | (unless (listp faces) 105 | (setq faces (list faces))) 106 | (dolist (f faces result) 107 | (setq result 108 | (or result (-contains? '(font-lock-comment-face font-lock-comment-delimiter-face) f)))))) 109 | 110 | (defun lean-message-boxes--make-overlay (end-line end-col caption text) 111 | "Construct a message box overlay at LINE and COL with CAPTION and TEXT." 112 | (let* ((end-pos (save-excursion (goto-char (point-min)) 113 | (forward-line (1- end-line)) 114 | (forward-char (1- end-col)) 115 | (while (or (looking-at-p "[[:space:]\n]") (lean-message-boxes--in-comment (point))) 116 | (forward-char -1)) 117 | (end-of-line) 118 | (point))) 119 | (overlay (make-overlay end-pos end-pos nil t t)) 120 | (as-box (concat " \n" (lean-message-boxes--as-string caption text)))) 121 | (put-text-property 0 (length as-box) 'cursor t as-box) 122 | (overlay-put overlay 'after-string as-box) 123 | (overlay-put overlay 'help-echo caption) 124 | (overlay-put overlay 'category 'lean-output))) 125 | 126 | (add-hook 'lean-server-show-message-hook 'lean-message-boxes-display) 127 | (provide 'lean-message-boxes) 128 | -------------------------------------------------------------------------------- /lean-mode.el: -------------------------------------------------------------------------------- 1 | ;;; lean-mode.el --- A major mode for the Lean 3 language -*- lexical-binding: t -*- 2 | 3 | ;; Copyright (c) 2013, 2014 Microsoft Corporation. All rights reserved. 4 | ;; Copyright (c) 2014, 2015 Soonho Kong. All rights reserved. 5 | 6 | ;; Author: Leonardo de Moura 7 | ;; Soonho Kong 8 | ;; Gabriel Ebner 9 | ;; Sebastian Ullrich 10 | ;; Maintainer: Sebastian Ullrich 11 | ;; Created: Jan 09, 2014 12 | ;; Keywords: languages 13 | ;; Package-Requires: ((emacs "24.3") (dash "2.18.0") (s "1.10.0") (f "0.19.0") (flycheck "30")) 14 | ;; URL: https://github.com/leanprover/lean-mode 15 | 16 | ;; Released under Apache 2.0 license as described in the file LICENSE. 17 | 18 | ;;; Commentary: 19 | 20 | ;; Provides a major mode for the Lean 3 programming language. 21 | 22 | ;; Provides highlighting, diagnostics, goal visualization, 23 | ;; and many other useful features for Lean users. 24 | 25 | ;; See the README.md for more advanced features and the 26 | ;; associated keybindings. 27 | 28 | ;;; Code: 29 | 30 | (require 'cl-lib) 31 | (require 'dash) 32 | (require 'pcase) 33 | (require 'flycheck) 34 | (require 'lean-eri) 35 | (require 'lean-util) 36 | (require 'lean-settings) 37 | (require 'lean-input) 38 | (require 'lean-syntax) 39 | (require 'lean-leanpkg) 40 | (require 'lean-server) 41 | (require 'lean-flycheck) 42 | (require 'lean-info) 43 | (require 'lean-hole) 44 | (require 'lean-type) 45 | (require 'lean-message-boxes) 46 | (require 'lean-right-click) 47 | (require 'lean-dev) 48 | 49 | (defun lean-compile-string (exe-name args file-name) 50 | "Concatenate EXE-NAME, ARGS, and FILE-NAME." 51 | (format "%s %s %s" exe-name args file-name)) 52 | 53 | (defun lean-create-temp-in-system-tempdir (file-name prefix) 54 | "Create a temp lean file and return its name." 55 | (make-temp-file (or prefix "flymake") nil (f-ext file-name))) 56 | 57 | (defun lean-execute (&optional arg) 58 | "Execute Lean in the current buffer." 59 | (interactive) 60 | (when (called-interactively-p 'any) 61 | (setq arg (read-string "arg: " arg))) 62 | (let ((cc compile-command) 63 | (target-file-name 64 | (or 65 | (buffer-file-name) 66 | (flymake-init-create-temp-buffer-copy 'lean-create-temp-in-system-tempdir)))) 67 | (compile (lean-compile-string 68 | (shell-quote-argument (f-full (lean-get-executable lean-executable-name))) 69 | (or arg "") 70 | (shell-quote-argument (f-full target-file-name)))) 71 | ;; restore old value 72 | (setq compile-command cc))) 73 | 74 | (defun lean-std-exe () 75 | (interactive) 76 | (lean-execute)) 77 | 78 | (defun lean-check-expansion () 79 | (interactive) 80 | (save-excursion 81 | (if (looking-at (rx symbol-start "_")) t 82 | (if (looking-at "\\_>") t 83 | (backward-char 1) 84 | (if (looking-at "\\.") t 85 | (backward-char 1) 86 | (if (looking-at "->") t nil)))))) 87 | 88 | (defun lean-tab-indent () 89 | (interactive) 90 | (cond ((looking-back (rx line-start (* white)) nil) 91 | (lean-eri-indent)) 92 | (t (indent-for-tab-command)))) 93 | 94 | (defun lean-set-keys () 95 | (local-set-key lean-keybinding-std-exe1 #'lean-std-exe) 96 | (local-set-key lean-keybinding-std-exe2 #'lean-std-exe) 97 | (local-set-key lean-keybinding-show-key #'quail-show-key) 98 | (local-set-key lean-keybinding-server-restart #'lean-server-restart) 99 | (local-set-key lean-keybinding-server-switch-version #'lean-server-switch-version) 100 | (local-set-key lean-keybinding-find-definition #'lean-find-definition) 101 | (local-set-key lean-keybinding-tab-indent #'lean-tab-indent) 102 | (local-set-key lean-keybinding-hole #'lean-hole) 103 | (local-set-key lean-keybinding-lean-toggle-show-goal #'lean-toggle-show-goal) 104 | (local-set-key lean-keybinding-lean-toggle-next-error #'lean-toggle-next-error) 105 | (local-set-key lean-keybinding-lean-message-boxes-toggle #'lean-message-boxes-toggle) 106 | (local-set-key lean-keybinding-leanpkg-configure #'lean-leanpkg-configure) 107 | (local-set-key lean-keybinding-leanpkg-build #'lean-leanpkg-build) 108 | (local-set-key lean-keybinding-leanpkg-test #'lean-leanpkg-test) 109 | ;; This only works as a mouse binding due to the event, so it is not abstracted 110 | ;; to avoid user confusion. 111 | (local-set-key (kbd "") #'lean-right-click-show-menu) 112 | ) 113 | 114 | (define-abbrev-table 'lean-abbrev-table 115 | '()) 116 | 117 | (defvar lean-mode-map (make-sparse-keymap) 118 | "Keymap used in Lean mode") 119 | 120 | (defun lean-mk-check-menu-option (text sym) 121 | `[,text (lean-set-check-mode ',sym) 122 | :style radio :selected (eq lean-server-check-mode ',sym)]) 123 | 124 | (easy-menu-define lean-mode-menu lean-mode-map 125 | "Menu for the Lean major mode" 126 | `("Lean" 127 | ["Execute lean" lean-execute t] 128 | ;; ["Create a new project" (call-interactively 'lean-project-create) (not (lean-project-inside-p))] 129 | "-----------------" 130 | ["Show type info" lean-show-type (and lean-eldoc-use eldoc-mode)] 131 | ["Toggle goal display" lean-toggle-show-goal t] 132 | ["Toggle next error display" lean-toggle-next-error t] 133 | ["Toggle message boxes" lean-message-boxes-toggle t] 134 | ["Highlight pending tasks" lean-server-toggle-show-pending-tasks 135 | :active t :style toggle :selected lean-server-show-pending-tasks] 136 | ["Find definition at point" lean-find-definition t] 137 | "-----------------" 138 | ["List of errors" flycheck-list-errors flycheck-mode] 139 | "-----------------" 140 | ["Restart lean process" lean-server-restart t] 141 | "-----------------" 142 | ,(lean-mk-check-menu-option "Check nothing" 'nothing) 143 | ,(lean-mk-check-menu-option "Check visible lines" 'visible-lines) 144 | ,(lean-mk-check-menu-option "Check visible lines and above" 'visible-lines-and-above) 145 | ,(lean-mk-check-menu-option "Check visible files" 'visible-files) 146 | ,(lean-mk-check-menu-option "Check open files" 'open-files) 147 | "-----------------" 148 | ("Configuration" 149 | ["Show type at point" 150 | lean-toggle-eldoc-mode :active t :style toggle :selected eldoc-mode]) 151 | "-----------------" 152 | ["Customize lean-mode" (customize-group 'lean) t])) 153 | 154 | (defconst lean-hooks-alist 155 | '( 156 | ;; server 157 | ;; (kill-buffer-hook . lean-server-stop) 158 | (after-change-functions . lean-server-change-hook) 159 | (focus-in-hook . lean-server-show-messages) 160 | (window-scroll-functions . lean-server-window-scroll-function-hook) 161 | ;; Handle events that may start automatic syntax checks 162 | (before-save-hook . lean-whitespace-cleanup) 163 | ;; info windows 164 | (post-command-hook . lean-show-goal--handler) 165 | (post-command-hook . lean-next-error--handler) 166 | (flycheck-after-syntax-check-hook . lean-show-goal--handler) 167 | (flycheck-after-syntax-check-hook . lean-next-error--handler) 168 | ) 169 | "Hooks which lean-mode needs to hook in. 170 | 171 | The `car' of each pair is a hook variable, the `cdr' a function 172 | to be added or removed from the hook variable if Flycheck mode is 173 | enabled and disabled respectively.") 174 | 175 | (defun lean-mode-setup () 176 | "Default lean-mode setup" 177 | ;; server 178 | (ignore-errors (lean-server-ensure-alive)) 179 | (setq mode-name '("Lean" (:eval (lean-server-status-string)))) 180 | ;; Right click menu sources 181 | (setq lean-right-click-item-functions '(lean-info-right-click-find-definition 182 | lean-hole-right-click)) 183 | ;; Flycheck 184 | (lean-flycheck-turn-on) 185 | (setq-local flycheck-disabled-checkers '()) 186 | ;; info buffers 187 | (lean-ensure-info-buffer lean-next-error-buffer-name) 188 | (lean-ensure-info-buffer lean-show-goal-buffer-name) 189 | ;; eldoc 190 | (when lean-eldoc-use 191 | (cond ((<= emacs-major-version 27) 192 | (set (make-local-variable 'eldoc-documentation-function) 193 | 'lean-eldoc-documentation-function)) 194 | (t (add-hook 'eldoc-documentation-functions 195 | #'lean-eldoc-documentation-function nil t) 196 | (setq-local eldoc-documentation-strategy 197 | 'eldoc-documentation-default))) 198 | (eldoc-mode t))) 199 | 200 | ;; Automode List 201 | ;;;###autoload 202 | (define-derived-mode lean-mode prog-mode "Lean" 203 | "Major mode for Lean 204 | \\{lean-mode-map} 205 | Invokes `lean-mode-hook'. 206 | " 207 | :syntax-table lean-syntax-table 208 | :abbrev-table lean-abbrev-table 209 | :group 'lean 210 | (set (make-local-variable 'comment-start) "--") 211 | (set (make-local-variable 'comment-start-skip) "[-/]-[ \t]*") 212 | (set (make-local-variable 'comment-end) "") 213 | (set (make-local-variable 'comment-end-skip) "[ \t]*\\(-/\\|\\s>\\)") 214 | (set (make-local-variable 'comment-padding) 1) 215 | (set (make-local-variable 'comment-use-syntax) t) 216 | (set (make-local-variable 'font-lock-defaults) lean-font-lock-defaults) 217 | (set (make-local-variable 'indent-tabs-mode) nil) 218 | (set 'compilation-mode-font-lock-keywords '()) 219 | (set-input-method "Lean") 220 | (set (make-local-variable 'lisp-indent-function) 221 | 'common-lisp-indent-function) 222 | (lean-set-keys) 223 | (if (fboundp 'electric-indent-local-mode) 224 | (electric-indent-local-mode -1)) 225 | ;; (abbrev-mode 1) 226 | (pcase-dolist (`(,hook . ,fn) lean-hooks-alist) 227 | (add-hook hook fn nil 'local)) 228 | (setq imenu-generic-expression '(("Inductive" "^ *\\(?:@\\[.*\\]\\)? *inductive +\\([^\n ]+\\)" 1) 229 | ("Function" "^ *\\(?:@\\[.*\\]\\)? *def +\\([^\n ]+\\)" 1) 230 | ("Lemma" "^ *\\(?:@\\[.*\\]\\)? *lemma +\\([^\n ]+\\)" 1) 231 | ("Theorem" "^ *\\(?:@\\[.*\\]\\)? *theorem +\\([^\n ]+\\)" 1) 232 | ("Theorem" "^ *\\(?:@\\[.*\\]\\)? *theorem +\\([^\n ]+\\)" 1) 233 | ("Namespace" "^ *\\(?:@\\[.*\\]\\)? *namespace +\\([^\n ]+\\)" 1))) 234 | (lean-mode-setup)) 235 | 236 | ;; Automatically use lean-mode for .lean files. 237 | ;;;###autoload 238 | (push '("\\.lean$" . lean-mode) auto-mode-alist) 239 | (push '("\\.hlean$" . lean-mode) auto-mode-alist) 240 | 241 | ;; Use utf-8 encoding 242 | ;;;### autoload 243 | (modify-coding-system-alist 'file "\\.lean\\'" 'utf-8) 244 | (modify-coding-system-alist 'file "\\.hlean\\'" 'utf-8) 245 | 246 | ;; Flycheck init 247 | (eval-after-load 'flycheck 248 | '(lean-flycheck-init)) 249 | 250 | (provide 'lean-mode) 251 | ;;; lean-mode.el ends here 252 | -------------------------------------------------------------------------------- /lean-right-click.el: -------------------------------------------------------------------------------- 1 | ;; -*- lexical-binding: t -*- 2 | ;; 3 | ;;; lean-right-click.el 4 | ;; 5 | ;; Copyright (c) 2017 David Christiansen. All rights reserved. 6 | ;; 7 | ;; Author: David Christiansen 8 | ;; Released under Apache 2.0 license as described in the file LICENSE. 9 | ;; 10 | 11 | ;;; Code: 12 | 13 | (defvar lean-right-click-item-functions nil 14 | "A list of functions to compute menu items from source locations. 15 | 16 | The functions take no arguments. They will be run in a context 17 | where `current-buffer' gives the buffer in which the click 18 | occurred. The function should return a three-element list, where 19 | the first is a Lean server command, the second is its parameter 20 | list, and the third is a continuation that will compute a list of 21 | menu items. 22 | 23 | Each menu item is a plist that maps the key :name to the string 24 | to show in the menu and the key :action to a zero-argument 25 | function that implements the action.") 26 | (make-variable-buffer-local 'lean-right-click-item-functions) 27 | 28 | (defvar lean-right-click--unique-val-counter 0 29 | "A global counter for unique values for lean-right-click.") 30 | 31 | (defun lean-right-click--unique-val () 32 | "Get a unique value for internal tagging." 33 | (cl-incf lean-right-click--unique-val-counter)) 34 | 35 | (defun lean-right-click--items-for-location () 36 | "Return the menu items for point in the current buffer." 37 | (let ((commands (cl-loop for fun in lean-right-click-item-functions 38 | collecting (funcall fun)))) 39 | (let ((timeout 0.15) 40 | (items '()) 41 | (start-time (time-to-seconds)) 42 | (command-count (length commands)) 43 | (commands-returned 0)) 44 | (cl-loop for (cmd args cont) in commands 45 | do (progn (lean-server-send-command 46 | cmd args 47 | (lambda (&rest result) 48 | (setq items (append items (apply cont result))) 49 | (cl-incf commands-returned)) 50 | (lambda (&rest _whatever) 51 | (cl-incf commands-returned))) 52 | ;; This is necessary to ensure that async IO happens. 53 | (sit-for 0.02))) 54 | (while (and (< (time-to-seconds) (+ timeout start-time)) 55 | (< commands-returned command-count)) 56 | (sit-for 0.02)) 57 | items))) 58 | 59 | (defun lean-right-click-show-menu (click) 60 | "Show a menu based on the location of CLICK, computed from the `lean-right-click-functions'." 61 | (interactive "e") 62 | (let* ((window (posn-window (event-end click))) 63 | (buffer (window-buffer window)) 64 | (where (posn-point (event-end click))) 65 | (menu-items (with-current-buffer buffer 66 | (save-excursion 67 | (goto-char where) 68 | (lean-right-click--items-for-location))))) 69 | (when menu-items 70 | (let* ((menu (make-sparse-keymap)) 71 | (todo (cl-loop for item in menu-items 72 | collecting (let ((sym (lean-right-click--unique-val))) 73 | (define-key-after menu `[,sym] 74 | `(menu-item ,(plist-get item :name) 75 | (lambda () (interactive))) 76 | t) 77 | (cons sym (plist-get item :action))))) 78 | (selection (x-popup-menu click menu))) 79 | (when selection 80 | (funcall (cdr (assoc (car selection) todo)))))))) 81 | 82 | 83 | (provide 'lean-right-click) 84 | ;;; lean-right-click.el ends here 85 | -------------------------------------------------------------------------------- /lean-server.el: -------------------------------------------------------------------------------- 1 | ;; -*- lexical-binding: t -*- 2 | ;; 3 | ;; Copyright (c) 2016 Microsoft Corporation. All rights reserved. 4 | ;; Released under Apache 2.0 license as described in the file LICENSE. 5 | ;; 6 | ;; Author: Gabriel Ebner 7 | ;; 8 | 9 | (require 'cl-lib) 10 | (require 'json) 11 | (require 'lean-debug) 12 | (require 'lean-leanpkg) 13 | (require 'dash) 14 | 15 | (defcustom lean-server-show-message-hook '(lean-message-boxes-display) 16 | "Hook run on messages from Lean, allowing custom display. 17 | 18 | Each hook is a function that receives a list of message objects 19 | for the current buffer. Each message object is a plist with at 20 | least the following keys: 21 | - :pos_line is the line number of the message, a number 22 | - :pos_col is the column of the start of the message, a number 23 | - :caption is a category of message, a string 24 | - :text is the text to display, a string." 25 | :group 'lean 26 | :type 'hook 27 | :options '(lean-message-boxes-display)) 28 | 29 | (cl-defstruct lean-server-session 30 | path-file ; the leanpkg.path file of this lean server 31 | process ; process object of lean --server 32 | seq-num ; sequence number 33 | callbacks ; alist of (seq_num . (success_cb . error_cb)) 34 | current-roi ; alist of (file_name (begin_line . end_line) ...) 35 | tasks ; last deserialized current_tasks message 36 | messages) ; list of messages in deserialized json 37 | 38 | (defun lean-server-session-proc-buffer (sess) 39 | (process-buffer (lean-server-session-process sess))) 40 | 41 | (defun lean-server-session-pop-callback (sess seq-num) 42 | (let ((cbp (assoc seq-num (lean-server-session-callbacks sess)))) 43 | (setf (lean-server-session-callbacks sess) 44 | (delete cbp (lean-server-session-callbacks sess))) 45 | (if cbp (cdr cbp) (cons nil nil)))) 46 | 47 | (defun lean-server-process-response (sess res) 48 | (pcase (plist-get res :response) 49 | ("additional_message" 50 | (setf (lean-server-session-messages sess) 51 | (cons (plist-get res :msg) (lean-server-session-messages sess))) 52 | (lean-server-notify-messages-changed sess)) 53 | ("all_messages" 54 | (setf (lean-server-session-messages sess) 55 | (plist-get res :msgs)) 56 | (lean-server-notify-messages-changed sess)) 57 | ("current_tasks" 58 | (let ((old-tasks (lean-server-session-tasks sess))) 59 | (setf (lean-server-session-tasks sess) res) 60 | (lean-server-notify-tasks-changed sess old-tasks))) 61 | ("error" 62 | (message "error: %s" (plist-get res :message)) 63 | ;; TODO(gabriel): maybe even add the error as a message 64 | (when (plist-get res :seq_num) 65 | (let ((cb (lean-server-session-pop-callback sess (plist-get res :seq_num)))) 66 | (when (cdr cb) (funcall (cdr cb) res))))) 67 | ("ok" 68 | (let ((cb (lean-server-session-pop-callback sess (plist-get res :seq_num)))) 69 | (when (car cb) (funcall (car cb) res)))))) 70 | 71 | (defun lean-server-process-line (sess line) 72 | (condition-case-unless-debug err 73 | (progn 74 | (lean-debug "server=> %s" line) 75 | (let* ((json-array-type 'list) 76 | (json-object-type 'plist) 77 | (json-false nil) 78 | (response (json-read-from-string line))) 79 | (lean-server-process-response sess response))) 80 | (error (message "error in lean-server command handler: %s\nServer response was:\n%s" err (buffer-string))))) 81 | 82 | (defun lean-server-process-buffer (sess) 83 | (goto-char (point-min)) 84 | (when (search-forward "\n" nil t) 85 | (let ((line (buffer-substring (point-min) (point)))) 86 | (delete-region (point-min) (point)) 87 | (lean-server-process-line sess line) 88 | (lean-server-process-buffer sess)))) 89 | 90 | (defun lean-server-filter (sess string) 91 | (when (buffer-live-p (lean-server-session-proc-buffer sess)) 92 | (with-current-buffer (lean-server-session-proc-buffer sess) 93 | (goto-char (point-max)) 94 | (insert string) 95 | (lean-server-process-buffer sess)))) 96 | 97 | (defun lean-server-handle-signal (_process event) 98 | "Handle signals for lean-server-process" 99 | (force-mode-line-update) 100 | (let ((event-string (s-trim event))) 101 | (lean-debug "lean-server-handle-signal: %s" 102 | (propertize event-string 'face '(:foreground "red"))) 103 | (if (s-contains? "abnormally" event) 104 | (message (concat "Lean server died. See lean-server stderr buffer for details; " 105 | "use lean-server-restart to restart it"))))) 106 | 107 | (defun lean-server-session-create (path-file) 108 | "Creates a new server session" 109 | (let* ((default-directory (f--traverse-upwards (f-dir? it) path-file)) 110 | (exe (lean-get-executable lean-executable-name)) 111 | (exe (if (assoc path-file lean-server-overrides) 112 | (if (f-file? (lean-get-executable "elan")) 113 | (list (lean-get-executable "elan") "run" "--install" (cdr (assoc path-file lean-server-overrides)) lean-executable-name) 114 | (progn 115 | (warn "Lean version override set but `elan` was not found; ignoring") 116 | (list exe))) 117 | (list exe))) 118 | ; Setting process-connection-type is necessary, otherwise 119 | ; emacs truncates lines with >4096 bytes: 120 | ; https://debbugs.gnu.org/cgi/bugreport.cgi?bug=24531 121 | (process-connection-type nil) 122 | (cmd `(,@exe 123 | "--server" 124 | ,(format "-M%i" lean-memory-limit) 125 | ,(format "-T%i" lean-timeout-limit) 126 | ,@lean-extra-arguments 127 | ,(format "*%s*" path-file))) 128 | (proc (if (and (fboundp 'make-process) (fboundp 'make-pipe-process)) 129 | (make-process ;; emacs >= 25 lets us redirect stderr 130 | :name "lean-server" 131 | :buffer (format " *lean-server (%s)*" path-file) 132 | :command cmd 133 | :coding 'utf-8 134 | :noquery t 135 | :sentinel #'lean-server-handle-signal 136 | :stderr (make-pipe-process 137 | :name "lean-server stderr" 138 | :buffer (format "*lean-server stderr (%s)*" path-file) 139 | :noquery t)) 140 | (progn 141 | ; emacs 24 loves directory separators, without it 142 | ; the server gets started in the parent directory.... 143 | (setq default-directory (format "%s/" default-directory)) 144 | (apply #'start-process "lean-server" 145 | (format " *lean-server (%s)*" (buffer-name)) 146 | cmd)))) 147 | (sess (make-lean-server-session 148 | :path-file path-file 149 | :process proc 150 | :seq-num 0 151 | :current-roi 'not-yet-sent 152 | :callbacks nil 153 | :messages nil))) 154 | (set-process-filter proc (lambda (_proc string) (lean-server-filter sess string))) 155 | (set-process-coding-system proc 'utf-8 'utf-8) 156 | (set-process-query-on-exit-flag proc nil) 157 | sess)) 158 | 159 | (defun lean-server-session-send-command (sess cmd-name params &optional cb error-cb) 160 | (let* ((seq-num (lean-server-session-seq-num sess)) 161 | (req `(:seq_num ,seq-num :command ,cmd-name . ,params)) 162 | (json-array-type 'list) 163 | (json-object-type 'plist) 164 | (json-false :json-false) 165 | (json-req (json-encode req)) 166 | (cur-buf (current-buffer)) 167 | (wrapped-cb (and cb 168 | (lambda (res) 169 | (and cur-buf 170 | (with-current-buffer cur-buf 171 | (apply cb :allow-other-keys t res)))))) 172 | (wrapped-err-cb (and error-cb 173 | (lambda (res) 174 | (and cur-buf 175 | (with-current-buffer cur-buf 176 | (apply error-cb :allow-other-keys t res))))))) 177 | (setf (lean-server-session-seq-num sess) (1+ seq-num)) 178 | (if (or cb error-cb) 179 | (setf (lean-server-session-callbacks sess) 180 | (cons (cons seq-num (cons wrapped-cb wrapped-err-cb)) (lean-server-session-callbacks sess)))) 181 | (lean-debug "server<= %s" json-req) 182 | (process-send-string (lean-server-session-process sess) 183 | (concat json-req "\n")))) 184 | 185 | (defvar lean-server-sessions nil 186 | "list of all running lean-server-sessions") 187 | 188 | (defun lean-server-session-alive-p (sess) 189 | (and sess 190 | (lean-server-session-process sess) 191 | (equal 'run (process-status (lean-server-session-process sess))))) 192 | 193 | (defun lean-server-session-kill (sess) 194 | (ignore-errors (delete-process (lean-server-session-process sess))) 195 | (ignore-errors (kill-buffer (lean-server-session-proc-buffer sess))) 196 | (setf (lean-server-session-process sess) nil) 197 | (setq lean-server-sessions (delete sess lean-server-sessions))) 198 | 199 | (defun lean-server-session-get (path-file) 200 | (setq lean-server-sessions 201 | (cl-remove-if-not #'lean-server-session-alive-p 202 | lean-server-sessions)) 203 | (or (cl-find path-file lean-server-sessions 204 | :test (lambda (d s) (equal d (lean-server-session-path-file s)))) 205 | (let ((sess (lean-server-session-create path-file))) 206 | (setq lean-server-sessions (cons sess lean-server-sessions)) 207 | sess))) 208 | 209 | (defvar-local lean-server-session nil 210 | "Lean server session for the current buffer") 211 | 212 | (defvar lean-server-overrides nil 213 | "alist of (path file . toolchain name) pairs defined by `lean-server-switch-version'.") 214 | 215 | (defun lean-server-session-running-p (sess) 216 | (and sess (plist-get (lean-server-session-tasks sess) :is_running))) 217 | 218 | (defun lean-server-status-string () 219 | (if (not (lean-server-session-alive-p lean-server-session)) " ☠" 220 | (if (lean-server-session-running-p lean-server-session) " ⌛" 221 | " ✓"))) 222 | 223 | (defvar-local lean-server-flycheck-delay-timer nil) 224 | 225 | (defvar-local lean-server-task-overlays nil) 226 | 227 | (defun lean-server-task-region (task) 228 | (let ((bl (1- (plist-get task :pos_line))) 229 | (bc (plist-get task :pos_col)) 230 | (el (1- (plist-get task :end_pos_line))) 231 | (ec (plist-get task :end_pos_col))) 232 | (save-excursion 233 | (widen) 234 | (goto-char (point-min)) 235 | (forward-line bl) 236 | (if (equal (cons bl bc) (cons el ec)) 237 | (progn 238 | (let ((beg (point))) 239 | (forward-line 1) 240 | (cons beg (point)))) 241 | (ignore-errors (forward-char bc)) 242 | (let ((beg (point))) 243 | (goto-char (point-min)) 244 | (forward-line el) 245 | (ignore-errors (forward-char ec)) 246 | (cons beg (point))))))) 247 | 248 | (defface lean-server-task-face 249 | nil 250 | "Face to highlight pending Lean tasks." 251 | :group 'lean) 252 | 253 | (if (fboundp 'define-fringe-bitmap) 254 | (define-fringe-bitmap 'lean-server-fringe-bitmap 255 | (vector) 16 8)) 256 | 257 | (defface lean-server-task-fringe-face 258 | '((((class color) (background light)) 259 | :background "chocolate1") 260 | (((class color) (background dark)) 261 | :background "navajo white") 262 | (t :inverse-video t)) 263 | "Face to highlight the fringe of pending Lean tasks." 264 | :group 'lean) 265 | 266 | (defun lean-server-update-task-overlays () 267 | (dolist (ov lean-server-task-overlays) (delete-overlay ov)) 268 | (setq lean-server-task-overlays nil) 269 | (when (and lean-server-show-pending-tasks lean-server-session) 270 | (let* ((tasks (lean-server-session-tasks lean-server-session)) 271 | (cur-fn (buffer-file-name)) 272 | (roi (cdr (assq cur-fn (lean-server-session-current-roi lean-server-session))))) 273 | (dolist (task (plist-get tasks :tasks)) 274 | (if (and (equal (plist-get task :file_name) cur-fn) 275 | (--any? (<= (max (car it) (plist-get task :pos_line)) 276 | (min (cdr it) (plist-get task :end_pos_line))) 277 | roi)) 278 | (let* ((reg (lean-server-task-region task)) 279 | (ov (make-overlay (car reg) (cdr reg)))) 280 | (setq lean-server-task-overlays (cons ov lean-server-task-overlays)) 281 | (overlay-put ov 'face 'lean-server-task-face) 282 | (overlay-put ov 'line-prefix 283 | (propertize " " 'display 284 | '(left-fringe lean-server-fringe-bitmap lean-server-task-fringe-face))) 285 | (overlay-put ov 'help-echo (format "%s..." (plist-get task :desc))))))))) 286 | 287 | (defun lean-server-toggle-show-pending-tasks () 288 | "Toggles highlighting of pending tasks" 289 | (interactive) 290 | (setq lean-server-show-pending-tasks (not lean-server-show-pending-tasks)) 291 | (dolist (sess lean-server-sessions) 292 | (lean-server-notify-tasks-changed sess nil))) 293 | 294 | (defvar-local lean-server-flycheck-delay-timer nil) 295 | (defvar-local lean-server-flycheck-delayed-update nil) 296 | 297 | (defun lean-server-show-messages (&optional buf) 298 | (with-current-buffer (or buf (current-buffer)) 299 | (save-match-data 300 | (when (and (eq buf flycheck-error-list-source-buffer) 301 | (get-buffer-window buf)) 302 | (if (memq lean-server-flycheck-delay-timer timer-list) 303 | (setq lean-server-flycheck-delayed-update t) ; arm timer 304 | (flycheck-buffer) 305 | (setq lean-server-flycheck-delay-timer 306 | (run-at-time "100 milliseconds" nil 307 | (lambda (buf) 308 | (with-current-buffer buf 309 | (when lean-server-flycheck-delayed-update 310 | (setq lean-server-flycheck-delayed-update nil) 311 | (flycheck-buffer)))) 312 | (current-buffer)))))) 313 | (when lean-server-session 314 | (let ((relevant-msgs 315 | (cl-remove-if-not (lambda (msg) 316 | (equal (buffer-file-name buf) 317 | (plist-get msg :file_name))) 318 | (lean-server-session-messages lean-server-session)))) 319 | (dolist (hook lean-server-show-message-hook) 320 | (funcall hook relevant-msgs)))))) 321 | 322 | (defvar-local lean-server-show-tasks-delay-timer nil) 323 | 324 | (defun lean-server-show-tasks (&optional buf) 325 | (with-current-buffer (or buf (current-buffer)) 326 | (save-match-data 327 | (when (not (memq lean-server-show-tasks-delay-timer timer-list)) 328 | (setq lean-server-show-tasks-delay-timer 329 | (run-at-time "300 milliseconds" nil 330 | (lambda (buf) 331 | (with-current-buffer buf 332 | (lean-server-update-task-overlays))) 333 | (current-buffer))))))) 334 | 335 | (defun lean-server-notify-messages-changed (sess) 336 | (dolist (buf (buffer-list)) 337 | (with-current-buffer buf 338 | (when (and lean-server-session 339 | (eq sess lean-server-session)) 340 | (lean-server-show-messages))))) 341 | 342 | (defun lean-server-notify-tasks-changed (sess old-tasks) 343 | (force-mode-line-update) 344 | (when (and (not lean-server-show-pending-tasks) 345 | (or (plist-get old-tasks :tasks) 346 | (plist-get (lean-server-session-tasks sess) :tasks))) 347 | ; update task flycheck messages only if the task list is non-empty 348 | (lean-server-notify-messages-changed sess)) 349 | (dolist (buf (buffer-list)) 350 | (with-current-buffer buf 351 | (when (eq sess lean-server-session) 352 | (lean-server-show-tasks))))) 353 | 354 | (defun lean-server-stop () 355 | "Stops the lean server associated with the current buffer" 356 | (interactive) 357 | (when lean-server-session 358 | (lean-server-session-kill lean-server-session))) 359 | 360 | (defun lean-server-ensure-alive () 361 | "Ensures that the current buffer has a lean server" 362 | (when (not (lean-server-session-alive-p lean-server-session)) 363 | (setq lean-server-session (lean-server-session-get (lean-leanpkg-find-path-file))) 364 | (lean-server-show-tasks) 365 | (lean-server-show-messages) 366 | (lean-server-sync))) 367 | 368 | (defun lean-server-restart () 369 | "Restarts the lean server for the current buffer" 370 | (interactive) 371 | (lean-server-stop) 372 | (lean-server-ensure-alive) 373 | (flycheck-stop) 374 | (flycheck-buffer)) 375 | 376 | (defun lean-server-versions () 377 | (unless (f-file? (lean-get-executable "elan")) 378 | (error "`bin/elan` was not found in the Lean root dir \"%s\"" (lean-get-rootdir))) 379 | (with-temp-buffer 380 | (call-process (lean-get-executable "elan") nil t nil "toolchain" "list") 381 | (let ((results (split-string (buffer-string) "\n" t))) 382 | ; strip " (default)" from versions 383 | (--map (car (split-string it " ")) results)))) 384 | 385 | (defun lean-server-switch-version () 386 | "Restarts the lean server for the current buffer, using a specific version from elan prompted by `completing-read'." 387 | (interactive) 388 | (setq lean-server-overrides 389 | (cons 390 | (cons (lean-leanpkg-find-path-file) 391 | (completing-read "version: " (lean-server-versions) nil 'confirm)) 392 | lean-server-overrides)) 393 | (lean-server-restart)) 394 | 395 | (defun lean-server-send-command (cmd params &optional cb error-cb) 396 | "Sends a command to the lean server for the current buffer, with a callback to be called upon completion" 397 | (lean-server-ensure-alive) 398 | (lean-server-session-send-command lean-server-session cmd params cb error-cb)) 399 | 400 | (defvar lean-async-timeout 2 401 | "Maximum wait time for a value to be set during asynchronous call.") 402 | 403 | (defvar lean-async-wait 0.03 404 | "Pause between checks to see if the value's been set when turning an 405 | asynchronous call into synchronous.") 406 | 407 | (defun lean-server-send-synchronous-command (cmd params) 408 | "Sends a command to the lean server for the current buffer, waiting for and returning the response" 409 | ;; inspired by company--force-sync 410 | (let ((res 'trash) 411 | (ok t) 412 | (start (time-to-seconds))) 413 | (lean-server-send-command cmd params 414 | (lambda (&rest result) (setq res result)) 415 | (cl-function 416 | (lambda (&key message) 417 | (setq ok nil) 418 | (setq res message)))) 419 | (while (eq res 'trash) 420 | (if (> (- (time-to-seconds) start) lean-async-timeout) 421 | (error "Lean server timed out") 422 | (sleep-for lean-async-wait))) 423 | (if ok 424 | res 425 | (error res)))) 426 | 427 | (defun lean-server-sync (&optional buf) 428 | "Synchronizes the state of BUF (or the current buffer, if nil) with the lean server" 429 | (interactive) 430 | (with-demoted-errors "lean server sync: %s" 431 | (with-current-buffer (or buf (current-buffer)) 432 | (lean-server-sync-roi) 433 | (lean-server-send-command 434 | 'sync (list :file_name (buffer-file-name) 435 | :content (buffer-string)))))) 436 | 437 | (defvar-local lean-server-sync-timer nil) 438 | 439 | (defvar lean-server-sync-on-change t 440 | "When the value is t, sync the server when the buffer is changed.") 441 | 442 | (defun lean-server-toggle-update-on-change () 443 | "Toggle whether the server should be synced when the buffer is changed." 444 | (interactive) 445 | (setq lean-server-sync-on-change (not lean-server-sync-on-change)) 446 | (when lean-server-sync-on-change 447 | (lean-server-sync))) 448 | 449 | (defvar lean-server-change-hook-delay "50 milliseconds" 450 | "The amount of time to wait before syncing the lean server. 451 | 452 | This should be a string giving a relative time like \"90\" or \"2 hours 35 minutes\" 453 | (the acceptable forms are a number of seconds without units or 454 | some combination of values using units in timer-duration-words). 455 | ") 456 | 457 | (defun lean-server-change-hook (_begin _end _len) 458 | (when lean-server-sync-on-change 459 | (save-match-data 460 | (when lean-server-sync-timer (cancel-timer lean-server-sync-timer)) 461 | (setq lean-server-sync-timer 462 | (run-at-time lean-server-change-hook-delay nil #'lean-server-sync (current-buffer)))))) 463 | 464 | (defun lean-server-compute-roi (sess) 465 | "Compute the region of interest for the session SESS." 466 | (--mapcat (with-current-buffer it 467 | (when (eq lean-server-session sess) 468 | (list (cons (buffer-file-name) 469 | (--map (cons (line-number-at-pos (window-start it)) 470 | (line-number-at-pos (window-end it t))) 471 | (get-buffer-window-list)))))) 472 | (buffer-list))) 473 | 474 | (defun lean-server-session-send-roi (sess roi) 475 | (setf (lean-server-session-current-roi sess) roi) 476 | (lean-server-send-command 477 | 'roi (list :mode lean-server-check-mode 478 | :files (--map (list (cons :file_name (car it)) 479 | (cons :ranges (--map (list (cons :begin_line (car it)) 480 | (cons :end_line (cdr it))) 481 | (cdr it)))) 482 | roi)))) 483 | 484 | (defun lean-server-roi-subset-p (as bs) 485 | (--all? (let ((b (cdr (assq (car it) bs)))) 486 | (and b (-all? (lambda (ar) (--any? (and (<= (car it) (car ar)) 487 | (<= (cdr ar) (cdr it))) 488 | b)) 489 | (cdr it)))) 490 | as)) 491 | 492 | (defun lean-server-roi-extend (roi delta) 493 | (--map `(,(car it) . 494 | ,(--map `(,(max 1 (- (car it) delta)) . ,(+ (cdr it) delta)) (cdr it))) 495 | roi)) 496 | 497 | (defun lean-server-roi-ok (old-roi new-roi) 498 | (and (lean-server-roi-subset-p new-roi old-roi) 499 | (lean-server-roi-subset-p old-roi (lean-server-roi-extend new-roi 10)))) 500 | 501 | (defun lean-server-sync-roi (&optional force) 502 | (when lean-server-session 503 | (let ((old-roi (lean-server-session-current-roi lean-server-session)) 504 | (new-roi (lean-server-compute-roi lean-server-session))) 505 | (when (or force (eq old-roi 'not-yet-sent) (not (lean-server-roi-ok old-roi new-roi))) 506 | (lean-server-session-send-roi lean-server-session 507 | (lean-server-roi-extend new-roi 5)))))) 508 | 509 | (defun lean-server-window-scroll-function-hook (wnd _new-start-pos) 510 | (let ((buf (window-buffer wnd))) 511 | (with-demoted-errors "lean scroll hook: %s" 512 | (with-current-buffer buf 513 | (lean-server-ensure-alive) 514 | (lean-server-sync-roi))))) 515 | 516 | (defun lean-set-check-mode (mode) 517 | (setq lean-server-check-mode mode) 518 | (lean-server-sync-roi t)) 519 | 520 | (defun lean-check-nothing () 521 | "Check nothing" 522 | (interactive) 523 | (lean-set-check-mode 'nothing)) 524 | 525 | (defun lean-check-visible-lines () 526 | "Check visible lines" 527 | (interactive) 528 | (lean-set-check-mode 'visible-lines)) 529 | 530 | (defun lean-check-visible-lines-and-above () 531 | "Check visible lines and above" 532 | (interactive) 533 | (lean-set-check-mode 'visible-lines-and-above)) 534 | 535 | (defun lean-check-visible-files () 536 | "Check visible files" 537 | (interactive) 538 | (lean-set-check-mode 'visible-files)) 539 | 540 | (defun lean-check-open-files () 541 | "Check visible files" 542 | (interactive) 543 | (lean-set-check-mode 'open-files)) 544 | 545 | (provide 'lean-server) 546 | -------------------------------------------------------------------------------- /lean-settings.el: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) 2014 Microsoft Corporation. All rights reserved. 2 | ;; Released under Apache 2.0 license as described in the file LICENSE. 3 | ;; 4 | ;; Author: Soonho Kong 5 | ;; 6 | 7 | (require 'cl-lib) 8 | 9 | (defgroup lean nil 10 | "Lean Theorem Prover" 11 | :prefix "lean-" 12 | :group 'languages 13 | :link '(url-link :tag "Website" "http://leanprover.github.io") 14 | :link '(url-link :tag "Github" "https://github.com/leanprover/lean")) 15 | 16 | (defgroup lean-keybinding nil 17 | "Keybindings for lean-mode." 18 | :prefix "lean-" 19 | :group 'lean) 20 | 21 | (defvar-local lean-default-executable-name 22 | (cl-case system-type 23 | ('windows-nt "lean.exe") 24 | ('cygwin "lean.exe") 25 | (t "lean")) 26 | "Default executable name of Lean") 27 | 28 | (defcustom lean-rootdir nil 29 | "Full pathname of lean root directory. It should be defined by user." 30 | :group 'lean 31 | :type 'string) 32 | 33 | (defcustom lean-executable-name lean-default-executable-name 34 | "Name of lean executable" 35 | :group 'lean 36 | :type 'string) 37 | 38 | (defcustom lean-memory-limit 4096 39 | "Memory limit for lean process in megabytes" 40 | :group 'lean 41 | :type 'number) 42 | 43 | (defcustom lean-timeout-limit 100000 44 | "Deterministic timeout limit (it is approximately the maximum number of memory allocations in thousands)" 45 | :group 'lean 46 | :type 'number) 47 | 48 | (defcustom lean-extra-arguments nil 49 | "Extra command-line arguments to the lean process" 50 | :group 'lean 51 | :type '(list string)) 52 | 53 | (defcustom lean-eldoc-use t 54 | "Use eldoc mode for lean." 55 | :group 'lean 56 | :type 'boolean) 57 | 58 | (defcustom lean-eldoc-nay-retry-time 0.3 59 | "When eldoc-function had nay, try again after this amount of time." 60 | :group 'lean 61 | :type 'number) 62 | 63 | (defcustom lean-delete-trailing-whitespace nil 64 | "Set this variable to true to automatically delete trailing 65 | whitespace when a buffer is loaded from a file or when it is 66 | written." 67 | :group 'lean 68 | :type 'boolean) 69 | 70 | (defcustom lean-show-type-add-to-kill-ring nil 71 | "If it is non-nil, add the type information to the kill-ring so 72 | that user can yank(paste) it later. By default, it's 73 | false (nil)." 74 | :group 'lean 75 | :type 'boolean) 76 | 77 | (defcustom lean-server-show-pending-tasks t 78 | "Highlights pending tasks in the current buffer." 79 | :group 'lean 80 | :type 'boolean) 81 | 82 | (defcustom lean-server-check-mode 'visible-lines-and-above 83 | "What parts of the open files the Lean server should check" 84 | :group 'lean 85 | :type 'symbol 86 | :options '(nothing visible-lines visible-lines-and-above visible-files open-files)) 87 | 88 | (defcustom lean-keybinding-std-exe1 (kbd "C-c C-x") 89 | "Lean Keybinding for std-exe #1" 90 | :group 'lean-keybinding :type 'key-sequence) 91 | (defcustom lean-keybinding-std-exe2 (kbd "C-c C-l") 92 | "Lean Keybinding for std-exe #2" 93 | :group 'lean-keybinding :type 'key-sequence) 94 | (defcustom lean-keybinding-show-key (kbd "C-c C-k") 95 | "Lean Keybinding for show-key" 96 | :group 'lean-keybinding :type 'key-sequence) 97 | (defcustom lean-keybinding-server-restart (kbd "C-c C-r") 98 | "Lean Keybinding for server-restart" 99 | :group 'lean-keybinding :type 'key-sequence) 100 | (defcustom lean-keybinding-server-switch-version (kbd "C-c C-s") 101 | "Lean Keybinding for lean-server-switch-version" 102 | :group 'lean-keybinding :type 'key-sequence) 103 | (defcustom lean-keybinding-find-definition (kbd "M-.") 104 | "Lean Keybinding for find-definition" 105 | :group 'lean-keybinding :type 'key-sequence) 106 | (defcustom lean-keybinding-tab-indent (kbd "TAB") 107 | "Lean Keybinding for tab-indent" 108 | :group 'lean-keybinding :type 'key-sequence) 109 | (defcustom lean-keybinding-auto-complete (kbd "S-SPC") 110 | "Lean Keybinding for auto completion" 111 | :group 'lean-keybinding :type 'key-sequence) 112 | (defcustom lean-keybinding-hole (kbd "C-c SPC") 113 | "Lean Keybinding for hole manipulation" 114 | :group 'lean-keybinding :type 'key-sequence) 115 | (defcustom lean-keybinding-lean-toggle-show-goal (kbd "C-c C-g") 116 | "Lean Keybinding for show-goal-at-pos" 117 | :group 'lean-keybinding :type 'key-sequence) 118 | (defcustom lean-keybinding-lean-toggle-next-error (kbd "C-c C-n") 119 | "Lean Keybinding for lean-toggle-next-error" 120 | :group 'lean-keybinding :type 'key-sequence) 121 | (defcustom lean-keybinding-lean-message-boxes-toggle (kbd "C-c C-b") 122 | "Lean Keybinding for lean-message-boxes-toggle" 123 | :group 'lean-keybinding :type 'key-sequence) 124 | (defcustom lean-keybinding-leanpkg-configure (kbd "C-c C-p C-c") 125 | "Lean Keybinding for lean-leanpkg-configure" 126 | :group 'lean-keybinding :type 'key-sequence) 127 | (defcustom lean-keybinding-leanpkg-build (kbd "C-c C-p C-b") 128 | "Lean Keybinding for lean-leanpkg-build" 129 | :group 'lean-keybinding :type 'key-sequence) 130 | (defcustom lean-keybinding-leanpkg-test (kbd "C-c C-p C-t") 131 | "Lean Keybinding for lean-leanpkg-test" 132 | :group 'lean-keybinding :type 'key-sequence) 133 | (provide 'lean-settings) 134 | -------------------------------------------------------------------------------- /lean-syntax.el: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) 2013, 2014 Microsoft Corporation. All rights reserved. 2 | ;; Released under Apache 2.0 license as described in the file LICENSE. 3 | ;; 4 | ;; Author: Leonardo de Moura 5 | ;; Soonho Kong 6 | ;; 7 | 8 | (require 'dash) 9 | (require 'rx) 10 | 11 | (defconst lean-keywords1 12 | '("import" "prelude" "protected" "private" "noncomputable" "definition" "meta" "renaming" 13 | "hiding" "exposing" "parameter" "parameters" "begin" "constant" "constants" 14 | "lemma" "variable" "variables" "theorem" "example" "abbreviation" 15 | "open" "export" "axiom" "axioms" "inductive" "coinductive" "with" "without" 16 | "structure" "universe" "universes" "hide" 17 | "precedence" "reserve" "declare_trace" "add_key_equivalence" 18 | "match" "infix" "infixl" "infixr" "notation" "postfix" "prefix" "instance" 19 | "end" "this" "using" "using_well_founded" "namespace" "section" 20 | "attribute" "local" "set_option" "extends" "include" "omit" "classes" "class" 21 | "attributes" "raw" "replacing" 22 | "calc" "have" "show" "suffices" "by" "in" "at" "do" "let" "forall" "Pi" "fun" 23 | "exists" "if" "then" "else" "assume" "from" 24 | "mutual" "def" "run_cmd") 25 | "lean keywords ending with 'word' (not symbol)") 26 | (defconst lean-keywords1-regexp 27 | (eval `(rx word-start (or ,@lean-keywords1) word-end))) 28 | (defconst lean-constants 29 | '("#" "@" "!" "$" "->" "∼" "↔" "/" "==" "=" ":=" "<->" "/\\" "\\/" "∧" "∨" 30 | "≠" "<" ">" "≤" "≥" "¬" "<=" ">=" "⁻¹" "⬝" "▸" "+" "*" "-" "/" "λ" 31 | "→" "∃" "∀" "∘" "×" "Σ" "Π" "~" "||" "&&" "≃" "≡" "≅" 32 | "ℕ" "ℤ" "ℚ" "ℝ" "ℂ" "𝔸" 33 | "⬝e" "⬝i" "⬝o" "⬝op" "⬝po" "⬝h" "⬝v" "⬝hp" "⬝vp" "⬝ph" "⬝pv" "⬝r" "◾" "◾o" 34 | "∘n" "∘f" "∘fi" "∘nf" "∘fn" "∘n1f" "∘1nf" "∘f1n" "∘fn1" 35 | "^c" "≃c" "≅c" "×c" "×f" "×n" "+c" "+f" "+n" "ℕ₋₂") 36 | "lean constants") 37 | (defconst lean-constants-regexp (regexp-opt lean-constants)) 38 | (defconst lean-numerals-regexp 39 | (eval `(rx word-start 40 | (one-or-more digit) (optional (and "." (zero-or-more digit))) 41 | word-end))) 42 | 43 | (defconst lean-warnings '("sorry" "exit") "lean warnings") 44 | (defconst lean-warnings-regexp 45 | (eval `(rx word-start (or ,@lean-warnings) word-end))) 46 | 47 | 48 | (defconst lean-syntax-table 49 | (let ((st (make-syntax-table))) 50 | ;; Matching parens 51 | (modify-syntax-entry ?\[ "(]" st) 52 | (modify-syntax-entry ?\] ")[" st) 53 | (modify-syntax-entry ?\{ "(}" st) 54 | (modify-syntax-entry ?\} "){" st) 55 | 56 | ;; comment 57 | (modify-syntax-entry ?/ ". 14nb" st) 58 | (modify-syntax-entry ?- ". 123" st) 59 | (modify-syntax-entry ?\n ">" st) 60 | (modify-syntax-entry ?« "<" st) 61 | (modify-syntax-entry ?» ">" st) 62 | 63 | ;; Word constituent 64 | (--map (modify-syntax-entry it "w" st) 65 | (list ?a ?b ?c ?d ?e ?f ?g ?h ?i ?j ?k ?l ?m 66 | ?n ?o ?p ?q ?r ?s ?t ?u ?v ?w ?x ?y ?z 67 | ?A ?B ?C ?D ?E ?F ?G ?H ?I ?J ?K ?L ?M 68 | ?N ?O ?P ?Q ?R ?S ?T ?U ?V ?W ?X ?Y ?Z)) 69 | (--map (modify-syntax-entry it "w" st) 70 | (list ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9)) 71 | (--map (modify-syntax-entry it "w" st) 72 | (list ?α ?β ?γ ?δ ?ε ?ζ ?η ?θ ?ι ?κ ;;?λ 73 | ?μ ?ν ?ξ ?ο ?π ?ρ ?ς ?σ ?τ ?υ 74 | ?φ ?χ ?ψ ?ω)) 75 | (--map (modify-syntax-entry it "w" st) 76 | (list ?ϊ ?ϋ ?ό ?ύ ?ώ ?Ϗ ?ϐ ?ϑ ?ϒ ?ϓ ?ϔ ?ϕ ?ϖ 77 | ?ϗ ?Ϙ ?ϙ ?Ϛ ?ϛ ?Ϝ ?ϝ ?Ϟ ?ϟ ?Ϡ ?ϡ ?Ϣ ?ϣ 78 | ?Ϥ ?ϥ ?Ϧ ?ϧ ?Ϩ ?ϩ ?Ϫ ?ϫ ?Ϭ ?ϭ ?Ϯ ?ϯ ?ϰ 79 | ?ϱ ?ϲ ?ϳ ?ϴ ?ϵ ?϶ ?Ϸ ?ϸ ?Ϲ ?Ϻ ?ϻ)) 80 | (--map (modify-syntax-entry it "w" st) 81 | (list ?ἀ ?ἁ ?ἂ ?ἃ ?ἄ ?ἅ ?ἆ ?ἇ ?Ἀ ?Ἁ ?Ἂ ?Ἃ ?Ἄ 82 | ?Ἅ ?Ἆ ?Ἇ ?ἐ ?ἑ ?ἒ ?ἓ ?ἔ ?ἕ ?἖ ?἗ ?Ἐ ?Ἑ 83 | ?Ἒ ?Ἓ ?Ἔ ?Ἕ ?἞ ?἟ ?ἠ ?ἡ ?ἢ ?ἣ ?ἤ ?ἥ 84 | ?ἦ ?ἧ ?Ἠ ?Ἡ ?Ἢ ?Ἣ ?Ἤ ?Ἥ ?Ἦ ?Ἧ ?ἰ ?ἱ 85 | ?ἲ ?ἳ ?ἴ ?ἵ ?ἶ ?ἷ ?Ἰ ?Ἱ ?Ἲ ?Ἳ ?Ἴ ?Ἵ ?Ἶ ?Ἷ 86 | ?ὀ ?ὁ ?ὂ ?ὃ ?ὄ ?ὅ ?὆ ?὇ ?Ὀ ?Ὁ ?Ὂ ?Ὃ 87 | ?Ὄ ?Ὅ ?὎ ?὏ ?ὐ ?ὑ ?ὒ ?ὓ ?ὔ ?ὕ ?ὖ ?ὗ 88 | ?὘ ?Ὑ ?὚ ?Ὓ ?὜ ?Ὕ ?὞ ?Ὗ ?ὠ ?ὡ ?ὢ 89 | ?ὣ ?ὤ ?ὥ ?ὦ ?ὧ ?Ὠ ?Ὡ ?Ὢ ?Ὣ ?Ὤ ?Ὥ ?Ὦ 90 | ?Ὧ ?ὰ ?ά ?ὲ ?έ ?ὴ ?ή ?ὶ ?ί ?ὸ ?ό ?ὺ ?ύ ?ὼ 91 | ?ώ ?὾ ?὿ ?ᾀ ?ᾁ ?ᾂ ?ᾃ ?ᾄ ?ᾅ ?ᾆ ?ᾇ ?ᾈ 92 | ?ᾉ ?ᾊ ?ᾋ ?ᾌ ?ᾍ ?ᾎ ?ᾏ ?ᾐ ?ᾑ ?ᾒ ?ᾓ ?ᾔ 93 | ?ᾕ ?ᾖ ?ᾗ ?ᾘ ?ᾙ ?ᾚ ?ᾛ ?ᾜ ?ᾝ ?ᾞ ?ᾟ ?ᾠ ?ᾡ ?ᾢ 94 | ?ᾣ ?ᾤ ?ᾥ ?ᾦ ?ᾧ ?ᾨ ?ᾩ ?ᾪ ?ᾫ ?ᾬ ?ᾭ ?ᾮ ?ᾯ ?ᾰ 95 | ?ᾱ ?ᾲ ?ᾳ ?ᾴ ?᾵ ?ᾶ ?ᾷ ?Ᾰ ?Ᾱ ?Ὰ ?Ά ?ᾼ ?᾽ 96 | ?ι ?᾿ ?῀ ?῁ ?ῂ ?ῃ ?ῄ ?῅ ?ῆ ?ῇ ?Ὲ ?Έ ?Ὴ 97 | ?Ή ?ῌ ?῍ ?῎ ?῏ ?ῐ ?ῑ ?ῒ ?ΐ ?῔ ?῕ ?ῖ ?ῗ 98 | ?Ῐ ?Ῑ ?Ὶ ?Ί ?῜ ?῝ ?῞ ?῟ ?ῠ ?ῡ ?ῢ ?ΰ ?ῤ ?ῥ 99 | ?ῦ ?ῧ ?Ῠ ?Ῡ ?Ὺ ?Ύ ?Ῥ ?῭ ?΅ ?` ?῰ ?῱ ?ῲ ?ῳ 100 | ?ῴ ?῵ ?ῶ ?ῷ ?Ὸ ?Ό ?Ὼ ?Ώ ?ῼ ?´ ?῾)) 101 | (--map (modify-syntax-entry it "w" st) 102 | (list ?℀ ?℁ ?ℂ ?℃ ?℄ ?℅ ?℆ ?ℇ ?℈ ?℉ ?ℊ ?ℋ ?ℌ ?ℍ ?ℎ 103 | ?ℏ ?ℐ ?ℑ ?ℒ ?ℓ ?℔ ?ℕ ?№ ?℗ ?℘ ?ℙ ?ℚ ?ℛ ?ℜ ?ℝ 104 | ?℞ ?℟ ?℠ ?℡ ?™ ?℣ ?ℤ ?℥ ?Ω ?℧ ?ℨ ?℩ ?K ?Å ?ℬ 105 | ?ℭ ?℮ ?ℯ ?ℰ ?ℱ ?Ⅎ ?ℳ ?ℴ ?ℵ ?ℶ ?ℷ ?ℸ ?ℹ ?℺ ?℻ 106 | ?ℼ ?ℽ ?ℾ ?ℿ ?⅀ ?⅁ ?⅂ ?⅃ ?⅄ ?ⅅ ?ⅆ ?ⅇ ?ⅈ ?ⅉ ?⅊ 107 | ?⅋ ?⅌ ?⅍ ?ⅎ ?⅏)) 108 | (modify-syntax-entry ?' "w" st) 109 | (modify-syntax-entry ?_ "w" st) 110 | (modify-syntax-entry ?\. "w" st) 111 | 112 | ;; Lean operator chars 113 | (mapc #'(lambda (ch) (modify-syntax-entry ch "_" st)) 114 | "!#$%&*+<=>@^|~:") 115 | 116 | ;; Whitespace is whitespace 117 | (modify-syntax-entry ?\ " " st) 118 | (modify-syntax-entry ?\t " " st) 119 | 120 | ;; Strings 121 | (modify-syntax-entry ?\" "\"" st) 122 | (modify-syntax-entry ?\\ "/" st) 123 | 124 | st)) 125 | 126 | (defconst lean-font-lock-defaults 127 | `((;; attributes 128 | (,(rx word-start "attribute" word-end (zero-or-more whitespace) (group (one-or-more "[" (zero-or-more (not (any "]"))) "]" (zero-or-more whitespace)))) 129 | (1 'font-lock-doc-face)) 130 | (,(rx (group "@[" (zero-or-more (not (any "]"))) "]")) 131 | (1 'font-lock-doc-face)) 132 | (,(rx (group "#" (or "eval" "print" "reduce" "help" "check"))) 133 | (1 'font-lock-keyword-face)) 134 | ;; mutual definitions "names" 135 | (,(rx word-start 136 | "mutual" 137 | word-end 138 | (zero-or-more whitespace) 139 | word-start 140 | (or "inductive" "definition" "def") 141 | word-end 142 | (group (zero-or-more (not (any " \t\n\r{([,"))) (zero-or-more (zero-or-more whitespace) "," (zero-or-more whitespace) (not (any " \t\n\r{([,"))))) 143 | (1 'font-lock-function-name-face)) 144 | ;; declarations 145 | (,(rx word-start 146 | (group (or "inductive" (group "class" (zero-or-more whitespace) "inductive") "instance" "structure" "class" "theorem" "axiom" "axioms" "lemma" "definition" "def" "constant")) 147 | word-end (zero-or-more whitespace) 148 | (group (zero-or-more "{" (zero-or-more (not (any "}"))) "}" (zero-or-more whitespace))) 149 | (zero-or-more whitespace) 150 | (group (zero-or-more (not (any " \t\n\r{(["))))) 151 | (4 'font-lock-function-name-face)) 152 | ;; Constants which have a keyword as subterm 153 | (,(rx (or "∘if")) . 'font-lock-constant-face) 154 | ;; Keywords 155 | ("\\(set_option\\)[ \t]*\\([^ \t\n]*\\)" (2 'font-lock-constant-face)) 156 | (,lean-keywords1-regexp . 'font-lock-keyword-face) 157 | (,(rx word-start (group "example") ".") (1 'font-lock-keyword-face)) 158 | (,(rx (or "∎")) . 'font-lock-keyword-face) 159 | ;; Types 160 | (,(rx word-start (or "Prop" "Type" "Type*" "Sort" "Sort*") symbol-end) . 'font-lock-type-face) 161 | (,(rx word-start (group (or "Prop" "Type" "Sort")) ".") (1 'font-lock-type-face)) 162 | ;; String 163 | ("\"[^\"]*\"" . 'font-lock-string-face) 164 | ;; ;; Constants 165 | (,lean-constants-regexp . 'font-lock-constant-face) 166 | (,lean-numerals-regexp . 'font-lock-constant-face) 167 | ;; place holder 168 | (,(rx symbol-start "_" symbol-end) . 'font-lock-preprocessor-face) 169 | ;; warnings 170 | (,lean-warnings-regexp . 'font-lock-warning-face) 171 | ;; escaped identifiers 172 | (,(rx (and (group "«") (group (one-or-more (not (any "»")))) (group "»"))) 173 | (1 font-lock-comment-face t) 174 | (2 nil t) 175 | (3 font-lock-comment-face t)) 176 | ))) 177 | 178 | ;; Syntax Highlighting for Lean Info Mode 179 | (defconst lean-info-font-lock-defaults 180 | (let ((new-entries 181 | `(;; Please add more after this: 182 | (,(rx (group (+ symbol-start (+ (or word (char ?₁ ?₂ ?₃ ?₄ ?₅ ?₆ ?₇ ?₈ ?₉ ?₀))) symbol-end (* white))) ":") 183 | (1 'font-lock-variable-name-face)) 184 | (,(rx white ":" white) 185 | . 'font-lock-keyword-face) 186 | (,(rx "⊢" white) 187 | . 'font-lock-keyword-face) 188 | (,(rx "[" (group "stale") "]") 189 | (1 'font-lock-warning-face)) 190 | (,(rx line-start "No Goal" line-end) 191 | . 'font-lock-constant-face))) 192 | (inherited-entries (car lean-font-lock-defaults))) 193 | `(,(-concat new-entries inherited-entries)))) 194 | 195 | (provide 'lean-syntax) 196 | -------------------------------------------------------------------------------- /lean-type.el: -------------------------------------------------------------------------------- 1 | ;; -*- lexical-binding: t; -*- 2 | ;; Copyright (c) 2014 Microsoft Corporation. All rights reserved. 3 | ;; Released under Apache 2.0 license as described in the file LICENSE. 4 | ;; 5 | ;; Authors: Soonho Kong, Sebastian Ullrich 6 | ;; 7 | 8 | (require 'cl-lib) 9 | (require 'dash) 10 | (require 's) 11 | (require 'lean-info) 12 | (require 'lean-util) 13 | (require 'lean-server) 14 | (require 'lean-debug) 15 | (require 'flymake) 16 | 17 | (defun lean-fill-placeholder-cont (info-record) 18 | "Continuation for lean-fill-placeholder" 19 | (let ((synth (and info-record (plist-get info-record :synth)))) 20 | (when synth 21 | (let ((synth-str 22 | (replace-regexp-in-string "?M_[0-9]+" "_" synth))) 23 | (when (cl-search " " synth-str) 24 | (setq synth-str (concat "(" synth-str ")"))) 25 | (when (looking-at "_") 26 | (delete-char 1) 27 | (insert synth-str)))))) 28 | 29 | (defun lean-fill-placeholder () 30 | "Fill the placeholder with a synthesized expression by Lean." 31 | (interactive) 32 | (lean-get-info-record-at-point 'lean-fill-placeholder-cont)) 33 | 34 | (cl-defun lean-info-record-to-string (info-record) 35 | "Given typeinfo, overload, and sym-name, compose information as a string." 36 | (cl-destructuring-bind (&key type tactic_params tactic_param_idx text doc full-id &allow-other-keys) info-record 37 | (let ((name-str (or full-id text)) 38 | (type-str type) 39 | str) 40 | (when tactic_params 41 | (setq tactic_params (-map-indexed (lambda (i param) 42 | (if (eq i tactic_param_idx) 43 | (propertize param 'face 'eldoc-highlight-function-argument) 44 | param)) tactic_params)) 45 | (setq type-str (mapconcat 'identity tactic_params " "))) 46 | 47 | (when (and name-str type-str) 48 | (setq str (format (if tactic_params "%s %s" "%s : %s") 49 | (propertize name-str 'face 'font-lock-variable-name-face) 50 | type-str))) 51 | (when doc 52 | (let ((doc (if (<= emacs-major-version 27) 53 | (let ((lines (split-string doc "\n"))) 54 | (if (cdr lines) 55 | (concat (car lines) " ⋯") 56 | (car lines))) 57 | doc))) 58 | (setq str (concat str 59 | (format "\n%s" 60 | (propertize doc 'face 'font-lock-comment-face)))))) 61 | str))) 62 | 63 | (defvar-local lean-eldoc-documentation-cache nil) 64 | (defvar-local lean-add-to-kill-ring nil) 65 | 66 | (defun lean-eldoc-documentation-function-cont (info-record cb) 67 | "Continuation for lean-eldoc-documentation-function" 68 | (let ((info-string (and info-record (lean-info-record-to-string info-record)))) 69 | (when info-string 70 | (when lean-add-to-kill-ring 71 | (setq lean-add-to-kill-ring nil) 72 | (kill-new 73 | (substring-no-properties info-string)))) 74 | (setq lean-eldoc-documentation-cache (and info-string (format "%s" info-string))) 75 | (funcall cb lean-eldoc-documentation-cache))) 76 | 77 | (defun lean-eldoc-documentation-function (&optional cb) 78 | "Show information of lean expression at point if any 79 | Takes as argument an optional callback function, which defaults to `eldoc-message`" 80 | (interactive) 81 | (when (not (eq lean-server-check-mode 'nothing)) ; TODO(gabriel): revisit once info no longer reparses the file 82 | (lean-get-info-record-at-point 83 | (lambda (info-record) 84 | (lean-eldoc-documentation-function-cont info-record (or cb 'eldoc-message)))) 85 | 'non-nil-non-string)) 86 | 87 | (defun lean-show-type () 88 | "Show information of lean-expression at point if any." 89 | (interactive) 90 | (setq lean-add-to-kill-ring lean-show-type-add-to-kill-ring) 91 | (if (<= emacs-major-version 27) 92 | (lean-eldoc-documentation-function) 93 | (eldoc-print-current-symbol-info t))) 94 | 95 | (defconst lean-show-goal-buffer-name "*Lean Goal*") 96 | 97 | (setq lean-show-goal--handler-mask nil) 98 | 99 | (defun lean-show-goal--handler () 100 | (if lean-show-goal--handler-mask 101 | (setq lean-show-goal--handler-mask nil) 102 | (let ((deactivate-mark)) ; keep transient mark 103 | (when (and (not (eq lean-server-check-mode 'nothing)) 104 | ; TODO(gabriel): revisit ^^ once info no longer reparses the file 105 | (lean-info-buffer-active lean-show-goal-buffer-name)) 106 | (lean-get-info-record-at-point 107 | (lambda (info-record) 108 | (let ((state (plist-get info-record :state))) 109 | (unless (or (s-blank? state) (s-blank? (s-trim state))) 110 | (lean-with-info-output-to-buffer lean-show-goal-buffer-name (princ state)))))))))) 111 | 112 | (defun lean-toggle-show-goal () 113 | "Show goal at the current point." 114 | (interactive) 115 | (lean-toggle-info-buffer lean-show-goal-buffer-name) 116 | (lean-show-goal--handler)) 117 | 118 | (provide 'lean-type) 119 | -------------------------------------------------------------------------------- /lean-util.el: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) 2014 Microsoft Corporation. All rights reserved. 2 | ;; Released under Apache 2.0 license as described in the file LICENSE. 3 | ;; 4 | ;; Author: Soonho Kong 5 | ;; 6 | 7 | (require 'cl-lib) 8 | (require 'f) 9 | (require 's) 10 | (require 'dash) 11 | 12 | (defun lean-setup-rootdir () 13 | (let ((root (executable-find lean-executable-name))) 14 | (when root 15 | (setq lean-rootdir (f-dirname (f-dirname root)))) 16 | root)) 17 | 18 | (defun lean-get-rootdir () 19 | (if lean-rootdir 20 | (let ((lean-path (f-full (f-join lean-rootdir "bin" lean-executable-name)))) 21 | (unless (f-exists? lean-path) 22 | (error "Incorrect 'lean-rootdir' value, path '%s' does not exist." lean-path)) 23 | lean-rootdir) 24 | (or 25 | (lean-setup-rootdir) 26 | (error 27 | (concat "Lean was not found in the 'exec-path' and 'lean-rootdir' is not defined. " 28 | "Please set it via M-x customize-variable RET lean-rootdir RET."))))) 29 | 30 | (defun lean-get-executable (exe-name) 31 | "Return fullpath of lean executable" 32 | (let ((lean-bin-dir-name "bin")) 33 | (f-full (f-join (lean-get-rootdir) lean-bin-dir-name exe-name)))) 34 | 35 | (defun lean-line-offset (&optional pos) 36 | "Return the byte-offset of `pos` or current position, counting from the 37 | beginning of the line" 38 | (interactive) 39 | (let* ((pos (or pos (point))) 40 | (bol-pos 41 | (save-excursion 42 | (goto-char pos) 43 | (beginning-of-line) 44 | (point)))) 45 | (- pos bol-pos))) 46 | 47 | (defun lean-pos-at-line-col (l c) 48 | "Return the point of the given line and column." 49 | ;; http://emacs.stackexchange.com/a/8083 50 | (save-excursion 51 | (goto-char (point-min)) 52 | (forward-line (- l 1)) 53 | (move-to-column c) 54 | (point))) 55 | 56 | (defun lean-whitespace-cleanup () 57 | (when lean-delete-trailing-whitespace 58 | (delete-trailing-whitespace))) 59 | 60 | (defun lean-in-comment-p () 61 | "t if a current point is inside of comment block 62 | nil otherwise" 63 | (nth 4 (syntax-ppss))) 64 | 65 | ;; The following function is a slightly modified version of 66 | ;; f--collect-entries written by Johan Andersson 67 | ;; The URL is at https://github.com/rejeep/f.el/blob/master/f.el#L416-L435 68 | (defun lean--collect-entries (path recursive) 69 | (let (result 70 | (entries 71 | (-reject 72 | (lambda (file) 73 | (or 74 | (equal (f-filename file) ".") 75 | (equal (f-filename file) ".."))) 76 | (directory-files path t)))) 77 | ;; The following line is the only modification that I made 78 | ;; It waits 0.0001 second for an event. This wait allows 79 | ;; wait-timeout function to check the timer and kill the execution 80 | ;; of this function. 81 | (sit-for 0.0001) 82 | (cond (recursive 83 | (-map 84 | (lambda (entry) 85 | (if (f-file? entry) 86 | (setq result (cons entry result)) 87 | (when (f-directory? entry) 88 | (setq result (cons entry result)) 89 | (setq result (append result (lean--collect-entries entry recursive)))))) 90 | entries)) 91 | (t (setq result entries))) 92 | result)) 93 | 94 | ;; The following function is a slightly modified version of 95 | ;; f-files function written by Johan Andersson The URL is at 96 | ;; https://github.com/rejeep/f.el/blob/master/f.el#L478-L481 97 | (defun lean-find-files (path &optional fn recursive) 98 | "Find all files in PATH." 99 | ;; It calls lean--collect-entries instead of f--collect-entries 100 | (let ((files (-select 'f-file? (lean--collect-entries path recursive)))) 101 | (if fn (-select fn files) files))) 102 | 103 | (provide 'lean-util) 104 | --------------------------------------------------------------------------------