├── .github └── FUNDING.yml ├── README.md ├── litable.el └── screenshot.png /.github/FUNDING.yml: -------------------------------------------------------------------------------- 1 | # These are supported funding model platforms 2 | 3 | github: [Fuco1] 4 | patreon: matusgoljer 5 | custom: https://www.paypal.com/cgi-bin/webscr?cmd=_s-xclick&hosted_button_id=A5PMGVKCQBT88 6 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | litable [![Paypal logo](https://www.paypalobjects.com/en_US/i/btn/btn_donate_LG.gif)](https://www.paypal.com/cgi-bin/webscr?cmd=_s-xclick&hosted_button_id=A5PMGVKCQBT88) [![Patreon](https://c5.patreon.com/external/logo/logomarkOrange.svg)](https://www.patreon.com/user?u=3282358&ty=h) 2 | ======= 3 | 4 | On-the-fly evaluation of emacs lisp. Inspired by Light Table. 5 | 6 | To start this up, simply enable the litable minor mode in the buffer by calling `M-x litable-mode`. 7 | 8 | Litable keeps a list of pure functions as a safeguard for unwanted evaluations. A function must first be accepted into this list (using `M-x litable-accept-as-pure`) before it can be evaluated on-the-fly. You should take care of what function you accept as pure to avoid any unfortunate accidents. Also, note that the pure functions list persists across sessions. 9 | 10 | Not meant to be used in production yet, be warned! 11 | 12 | Demos 13 | ===== 14 | 15 | ![screenshot](screenshot.png) 16 | 17 | There's also a screencast available: https://www.youtube.com/watch?v=mNO-vgq3Avg [1:50] 18 | 19 | Contribute 20 | ======= 21 | 22 | * If you feel like contributing, there are **TODO** annotations in the code. Mostly basic/trivial stuff, good exercise for people starting with elisp. 23 | * If you have more substantial ideas, start an issue so we can discuss it. I'm open to all ideas, this is simply a precaution for people to not work on the same feature. 24 | * If you want, you can [throw a couple bucks my way](https://www.paypal.com/cgi-bin/webscr?cmd=_s-xclick&hosted_button_id=A5PMGVKCQBT88) or support me on [Patreon](https://www.patreon.com/user?u=3282358&ty=h) \(we have a long way to beat that $300k goal people!\). 25 | -------------------------------------------------------------------------------- /litable.el: -------------------------------------------------------------------------------- 1 | ;;; litable.el --- dynamic evaluation replacement with emacs 2 | 3 | ;; Copyright (C) 2013-2014 Matus Goljer 4 | 5 | ;; Author: Matus Goljer 6 | ;; Maintainer: Matus Goljer 7 | ;; Keywords: lisp 8 | ;; Created: 8th April 2013 9 | ;; Package-requires: ((dash "2.6.0")) 10 | 11 | ;; This program is free software; you can redistribute it and/or modify 12 | ;; it under the terms of the GNU General Public License as published by 13 | ;; the Free Software Foundation, either version 3 of the License, or 14 | ;; (at your option) any later version. 15 | 16 | ;; This program is distributed in the hope that it will be useful, 17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19 | ;; GNU General Public License for more details. 20 | 21 | ;; You should have received a copy of the GNU General Public License 22 | ;; along with this program. If not, see . 23 | 24 | ;;; Commentary: 25 | 26 | ;; This allows light-table like dynamic evaluation with Emacs. It's 27 | ;; fun for investigating lisp or for particular light problems before 28 | ;; you delve in and start hacking serious functions together. 29 | 30 | ;; It's very much a work in progress, please heed that warning. 31 | 32 | ;;; Code: 33 | 34 | (require 'dash) 35 | (require 'thingatpt) 36 | 37 | ;;;;; global TODO 38 | ;; 1. investigate: http://lists.gnu.org/archive/html/gnu-emacs-sources/2009-04/msg00032.html 39 | ;; and merge relevant parts. 40 | ;; 41 | ;; 2. update free variable bindings when `setq' call is made on them. 42 | 43 | (defgroup litable nil 44 | "On-the-fly evaluation/substitution of emacs lisp code." 45 | :group 'completion 46 | :prefix "litable-") 47 | 48 | (defcustom litable-result-overlay-text-function 'litable--create-result-overlay-text 49 | "Function used to create the result overlay text. 50 | A function that is called with a string argument and an optional face 51 | argument, and should evaluate to text with attendant properties." 52 | :group 'litable 53 | :type 'function) 54 | 55 | (defcustom litable-substitution-overlay-text-function 'litable--create-substitution-overlay-text 56 | "Function used to create the substitution overlay text. 57 | A function that is called with a string argument containing the 58 | expression to be replaced, another string argument containing the 59 | value to be used in the substitution, and an optional face argument. 60 | The function should evaluate to text with the desired properties." 61 | :group 'litable 62 | :type 'function) 63 | 64 | (defcustom litable-result-format " %s " 65 | "Format used to display a litable result. 66 | A format string like \"=> %s\"." 67 | :group 'litable 68 | :type '(choice (string :tag "Format string"))) 69 | 70 | (defcustom litable-print-function 'pp-to-string 71 | "Function used to print results and inputs" 72 | :type '(choice 73 | (function-item :tag "pp-to-string" :value pp-to-string) 74 | (function-item :tag "prin1-to-string" 75 | :value prin1-to-string) 76 | (function :tag "Your own function")) 77 | :group 'litable) 78 | 79 | (defface litable-result-face 80 | '((default :inherit (font-lock-warning-face))) 81 | "Face for displaying the litable result. 82 | Defaults to inheriting font-lock-warning-face." 83 | :group 'litable) 84 | 85 | (defface litable-substitution-face 86 | '((default :inherit (font-lock-type-face))) 87 | "Face for displaying the litable substitution. 88 | Defaults to inheriting font-lock-type-face." 89 | :group 'litable) 90 | 91 | (defvar litable-exceptions '( 92 | (setq . 2) 93 | ) 94 | "A list of cons pairs (form-name . nth argument) where the 95 | substitution should not occur. The number includes the first 96 | item, counting starts at 1. 97 | 98 | For example: 99 | 100 | (setq . 2) ;; first argument is target name, do not substitute.") 101 | 102 | 103 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 104 | ;; let-form annotation 105 | 106 | (defun litable--annotate-let-form (subs &optional point) 107 | "Annotate the let form following point. 108 | 109 | Add an overlay over the let form that will keep track of the 110 | variables bound there. If an overlay is already oresent around 111 | point, merge the variables into this overlay." 112 | (setq point (or point (point))) 113 | (let* ((let-form (sexp-at-point)) 114 | (bounds (bounds-of-thing-at-point 'sexp)) 115 | (var-form-bounds (save-excursion 116 | (down-list) 117 | (forward-list) 118 | (backward-list) 119 | (bounds-of-thing-at-point 'sexp))) 120 | (cvars (litable--extract-variables-with-defs (cadr let-form))) ; vars defined in current form 121 | (pvars (litable-get-let-bound-variable-values point)) ; vars defined in the very previous form 122 | (nvars (litable--merge-variables ; merged vars 123 | (litable--get-active-overlay point) subs cvars)) 124 | ov) 125 | (setq ov (make-overlay (car bounds) (cdr bounds))) 126 | (push ov litable-overlays) 127 | (overlay-put ov 'litable-let-form t) 128 | (overlay-put ov 'litable-let-form-type (car let-form)) 129 | ;; TODO: this still ignores the `setq' updated local bindings. 130 | (overlay-put ov 'litable-let-form-cur nvars) 131 | (overlay-put ov 'litable-let-form-prev pvars) 132 | (overlay-put ov 'litable-var-form-bounds var-form-bounds))) 133 | 134 | (defun litable--extract-variables (varlist) 135 | "Extract the variable names from VARLIST. 136 | VARLIST is a list of the same format `let' accept as first 137 | argument." 138 | (let (vars) 139 | (while varlist 140 | (let ((current (car varlist))) 141 | (pop varlist) 142 | (if (listp current) 143 | (push (car current) vars) 144 | (push current vars)))) 145 | (nreverse vars))) 146 | 147 | (defun litable--extract-variables-with-defs (varlist) 148 | "Extract the variable names from VARLIST. 149 | VARLIST is a list of the same format `let' accept as first 150 | argument." 151 | (let (vars) 152 | (while varlist 153 | (let ((current (car varlist))) 154 | (pop varlist) 155 | (if (listp current) 156 | (push (cons (car current) (cdr current)) vars) 157 | (push (cons current nil) vars)))) 158 | (nreverse vars))) 159 | 160 | (defun litable--overlays-at (&optional pos) 161 | "Simple wrapper of `overlays-at' to get only let-form overlays 162 | from litable." 163 | (--filter (overlay-get it 'litable-let-form) (overlays-at (or pos (point))))) 164 | 165 | (defun litable--point-in-overlay-p (overlay) 166 | "Return t if point is in OVERLAY." 167 | (and (< (point) (overlay-end overlay)) 168 | (> (point) (overlay-start overlay)))) 169 | 170 | (defun litable--get-overlay-length (overlay) 171 | "Compute the length of OVERLAY." 172 | (- (overlay-end overlay) (overlay-start overlay))) 173 | 174 | (defun litable--get-active-overlay (&optional pos) 175 | "Get active overlay. Active overlay is the shortest overlay at 176 | point." 177 | (let ((overlays (litable--overlays-at pos))) 178 | (cond 179 | ((not overlays) nil) 180 | ((not (cdr overlays)) (car overlays)) 181 | (t 182 | (--reduce (if (< (litable--get-overlay-length it) 183 | (litable--get-overlay-length acc)) it acc) overlays))))) 184 | 185 | (defun litable--in-var-form-p (&optional pos) 186 | "Return non-nil if POS is inside a var-form of some let-form." 187 | (setq pos (or pos (point))) 188 | (let* ((active (litable--get-active-overlay pos)) 189 | (bounds (and active (overlay-get active 'litable-var-form-bounds)))) 190 | (when bounds 191 | (and (> pos (car bounds)) 192 | (< pos (cdr bounds)))))) 193 | 194 | (defun litable-get-let-bound-variables (&optional point symbols) 195 | "Get a list of let-bound variables at POINT." 196 | (let ((active (litable--get-active-overlay point))) 197 | (when active 198 | (--map (if symbols (car it) (symbol-name (car it))) (overlay-get active 'litable-let-form-cur))))) 199 | 200 | (defun litable-get-let-bound-parent-variables (&optional point symbols) 201 | "Get a list of let-bound variables in the parent form at POINT." 202 | (let ((active (litable--get-active-overlay point))) 203 | (when active 204 | (--map (if symbols (car it) (symbol-name (car it))) (overlay-get active 'litable-let-form-prev))))) 205 | 206 | (defun litable-get-let-bound-variable-values (&optional point) 207 | (let ((active (litable--get-active-overlay point))) 208 | (when active 209 | (overlay-get active 'litable-let-form-cur)))) 210 | 211 | (defun litable-get-let-bound-parent-variable-values (&optional point) 212 | (let ((active (litable--get-active-overlay point))) 213 | (when active 214 | (overlay-get active 'litable-let-form-prev)))) 215 | 216 | (defun litable-annotate-let-forms (subs &optional point) 217 | "Annotate all let and let* forms in the defun at point." 218 | (setq point (or point (point))) 219 | (save-excursion 220 | (save-restriction 221 | (widen) 222 | (narrow-to-defun) 223 | ;; TODO: this can be made more efficient somehow -- just reuse 224 | ;; the overlays, or keep them be and skip evaling this function 225 | ;; alltogether. Will need a list of already "instrumented" 226 | ;; functions somewhere. 227 | (remove-overlays (point-min) (point-max) 'litable-let-form t) 228 | (goto-char (point-min)) 229 | (while (re-search-forward "(let\\*?" nil t) 230 | (save-excursion 231 | (goto-char (match-beginning 0)) 232 | ;; this gen error if the let form is invalid, or inside 233 | ;; macro etc. Just ignore it 234 | (ignore-errors (litable--annotate-let-form subs))))))) 235 | 236 | 237 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 238 | ;; fake eval (eval with environment) 239 | 240 | (defun litable--fake-eval (form environment &optional type) 241 | "Evaluate the FORM in ENVIRONMENT using the environment binding of TYPE. 242 | 243 | TYPE can be a symbol `let' or `let*'." 244 | (setq type (or type 'let)) 245 | (ignore-errors (litable--safe-eval `(,type ,environment ,form)))) 246 | 247 | (defun litable--alist-to-list (alist) 248 | "Change (a . b) into (a b)" 249 | (--map (list (car it) (cdr it)) alist)) 250 | 251 | (defun litable--merge-variables (overlay subs varlist) 252 | "Merge the varlist with the variables stored in overlays. 253 | 254 | This will also evaluate the newly-bound variables." 255 | (let* ((pvars (or (and overlay (overlay-get overlay 'litable-let-form-cur)) subs)) 256 | (environment (litable--alist-to-list pvars))) 257 | ;; TODO: THIS DOESN'T WORK WITH let*!! We need to update the 258 | ;; bindings one by one in that case, and merge after each update. 259 | (litable--alist-merge 260 | pvars 261 | (mapcar (lambda (it) 262 | (cons (car it) 263 | (litable--fake-eval (cadr it) environment 'let))) 264 | varlist)))) 265 | 266 | ;; TODO: this just sucks... make it better :P 267 | (defun litable--alist-merge (al1 al2) 268 | "Merge alists AL1 and AL2. 269 | 270 | Return a new copy independent of AL1 and AL2. 271 | 272 | If the same key is present in both alists, use the value from AL2 273 | in the result." 274 | (let ((re (--map (cons (car it) (cdr it)) al1))) 275 | (mapc (lambda (it) 276 | (let ((c (assoc (car it) re))) 277 | (if c 278 | (setcdr c (cdr it)) 279 | (!cons (cons (car it) (cdr it)) re)))) 280 | al2) 281 | re)) 282 | 283 | 284 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 285 | ;; argument propagation in the defuns 286 | 287 | ;; TODO: Should this be protected against unpure? I think that's 288 | ;; unecessary as it seems only variable names are being evaluated, but 289 | ;; I'm not familiar enough with the code to know. 290 | (defun litable--make-subs-list (arg-names values) 291 | "Return the list of cons pairs with symbol name in car and value in cdr." 292 | (let (r) 293 | (--each (-zip arg-names values) 294 | ;; do we want to eval here? TODO: Make it a customizable option! 295 | (!cons (cons (car it) 296 | (if (and (listp (cdr it)) (eq 'quote (cadr it))) 297 | (cdr it) 298 | (eval (cdr it)))) r)) 299 | r)) 300 | 301 | (defun litable--in-exception-form () 302 | "Test if the point is in an exception form." 303 | (save-excursion 304 | (litable-backward-up-list) 305 | (let* ((s (sexp-at-point)) 306 | (ex-form (assq (car s) litable-exceptions))) 307 | (when ex-form 308 | (down-list) 309 | (forward-sexp (cdr ex-form)) 310 | (>= (point) me))))) 311 | 312 | (defun litable--at-let-variable-def-p (me) 313 | "Test if the point is after a let variable definition." 314 | (/= me (save-excursion 315 | (litable-backward-up-list) 316 | (down-list) 317 | (forward-sexp) 318 | (point)))) 319 | 320 | (defun litable--construct-needle (variables) 321 | "Return a regexp that will search for the variable symbols." 322 | (regexp-opt (-map #'symbol-name variables) 'symbols)) 323 | 324 | ;; - maybe add different colors for different arguments that get 325 | ;; substituted. This might result in rainbows sometimes, maybe 326 | ;; undesirable 327 | ;; TODO: general warning: LONGASS FUNCTION! Refactor this into 328 | ;; something more managable. 329 | (defun litable-find-function-subs-arguments (form &optional depth) 330 | "Find the definition of \"form\" and substitute the arguments. 331 | 332 | If depth = 0, also evaluate the current form and print the result." 333 | (setq depth (or depth 0)) 334 | (let* ((symbol (and (listp form) (car form))) 335 | (name (and (symbolp symbol) (symbol-name symbol))) 336 | subs args needle) 337 | (when (and symbol 338 | (symbolp symbol) 339 | (not (keywordp symbol))) 340 | ;; recursively evaluate the arguments first 341 | (--each (cdr form) (litable-find-function-subs-arguments it (1+ depth))) 342 | (when (not (subrp (symbol-function symbol))) 343 | (save-excursion 344 | (save-restriction 345 | (widen) 346 | (goto-char 1) 347 | (when (re-search-forward (regexp-quote (concat "(defun " name)) nil t) 348 | (forward-list) (backward-list) 349 | ;; TODO: &rest, &key should be handled in some special 350 | ;; way when doing the substitution 351 | (setq args (->> (sexp-at-point) 352 | (delete '&optional) 353 | (delete '&rest))) 354 | (setq subs (litable--make-subs-list args (cdr form))) 355 | (save-restriction 356 | (narrow-to-defun) 357 | (litable-annotate-let-forms subs) 358 | (setq needle (litable--construct-needle args)) 359 | (let (mb me ms ignore) 360 | (while (re-search-forward needle nil t) 361 | (setq mb (match-beginning 0)) 362 | (setq me (match-end 0)) 363 | (setq ms (match-string 0)) 364 | ;; figure out the context here. If the sexp we're in is 365 | ;; on the exception list, move along. Maybe we shouldn't 366 | ;; censor some results though. TODO: Meditate on this 367 | (when (litable--in-exception-form) 368 | (setq ignore t)) 369 | ;; test the let form. TODO: this will go to special 370 | ;; function when we decide to do let-def-eval? 371 | (let ((in-var-form (litable--in-var-form-p))) 372 | (when in-var-form 373 | ;; we can still be at the "definition" 374 | ;; instance, that is: (>x< (blabla x)). This 375 | ;; should not get replaced by the normal value 376 | ;; but by the newly eval'd value 377 | (if (litable--at-let-variable-def-p me) 378 | (setq ignore 'let) 379 | (setq ignore 'let-def)))) 380 | (cond 381 | ((eq ignore 'let) 382 | (let* ((in-var-form (litable--in-var-form-p)) 383 | (vars (or (if in-var-form 384 | (litable-get-let-bound-parent-variable-values) 385 | (litable-get-let-bound-variable-values)) subs))) 386 | (litable--create-substitution-overlay mb me (cdr (assoc (intern ms) vars))))) 387 | ;; TODO: make this configurable too 388 | ((eq ignore 'let-def) 389 | (let ((vars (litable-get-let-bound-variable-values))) 390 | (when vars 391 | ;; TODO: make the face customizable 392 | (litable--create-substitution-overlay 393 | mb me (cdr (assoc (intern ms) vars)) 'litable-result-face)))) 394 | ((not ignore) 395 | (let ((vars (or (litable-get-let-bound-variable-values) subs))) 396 | (litable--create-substitution-overlay mb me (cdr (assoc (intern ms) vars)))))) 397 | (setq ignore nil) 398 | ;; TODO: this can be precomputed and stored in the 399 | ;; let-form overlay. I think `regexp-opt' can be 400 | ;; fairly slow at times. 401 | (setq needle (litable--construct-needle 402 | (or (litable-get-let-bound-variables nil t) args))))) 403 | ;; if depth > 0 means we're updating a defun, print the 404 | ;; end result after the end of the defun 405 | ;; TODO: add a customize to print the partial result 406 | ;; also if depth = 0 (it would be same as the final 407 | ;; result, but maybe the defun is on different screen 408 | ;; and so it will be invisible otherwise.) 409 | (when (> depth 0) 410 | (save-excursion 411 | (end-of-defun) 412 | (backward-char) 413 | (litable--print-result (litable--safe-eval form) (point) 'font-lock-constant-face))) 414 | ;; TODO: make the printing of input customizable 415 | (save-excursion 416 | (beginning-of-defun) 417 | (end-of-line) 418 | ;; TODO: make the face customizable 419 | (litable--print-input (cdr form) (point) 'font-lock-variable-name-face)))))))) 420 | (when (and (= depth 0) 421 | (nth 1 (syntax-ppss))) 422 | (let ((ostart (save-excursion 423 | (litable-goto-toplevel-form) 424 | (forward-list) 425 | (point)))) 426 | (litable--print-result (litable--safe-eval form) ostart 'litable-result-face))))) 427 | 428 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 429 | ;;; Creating and saving the pure-functions list 430 | 431 | (defcustom litable-list-file "~/.emacs.d/.litable-lists.el" 432 | "The position of the file that keeps track of known pure functions." 433 | :group 'litable 434 | :type 'file) 435 | 436 | (defun litable--save-lists () 437 | "Saves pure functions list to `litable-list-file'" 438 | (with-temp-file litable-list-file 439 | (insert ";; This file is automatically generated by litable.el.") 440 | (newline) 441 | (insert ";; It keeps track of which functions (beyond the defaults) you trust to be pure.") 442 | (newline) 443 | (newline) 444 | (litable--dump-list 'litable-pure-functions-list))) 445 | 446 | (defun litable--dump-list (list-symbol) 447 | "Insert (setq 'LIST-SYMBOL (append LIST-VALUE LIST-SYMBOL-default) to current buffer." 448 | (cl-symbol-macrolet ((value (symbol-value list-symbol))) 449 | (insert "(setq " (symbol-name list-symbol) "\n" 450 | " '(") 451 | (newline-and-indent) 452 | (set list-symbol 453 | (sort value (lambda (x y) (string-lessp (symbol-name x) 454 | (symbol-name y))))) 455 | (mapc #'(lambda (cmd) (insert (format "%S" cmd)) (newline-and-indent)) 456 | value) 457 | (insert "))") 458 | (newline))) 459 | 460 | (defvar litable-pure-functions-list 461 | '( 462 | % 463 | * 464 | + 465 | - 466 | -zip 467 | / 468 | 1+ 469 | 1- 470 | LaTeX-back-to-indentation 471 | LaTeX-current-environment 472 | LaTeX-default-environment 473 | LaTeX-default-style 474 | LaTeX-find-matching-begin 475 | LaTeX-mark-environment 476 | TeX-active-master 477 | TeX-check-files 478 | TeX-fold-mode 479 | TeX-normal-mode 480 | TeX-output-extension 481 | abbreviate-file-name 482 | abs 483 | activate-mark 484 | add-text-properties 485 | alist 486 | and 487 | append 488 | aref 489 | assoc 490 | assq 491 | back-to-indentation 492 | backward-char 493 | backward-list 494 | backward-sexp 495 | backward-up-list 496 | backward-word 497 | beginning-of-buffer 498 | beginning-of-defun 499 | beginning-of-line 500 | beginning-of-thing 501 | boundp 502 | bounds-of-thing-at-point 503 | browse-url-encode-url 504 | buffer-end 505 | buffer-file-name 506 | buffer-list 507 | buffer-live-p 508 | buffer-modified-p 509 | buffer-name 510 | buffer-read-only 511 | buffer-string 512 | buffer-substring 513 | buffer-substring-no-properties 514 | c-end-of-defun 515 | caar 516 | cadr 517 | called-interactively-p 518 | capitalize 519 | car 520 | car-safe 521 | case 522 | catch 523 | cdar 524 | cddr 525 | cdr 526 | cdr-safe 527 | ceiling 528 | char-displayable-p 529 | char-to-string 530 | check-parens 531 | cl-copy-list 532 | cl-find 533 | cl-loop 534 | cl-member 535 | cl-remove-if 536 | cl-signum 537 | comment-region 538 | compare-strings 539 | compilation-buffer-internal-p 540 | completing-read 541 | con 542 | concat 543 | concatenate 544 | cond 545 | condition-case 546 | cons 547 | consp 548 | copy-sequence 549 | count 550 | count-if 551 | current-buffer 552 | current-column 553 | current-prefix-arg 554 | current-time 555 | current-time-string 556 | date-to-time 557 | decf 558 | default-directory 559 | directory-file-name 560 | directory-files 561 | dired-get-filename 562 | dired-next-line 563 | display-graphic-p 564 | dolist 565 | dotimes 566 | down-list 567 | downcase 568 | elt 569 | emacs-uptime 570 | end-of-defun 571 | end-of-line 572 | end-of-thing 573 | eobp 574 | eolp 575 | eq 576 | equal 577 | error 578 | error-message-string 579 | executable-find 580 | expand-file-name 581 | fboundp 582 | file-attributes 583 | file-directory-p 584 | file-exists-p 585 | file-expand-wildcards 586 | file-name 587 | file-name-absolute-p 588 | file-name-as-directory 589 | file-name-base 590 | file-name-directory 591 | file-name-extension 592 | file-name-nondirectory 593 | file-name-sans-extension 594 | file-readable-p 595 | file-regular-p 596 | file-relative-name 597 | file-remote-p 598 | file-writable-p 599 | find-if 600 | first 601 | float-time 602 | floor 603 | for 604 | format 605 | format-mode-line 606 | format-time-string 607 | forward-char 608 | forward-line 609 | forward-list 610 | forward-sexp 611 | frame-first-window 612 | frame-parameter 613 | frame-width 614 | fresets 615 | functionp 616 | get 617 | get-buffer-process 618 | get-buffer-window 619 | get-buffer-window-list 620 | get-char-property 621 | getenv 622 | gethash 623 | goto-char 624 | goto-line 625 | if 626 | ignore-errors 627 | int-to-string 628 | integer-or-marker-p 629 | integerp 630 | interactive 631 | jabber-muc-sender-p 632 | json-encode 633 | json-encode-alist 634 | json-encode-string 635 | json-join 636 | kbd 637 | key-binding 638 | keywordp 639 | lambda 640 | length 641 | let 642 | let* 643 | line-beginning-position 644 | line-end-position 645 | line-number-at-pos 646 | list 647 | list-system-processes 648 | listify-key-sequence 649 | listp 650 | litable-create-fake-cursor-at-point 651 | local-key-binding 652 | log 653 | looking-at 654 | looking-back 655 | loop 656 | make-hash-table 657 | make-marker 658 | make-overlay 659 | make-sparse-keymap 660 | make-string 661 | make-symbol 662 | mark 663 | mark-marker 664 | mark-sexp 665 | match-beginning 666 | match-data 667 | match-data-list 668 | match-end 669 | match-string 670 | match-string-no-properties 671 | max 672 | member 673 | memq 674 | message 675 | mew-summary-display 676 | min 677 | minibufferp 678 | minor-mode-key-binding 679 | mode-line-eol-desc 680 | move-beginning-of-line 681 | move-end-of-line 682 | move-overlay 683 | not 684 | nth 685 | null 686 | number-or-marker-p 687 | number-to-string 688 | numberp 689 | one-window-p 690 | or 691 | overlay-end 692 | overlay-get 693 | overlay-put 694 | overlay-start 695 | overlays 696 | overlays-at 697 | overlays-in 698 | paredit-backward-up 699 | plist-get 700 | point 701 | point-max 702 | point-min 703 | pp-to-string 704 | princ 705 | print 706 | process-attributes 707 | process-get 708 | process-status 709 | progn 710 | propertize 711 | quote 712 | random 713 | rassoc 714 | re-search-backward 715 | re-search-forward 716 | regexp-opt 717 | regexp-quote 718 | region-active-p 719 | region-beginning 720 | region-end 721 | remove-duplicates 722 | remove-if 723 | remove-if-not 724 | remove-overlays 725 | replace-regexp-in-string 726 | replace-string 727 | reverse 728 | save-current-buffer 729 | save-excursion 730 | save-match-data 731 | save-restriction 732 | secure-hash 733 | set 734 | set-buffer 735 | set-buffer-modified-p 736 | setf 737 | setq 738 | sexp-at-point 739 | signal 740 | sin 741 | skip-chars-backward 742 | skip-chars-forward 743 | split-string 744 | string 745 | string-equal 746 | string-lessp 747 | string-match 748 | string-match-p 749 | string-prefix-p 750 | string-to-char 751 | string-to-list 752 | string-to-number 753 | string< 754 | string= 755 | stringp 756 | strings 757 | subrp 758 | substring 759 | substring-no-properties 760 | symbol-function 761 | symbol-macrolet 762 | symbol-name 763 | symbol-regexp 764 | symbol-value 765 | symbolp 766 | tan 767 | text-properties-at 768 | thing-at-point 769 | thing-at-point-looking-at 770 | this-command-keys 771 | throw 772 | time-since 773 | time-to-seconds 774 | type-of 775 | unless 776 | unwind-protect 777 | upcase 778 | url-hexify-string 779 | use-region-p 780 | user-full-name 781 | variable-at-point 782 | variables 783 | vector 784 | verify-visited-file-modtime 785 | version-to-list 786 | warn 787 | when 788 | while 789 | window-list 790 | window-live-p 791 | window-start 792 | window-width 793 | with-current-buffer 794 | with-output-to-string 795 | with-temp-buffer 796 | y-or-n-p 797 | yes-or-no-p 798 | zerop 799 | ) 800 | "List of additional function considered pure (and thus safe) by litable. 801 | 802 | Litable will only execute functions marked as pure by the 803 | byte-compiler, or whitelisted here. See `literable--pure-p'. 804 | 805 | Functions that take predicates as arguments (such as `remove-if') 806 | are included here even though they aren't necessarily pure. That 807 | is because we assume the predicate will be a pure function. 808 | 809 | Functions that evaluate arbitrary code (eval, apply, funcall) are 810 | NOT included here and should never be.") 811 | 812 | (if (file-exists-p litable-list-file) 813 | (load litable-list-file t) 814 | (litable--save-lists)) 815 | 816 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 817 | ;;; Check for impure functions 818 | (defvar litable--impure-found nil "Used to keep track of impure functions found.") 819 | 820 | (defun litable-accept-as-pure (batch) 821 | "Saves as pure the currently found impure functions. 822 | 823 | Asking for confirmation, adds each impure function found to 824 | `litable-pure-functions-list' (and saves the list). 825 | 826 | With BATCH prefix argument, asks only once for all." 827 | (interactive "P") 828 | (if batch 829 | (when (y-or-n-p (format "Save ALL these functions as pure? %s" litable--impure-found)) 830 | (mapc (lambda (x) (add-to-list 'litable-pure-functions-list x)) 831 | litable--impure-found)) 832 | (dolist (cur litable--impure-found) 833 | (when (y-or-n-p (format "Save %s as pure?" cur)) 834 | (add-to-list 'litable-pure-functions-list cur)))) 835 | (litable--save-lists)) 836 | 837 | (defun litable--pure-at-point () 838 | "Return symbol at point if it's a pure function." 839 | (let ((sym (symbol-at-point))) 840 | (when (and 841 | (functionp sym) 842 | (-contains-p litable-pure-functions-list sym)) 843 | sym))) 844 | 845 | (defun litable-remove-from-pure-list () 846 | "Remove a function from the pure functions list. 847 | 848 | Provide completion for the content of `litable-pure-functions-list' 849 | using `completing-read', remove the selected candidate and save the list." 850 | (interactive) 851 | (if (null litable-pure-functions-list) 852 | (message "No function trusted to be pure.") 853 | (let ((symbol 854 | (completing-read "Pure function: " 855 | litable-pure-functions-list 856 | nil t 857 | (if-let (sym-at-pt (litable--pure-at-point)) 858 | (symbol-name sym-at-pt) nil)))) 859 | (setq litable-pure-functions-list 860 | (delq (intern symbol) litable-pure-functions-list)) 861 | (litable--save-lists)))) 862 | 863 | (defun litable--pure-p (fn-symbol) 864 | "Return non-nil if fn-symbol is a pure function." 865 | (and (fboundp fn-symbol) 866 | (or 867 | (get fn-symbol 'side-effect-free) 868 | (member fn-symbol litable-pure-functions-list)))) 869 | 870 | (defun litable--safe-eval (form) 871 | "Check if FORM contains only known pure functions and eval it. 872 | 873 | If it doesn't, don't eval and return a warning string. 874 | Functions can be accepted as pure with `litable-accept-as-pure'." 875 | ;; We'll keep track of whether an impure function was found. 876 | ;; This is a setq instead of a let-form, because this way we can use 877 | ;; this information interactively in `litable-accept-as-pure'. 878 | (setq litable--impure-found nil) 879 | (litable--deep-search-for-impures form) 880 | ;; If it was, we report 881 | (if litable--impure-found 882 | (format "Unsafe functions: %S" litable--impure-found) 883 | ;; If it wasn't, we evaluate as expected 884 | (eval form))) 885 | 886 | (defun litable--deep-search-for-impures (form) 887 | "Check whether all car's inside FORM are pure. 888 | 889 | If any isn't a pure function, reports in the variable `litable--impure-found'." 890 | ;; It's possible we got passed a nil form, if so just ignore it. 891 | (when form 892 | (if (not (listp form)) 893 | ;; If it's not a list, it is the function name 894 | (unless (litable--pure-p form) 895 | (add-to-list 'litable--impure-found form)) 896 | ;; If it's a list, it is the entire function call. Check the name, 897 | ;; and search the arguments for more function calls. Plain 898 | ;; arguments don't get checked. 899 | (let ((function (car form)) 900 | (rest (cdr form))) 901 | (cond 902 | ;; If it's a let form, try to do the right thing about its 903 | ;; arguments. 904 | ((string-match "\\`let\\*?\\'" (symbol-name function)) 905 | (dolist (cur (car rest)) ;For each item in the first form 906 | (when (and (listp cur) (listp (cadr cur))) ;If the variable's value is set with a function call 907 | (litable--deep-search-for-impures (cadr cur)))) ;Check the function call 908 | (dolist (cur (cdr rest)) ;Then check the actual content of the let form 909 | (when (listp cur) (litable--deep-search-for-impures cur)))) 910 | ;; If it's a lambda, we can skip the first argument (it's the 911 | ;; argument list) but we need to check the rest. 912 | ((eq function 'lambda) 913 | (dolist (cur (cdr rest)) 914 | (when (listp cur) (litable--deep-search-for-impures cur)))) 915 | ;; Anything inside a quote is considered safe, because 916 | ;; anything that could evaluate it (eval, funcall, etc) is 917 | ;; considered unsafe. The exception are functions with 918 | ;; predicates (remove-if), but we assume these functions will 919 | ;; use plain lambdas instead of quotes. 920 | ((eq function 'quote) nil) 921 | ((eq function 'function) nil) 922 | ;; A ` is similar to a quote, except we need to check the evaluated arguments 923 | ((eq function '\`) 924 | (dolist (cur (car rest)) ;; rest is a 1-element list. This 1 element is a list contain all the arguments to the `. 925 | (when (listp cur) (litable--deep-search-for-commas cur)))) 926 | ;; Anything else is a typical function, just check the name and 927 | ;; the arguments. 928 | (t 929 | (litable--deep-search-for-impures function) 930 | (dolist (cur rest) 931 | (when (listp cur) (litable--deep-search-for-impures cur))))))))) 932 | 933 | ;; TODO: This is not being used right now. For some reason the 934 | ;; evaluator doesn't even get called when there's a "," in the form. 935 | ;; Is this intentional? 936 | (defun litable--deep-search-for-commas (form) 937 | "Deep search in form for a \",\". When found, pass its argument to `litable--deep-search-for-impures'. " 938 | (when (listp form) 939 | (let ((function (car form)) 940 | (rest (cdr form))) 941 | (if (eq function '\,) 942 | (litable--deep-search-for-impures rest) 943 | (dolist (cur rest) 944 | (when (listp cur) (litable--deep-search-for-commas cur))))))) 945 | 946 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 947 | ;;; Printing the result 948 | 949 | ;; TODO: both print-result and print-input should accumulate the 950 | ;; results in a variable (for each defun? -- alist?) and then only 951 | ;; print int in single overlay after all the updating is done 952 | ;; (i.e. when the final result is printed as well). Right now, each 953 | ;; input/output has its own overlay. 954 | 955 | ;; TODO: shorten the result if too long? Add customize limit for 956 | ;; cut-off. Maybe echo the full thing in the echo area/print in msg 957 | ;; log <- maybe not a good idea, it will produce tons of spam. 958 | (defun litable--print-result (result pos face) 959 | "Print the RESULT of evaluating form at POS. 960 | Fontify the result using FACE." 961 | (let* ((o (make-overlay pos pos)) 962 | (print-quoted t) 963 | (s (format litable-result-format (funcall litable-print-function result)))) 964 | (push o litable-overlays) 965 | (litable--set-result-overlay-priority o) 966 | (put-text-property 0 1 'cursor t s) 967 | (overlay-put o 968 | 'before-string 969 | (funcall litable-result-overlay-text-function s face)))) 970 | 971 | (defun litable--create-result-overlay-text (s &optional face) 972 | "Create the text for the overlay that shows the result." 973 | (format "%s%s" " " (propertize s 'face (or face 'litable-result-face)))) 974 | 975 | (defun litable--print-input (input pos face) 976 | "Print the INPUT for the evaluated form at POS. 977 | Fontify the input using FACE." 978 | (let ((o (make-overlay pos pos)) 979 | (print-quoted t)) 980 | (push o litable-overlays) 981 | (litable--set-result-overlay-priority o) 982 | (overlay-put o 983 | ;; TODO: add customize to reverse the order of input args. Now it 984 | ;; resemples LIFO, should be FIFO! 985 | ;; 986 | ;; (defun foo (x) <= (- 10 5) <= 2 987 | ;; (1+ x)) => 6 => 3 988 | ;; 989 | ;; (+ (foo (- 10 5)) (foo 2) 3 4) => 16 990 | ;; before-string <-> after-string 991 | 'before-string 992 | (propertize 993 | ;; TODO: extract this format into customize 994 | (format " <= %s" (mapconcat litable-print-function input ", ")) 995 | 'face face)))) 996 | 997 | (defun litable--create-substitution-overlay (start end value &optional face) 998 | "Create the overlay that shows the substituted value." 999 | ;; TODO: make the face customizable 1000 | (setq face (or face 'litable-substitution-face)) 1001 | (let (o (print-quoted t)) 1002 | (setq o (make-overlay start end)) 1003 | (push o litable-overlays) 1004 | (litable--set-overlay-priority o) 1005 | (overlay-put o 'display 1006 | ;; TODO: customize max-length 1007 | ;; for the subexpression, then 1008 | ;; cut off and replace with 1009 | ;; "bla..." 1010 | (funcall 1011 | litable-substitution-overlay-text-function 1012 | ms 1013 | (funcall litable-print-function value))))) 1014 | 1015 | (defun litable--create-substitution-overlay-text (exp value &optional face) 1016 | "Create the text for the overlay that shows the substitution." 1017 | (format "%s %s" exp (propertize value 'face (or face 'litable-substitution-face)))) 1018 | 1019 | 1020 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 1021 | ;; navigation 1022 | 1023 | (defun litable--next-sexp () 1024 | (ignore-errors 1025 | (forward-sexp)) 1026 | (ignore-errors 1027 | (forward-sexp)) 1028 | (ignore-errors 1029 | (backward-sexp))) 1030 | 1031 | ;; stolen from mastering emacs comments 1032 | (defun litable-backward-up-list () 1033 | "Stupid backward-up-list doesn't work from inside a string and 1034 | I got tired of having to move outside the string to use it." 1035 | (interactive) 1036 | (when (in-string-p) 1037 | (while (in-string-p) 1038 | (backward-char))) 1039 | (backward-up-list)) 1040 | 1041 | 1042 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 1043 | ;; updating the overlays 1044 | 1045 | (defun litable-goto-toplevel-form () 1046 | (while (/= (car (syntax-ppss)) 0) (litable-backward-up-list))) 1047 | 1048 | (defun litable-update-defs (&optional a b c) 1049 | (litable-remove-overlays) 1050 | (when a 1051 | (ignore-errors 1052 | (let ((form (save-excursion 1053 | (litable-goto-toplevel-form) 1054 | (sexp-at-point)))) 1055 | (litable-find-function-subs-arguments form))))) 1056 | 1057 | (defvar litable--current-end-position nil "End position of current top level sexp.") 1058 | (defvar litable--current-beginning-position nil "Beginning position of current top level sexp.") 1059 | 1060 | (defun litable-update-defs-if-moved () 1061 | "Run `litable-update-defs' only if moved to a different toplevel sexp." 1062 | (when litable-update-on-move 1063 | (let ((beginning (save-excursion (ignore-errors (beginning-of-defun)) (point))) 1064 | (end (save-excursion (ignore-errors (end-of-defun)) (point)))) 1065 | (unless (and litable--current-end-position 1066 | litable--current-beginning-position 1067 | (or (= litable--current-beginning-position beginning) 1068 | (= litable--current-end-position end))) 1069 | (setq litable--current-end-position end) 1070 | (setq litable--current-beginning-position beginning) 1071 | (litable-update-defs 1))))) 1072 | 1073 | 1074 | (defun litable-refresh () 1075 | (interactive) 1076 | (litable-update-defs 1)) 1077 | 1078 | ;; TODO: if the same function is eval'd twice, also all the overlays 1079 | ;; are created twice. Maybe we should keep an alist (defun . overlays 1080 | ;; in defun) and reuse/update them. But, until we hit performance 1081 | ;; issues, doesn't matter -- for now fixed with priorities. 1082 | (defvar litable-overlays nil) 1083 | 1084 | (defcustom litable-overlay-priority 0 1085 | "Overlay priority" 1086 | :type 'integer 1087 | :group 'litable) 1088 | 1089 | (defcustom litable-result-overlay-priority 0 1090 | "Result overlay priority" 1091 | :type 'integer 1092 | :group 'litable) 1093 | 1094 | (defcustom litable-update-on-move t 1095 | "If non-nil, overlays are updated when point moves. 1096 | 1097 | This allows the overlay to \"follow\" the point. 1098 | 1099 | Independent of this variable, overlays are also updated when the 1100 | buffer is edited." 1101 | :type 'boolean 1102 | :group 'litable 1103 | :package-version '(litable . "0.0.20130408")) 1104 | 1105 | ;; internal variables 1106 | (defvar litable--overlay-priority litable-overlay-priority) 1107 | (defvar litable--result-overlay-priority litable-result-overlay-priority) 1108 | 1109 | (defun litable--set-overlay-priority (overlay) 1110 | (setq litable--overlay-priority (1+ litable--overlay-priority)) 1111 | (overlay-put overlay 'priority litable--overlay-priority)) 1112 | 1113 | (defun litable--set-result-overlay-priority (overlay) 1114 | (setq litable--result-overlay-priority (1+ litable--result-overlay-priority)) 1115 | (overlay-put overlay 'priority litable--result-overlay-priority)) 1116 | 1117 | (defun litable-remove-overlays () 1118 | (--each litable-overlays (delete-overlay it)) 1119 | (setq litable-overlays nil) 1120 | (setq litable--overlay-priority litable-overlay-priority) 1121 | (setq litable--result-overlay-priority litable-result-overlay-priority)) 1122 | 1123 | (defvar litable-mode-map (make-sparse-keymap) 1124 | "litable mode map.") 1125 | 1126 | (defcustom litable-mode-hook nil 1127 | "Hook for `litable-mode'." 1128 | :type 'hook 1129 | :group 'litable) 1130 | 1131 | (defun litable-init () 1132 | "Initialize litable in the buffer." 1133 | (add-hook 'after-change-functions 'litable-update-defs nil t) 1134 | (add-hook 'post-command-hook 'litable-update-defs-if-moved nil t) 1135 | (make-local-variable 'litable--current-end-position) 1136 | (make-local-variable 'litable--current-beginning-position) 1137 | (litable-update-defs 1) 1138 | (run-hooks 'litable-mode-hook)) 1139 | 1140 | (defun litable-stop () 1141 | "Stop litable in the buffer." 1142 | (remove-hook 'after-change-functions 'litable-update-defs t) 1143 | (remove-hook 'post-command-hook 'litable-update-defs-if-moved t) 1144 | (litable-remove-overlays)) 1145 | 1146 | ;;;###autoload 1147 | (define-minor-mode litable-mode 1148 | "Toggle litable-mode" 1149 | :lighter " litable" 1150 | :keymap litable-mode-map 1151 | :group 'litable 1152 | (if litable-mode 1153 | (litable-init) 1154 | (litable-stop))) 1155 | 1156 | (provide 'litable) 1157 | 1158 | ;;; litable.el ends here 1159 | -------------------------------------------------------------------------------- /screenshot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Fuco1/litable/b83b1283ea6642ab82f536f1f3b280160404ff6b/screenshot.png --------------------------------------------------------------------------------