1 ;;; sotlisp.el --- Write lisp at the speed of thought. -*- lexical-binding: t; -*-
3 ;; Copyright (C) 2014, 2015 Free Software Foundation, Inc.
5 ;; Author: Artur Malabarba <emacs@endlessparentheses.com>
6 ;; URL: https://github.com/Malabarba/speed-of-thought-lisp
7 ;; Keywords: convenience, lisp
8 ;; Package-Requires: ((emacs "24.1"))
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.
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.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
26 ;; This defines a new global minor-mode `speed-of-thought-mode', which
27 ;; activates locally on any supported buffer. Currently, only
28 ;; `emacs-lisp-mode' buffers are supported.
30 ;; The mode is quite simple, and is composed of two parts:
34 ;; A large number of abbrevs which expand function
35 ;; initials to their name. A few examples:
37 ;; - wcb -> with-current-buffer
42 ;; However, these are defined in a way such that they ONLY expand in a
43 ;; place where you would use a function, so hitting SPC after "(r"
44 ;; expands to "(require '", but hitting SPC after "(delete-region r"
45 ;; will NOT expand the `r', because that's obviously not a function.
46 ;; Furtheromre, "#'r" will expand to "#'require" (note how it ommits
47 ;; that extra quote, since it would be useless here).
51 ;; It also defines 4 commands, which really fit into this "follow the
52 ;; thought-flow" way of writing. The bindings are as follows, I
53 ;; understand these don't fully adhere to conventions, and I'd
54 ;; appreciate suggestions on better bindings.
56 ;; - M-RET :: Break line, and insert "()" with point in the middle.
57 ;; - C-RET :: Do `forward-up-list', then do M-RET.
59 ;; Hitting RET followed by a `(' was one of the most common key sequences
60 ;; for me while writing elisp, so giving it a quick-to-hit key was a
61 ;; significant improvement.
63 ;; - C-c f :: Find function under point. If it is not defined, create a
64 ;; definition for it below the current function and leave point inside.
65 ;; - C-c v :: Same, but for variable.
67 ;; With these commands, you just write your code as you think of it. Once
68 ;; you hit a "stop-point" of sorts in your tought flow, you hit `C-c f/v`
69 ;; on any undefined functions/variables, write their definitions, and hit
70 ;; `C-u C-SPC` to go back to the main function.
74 ;; With the above (assuming you use something like paredit or
75 ;; electric-pair-mode), if you write:
77 ;; ( w t b M-RET i SPC text
81 ;; (with-temp-buffer (insert text))
86 (defun sotlisp--auto-paired-p ()
87 "Non-nil if this buffer auto-inserts parentheses."
88 (or (bound-and-true-p electric-pair-mode)
89 (bound-and-true-p paredit-mode)
90 (bound-and-true-p smartparens-mode)))
92 (defun sotlisp--looking-back (regexp)
95 (buffer-substring (line-beginning-position) (point))))
97 (defun sotlisp--function-form-p ()
98 "Non-nil if point is at the start of a sexp.
99 Specially, avoids matching inside argument lists."
100 (and (eq (char-before) ?\()
101 (not (sotlisp--looking-back "(\\(defun\\s-+.*\\|\\(lambda\\|dolist\\|dotimes\\)\\s-+\\)("))
109 (looking-at-p (rx (* (or (syntax word) (syntax symbol) "-"))
112 (not (string-match (rx (syntax symbol)) (string last-command-event)))))
114 (defun sotlisp--function-quote-p ()
115 "Non-nil if point is at a sharp-quote."
119 (looking-at-p "#'"))))
121 (defun sotlisp--code-p ()
125 (let ((pps (parse-partial-sexp (point) r)))
129 (defun sotlisp--function-p ()
130 "Non-nil if point is at reasonable place for a function name.
131 Returns non-nil if, after moving backwards by a sexp, either
132 `sotlisp--function-form-p' or `sotlisp--function-quote-p' return
136 (skip-chars-backward (rx alnum))
137 (and (sotlisp--code-p)
138 (or (sotlisp--function-form-p)
139 (sotlisp--function-quote-p))))))
141 (defun sotlisp--whitespace-p ()
142 "Non-nil if current `self-insert'ed char is whitespace."
143 (sotlisp--whitespace-char-p last-command-event))
144 (make-obsolete 'sotlisp--whitespace-p 'sotlisp--whitespace-char-p "1.2")
146 (defun sotlisp--whitespace-char-p (char)
147 "Non-nil if CHAR is has whitespace syntax."
149 (string-match (rx space) (string char))))
153 (defvar sotlisp--needs-moving nil
154 "Will `sotlisp--move-to-$' move point after insertion?")
156 (defun sotlisp--move-to-$ ()
157 "Move backwards until `$' and delete it.
158 Point is left where the `$' char was. Does nothing if variable
159 `sotlisp-mode' is nil."
160 (when (bound-and-true-p speed-of-thought-mode)
161 (when sotlisp--needs-moving
162 (setq sotlisp--needs-moving nil)
163 (skip-chars-backward "^\\$")
166 (add-hook 'post-command-hook #'sotlisp--move-to-$ 'append)
168 (defun sotlisp--maybe-skip-closing-paren ()
169 "Move past `)' if variable `electric-pair-mode' is enabled."
170 (when (and (char-after ?\))
171 (sotlisp--auto-paired-p))
174 (defun sotlisp--post-expansion-cleanup ()
175 "Do some processing conditioned on the expansion done.
176 If the command that triggered the expansion was a whitespace
177 char, perform the steps below and return t.
179 If the expansion ended in a $, delete it and call
180 `sotlisp--maybe-skip-closing-paren'.
181 If it ended in a space and there's a space ahead, delete the
183 ;; Inform `expand-abbrev' that `self-insert-command' should not
184 ;; trigger, by returning non-nil on SPC.
185 (when (sotlisp--whitespace-char-p last-command-event)
186 ;; And maybe move out of closing paren if expansion ends with $.
187 (if (eq (char-before) ?$)
188 (progn (delete-char -1)
189 (setq sotlisp--needs-moving nil)
190 (sotlisp--maybe-skip-closing-paren))
191 (when (and (sotlisp--whitespace-char-p (char-after))
192 (sotlisp--whitespace-char-p (char-before)))
196 (defvar sotlisp--function-table (make-hash-table :test #'equal)
197 "Table where function abbrev expansions are stored.")
199 (defun sotlisp--expand-function ()
200 "Expand the function abbrev before point.
201 See `sotlisp-define-function-abbrev'."
203 (skip-chars-backward (rx alnum))
204 (let* ((name (buffer-substring (point) r))
205 (expansion (gethash name sotlisp--function-table)))
207 (progn (goto-char r) nil)
208 (delete-region (point) r)
209 (if (sotlisp--function-quote-p)
210 ;; After #' use the simple expansion.
211 (insert (sotlisp--simplify-function-expansion expansion))
212 ;; Inside a form, use the full expansion.
214 (when (string-match "\\$" expansion)
215 (setq sotlisp--needs-moving t)))
217 (sotlisp--post-expansion-cleanup)))))
219 (put 'sotlisp--expand-function 'no-self-insert t)
221 (defun sotlisp--simplify-function-expansion (expansion)
222 "Take a substring of EXPANSION up to first space.
223 The space char is not included. Any \"$\" are also removed."
224 (replace-regexp-in-string
226 (substring expansion 0 (string-match " " expansion))))
229 ;;; Abbrev definitions
230 (defconst sotlisp--default-function-abbrevs
233 ("ah" . "add-hook '")
234 ("atl" . "add-to-list '")
235 ("bb" . "bury-buffer")
236 ("bc" . "forward-char -1")
237 ("bfn" . "buffer-file-name")
238 ("bl" . "buffer-list$")
239 ("blp" . "buffer-live-p ")
240 ("bn" . "buffer-name")
241 ("bod" . "beginning-of-defun")
242 ("bol" . "forward-line 0$")
244 ("bs" . "buffer-string$")
245 ("bsn" . "buffer-substring-no-properties")
246 ("bss" . "buffer-substring ")
247 ("bw" . "forward-word -1")
249 ("ca" . "char-after$")
250 ("cb" . "current-buffer$")
251 ("cc" . "condition-case er\n$\n(error nil)")
252 ("ci" . "call-interactively ")
253 ("cip" . "called-interactively-p 'any")
254 ("csv" . "customize-save-variable '")
255 ("d" . "delete-char 1")
256 ("dc" . "delete-char 1")
257 ("dcu" . "defcustom $ t\n \"\"\n :type 'boolean")
258 ("df" . "defun $ ()\n \"\"\n ")
259 ("dfa" . "defface $ \n '((t))\n \"\"\n ")
260 ("dfc" . "defcustom $ t\n \"\"\n :type 'boolean")
261 ("dff" . "defface $ \n '((t))\n \"\"\n ")
262 ("dfv" . "defvar $ t\n \"\"")
263 ("dk" . "define-key ")
264 ("dl" . "dolist (it $)")
265 ("dt" . "dotimes (it $)")
266 ("dmp" . "derived-mode-p '")
267 ("dm" . "defmacro $ ()\n \"\"\n ")
268 ("dr" . "delete-region ")
269 ("dv" . "defvar $ t\n \"\"")
270 ("e" . "error \"$\"")
271 ("ef" . "executable-find ")
272 ("efn" . "expand-file-name ")
273 ("eol" . "end-of-line")
274 ("f" . "format \"$\"")
276 ("fbp" . "fboundp '")
277 ("fc" . "forward-char 1")
278 ("ff" . "find-file ")
279 ("fl" . "forward-line 1")
280 ("fp" . "functionp ")
281 ("frp" . "file-readable-p ")
282 ("fs" . "forward-sexp 1")
284 ("fw" . "forward-word 1")
286 ("gc" . "goto-char ")
287 ("gsk" . "global-set-key ")
289 ("ie" . "ignore-errors ")
290 ("ii" . "interactive")
291 ("il" . "if-let (($))")
292 ("ir" . "indent-region ")
293 ("jcl" . "justify-current-line ")
294 ("jl" . "delete-indentation")
295 ("jos" . "just-one-space")
296 ("jr" . "json-read$")
297 ("jtr" . "jump-to-register ")
299 ("kb" . "kill-buffer")
303 ("la" . "looking-at \"$\"")
304 ("lap" . "looking-at-p \"$\"")
305 ("lb" . "looking-back \"$\"")
306 ("lbp" . "line-beginning-position")
307 ("lep" . "line-end-position")
308 ("let" . "let (($))")
310 ("m" . "message \"$%s\"")
311 ("mb" . "match-beginning 0")
313 ("mct" . "mapconcat ")
314 ("me" . "match-end 0")
315 ("ms" . "match-string 0")
316 ("msn" . "match-string-no-properties 0")
317 ("msnp" . "match-string-no-properties 0")
318 ("msp" . "match-string-no-properties 0")
319 ("mt" . "mapconcat ")
321 ("nai" . "newline-and-indent$")
322 ("nl" . "forward-line 1")
324 ("ntr" . "narrow-to-region ")
325 ("ow" . "other-window 1")
327 ("pm" . "point-marker$")
328 ("pa" . "point-max$")
329 ("pg" . "plist-get ")
330 ("pi" . "point-min$")
331 ("pz" . "propertize ")
333 ("ra" . "use-region-p$")
334 ("rap" . "use-region-p$")
335 ("rb" . "region-beginning")
336 ("re" . "region-end")
337 ("rh" . "remove-hook '")
338 ("rm" . "replace-match \"$\"")
339 ("ro" . "regexp-opt ")
340 ("rq" . "regexp-quote ")
341 ("rris" . "replace-regexp-in-string ")
342 ("rrs" . "replace-regexp-in-string ")
343 ("rs" . "while (search-forward $ nil t)\n(replace-match \"\") nil t)")
344 ("rsb" . "re-search-backward \"$\" nil 'noerror")
345 ("rsf" . "re-search-forward \"$\" nil 'noerror")
347 ("sb" . "search-backward $ nil 'noerror")
348 ("sbr" . "search-backward-regexp $ nil 'noerror")
349 ("scb" . "skip-chars-backward \"$\\r\\n[:blank:]\"")
350 ("scf" . "skip-chars-forward \"$\\r\\n[:blank:]\"")
351 ("se" . "save-excursion")
352 ("sf" . "search-forward $ nil 'noerror")
353 ("sfr" . "search-forward-regexp $ nil 'noerror")
354 ("sic" . "self-insert-command")
355 ("sl" . "setq-local ")
356 ("sm" . "string-match \"$\"")
357 ("smd" . "save-match-data")
358 ("sn" . "symbol-name ")
361 ("sr" . "save-restriction")
362 ("ss" . "substring ")
363 ("ssn" . "substring-no-properties ")
364 ("ssnp" . "substring-no-properties ")
365 ("stb" . "switch-to-buffer ")
366 ("sw" . "selected-window$")
368 ("tap" . "thing-at-point 'symbol")
371 ("up" . "unwind-protect\n(progn $)")
372 ("urp" . "use-region-p$")
374 ("wcb" . "with-current-buffer ")
375 ("wf" . "write-file ")
377 ("wl" . "when-let (($))")
378 ("we" . "window-end")
379 ("ws" . "window-start")
380 ("wsw" . "with-selected-window ")
381 ("wtb" . "with-temp-buffer")
382 ("wtf" . "with-temp-file ")
384 "Alist of (ABBREV . EXPANSION) used by `sotlisp'.")
386 (defun sotlisp-define-function-abbrev (name expansion)
387 "Define a function abbrev expanding NAME to EXPANSION.
388 This abbrev will only be expanded in places where a function name is
389 sensible. Roughly, this is right after a `(' or a `#''.
391 If EXPANSION is any string, it doesn't have to be the just the
392 name of a function. In particular:
393 - if it contains a `$', this char will not be inserted and
394 point will be moved to its position after expansion.
395 - if it contains a space, only a substring of it up to the
396 first space is inserted when expanding after a `#'' (this is done
397 by defining two different abbrevs).
399 For instance, if one defines
400 (sotlisp-define-function-abbrev \"d\" \"delete-char 1\")
402 then triggering `expand-abbrev' after \"d\" expands in the
405 #'d => #'delete-char"
406 (define-abbrev emacs-lisp-mode-abbrev-table
407 name t #'sotlisp--expand-function
408 ;; Don't override user abbrevs
410 ;; Only expand in function places.
411 :enable-function #'sotlisp--function-p)
412 (puthash name expansion sotlisp--function-table))
414 (defun sotlisp-erase-all-abbrevs ()
415 "Undefine all abbrevs defined by `sotlisp'."
417 (maphash (lambda (x _) (define-abbrev emacs-lisp-mode-abbrev-table x nil))
418 sotlisp--function-table))
420 (defun sotlisp-define-all-abbrevs ()
421 "Define all abbrevs in `sotlisp--default-function-abbrevs'."
423 (mapc (lambda (x) (sotlisp-define-function-abbrev (car x) (cdr x)))
424 sotlisp--default-function-abbrevs))
427 ;;; The global minor-mode
428 (defvar speed-of-thought-turn-on-hook '()
429 "Hook run once when `speed-of-thought-mode' is enabled.
430 Note that `speed-of-thought-mode' is global, so this is not run
433 See `sotlisp-turn-on-everywhere' for an example of what a
434 function in this hook should do.")
436 (defvar speed-of-thought-turn-off-hook '()
437 "Hook run once when `speed-of-thought-mode' is disabled.
438 Note that `speed-of-thought-mode' is global, so this is not run
441 See `sotlisp-turn-on-everywhere' for an example of what a
442 function in this hook should do.")
445 (define-minor-mode speed-of-thought-mode
448 (run-hooks (if speed-of-thought-mode
449 'speed-of-thought-turn-on-hook
450 'speed-of-thought-turn-off-hook)))
453 (defun speed-of-thought-hook-in (on off)
454 "Add functions ON and OFF to `speed-of-thought-mode' hooks.
455 If `speed-of-thought-mode' is already on, call ON."
456 (add-hook 'speed-of-thought-turn-on-hook on)
457 (add-hook 'speed-of-thought-turn-off-hook off)
458 (when speed-of-thought-mode (funcall on)))
461 ;;; The local minor-mode
462 (define-minor-mode sotlisp-mode
464 `(([M-return] . sotlisp-newline-and-parentheses)
465 ([C-return] . sotlisp-downlist-newline-and-parentheses)
466 (,(kbd "C-M-;") . ,(if (fboundp 'comment-or-uncomment-sexp)
467 #'comment-or-uncomment-sexp
468 #'sotlisp-comment-or-uncomment-sexp))
469 ("\C-cf" . sotlisp-find-or-define-function)
470 ("\C-cv" . sotlisp-find-or-define-variable)))
472 (defun sotlisp-turn-on-everywhere ()
473 "Call-once function to turn on sotlisp everywhere.
474 Calls `sotlisp-mode' on all `emacs-lisp-mode' buffers, and sets
475 up a hook and abbrevs."
476 (add-hook 'emacs-lisp-mode-hook #'sotlisp-mode)
477 (sotlisp-define-all-abbrevs)
479 (with-current-buffer b
480 (when (derived-mode-p 'emacs-lisp-mode)
484 (defun sotlisp-turn-off-everywhere ()
485 "Call-once function to turn off sotlisp everywhere.
486 Removes `sotlisp-mode' from all `emacs-lisp-mode' buffers, and
487 removes hooks and abbrevs."
488 (remove-hook 'emacs-lisp-mode-hook #'sotlisp-mode)
489 (sotlisp-erase-all-abbrevs)
491 (with-current-buffer b
492 (when (derived-mode-p 'emacs-lisp-mode)
496 (speed-of-thought-hook-in #'sotlisp-turn-on-everywhere #'sotlisp-turn-off-everywhere)
500 (defun sotlisp-newline-and-parentheses ()
501 "`newline-and-indent' then insert a pair of parentheses."
504 (ignore-errors (expand-abbrev))
509 (defun sotlisp-downlist-newline-and-parentheses ()
510 "`up-list', `newline-and-indent', then insert a parentheses pair."
512 (ignore-errors (expand-abbrev))
518 (defun sotlisp--find-in-buffer (r s)
519 "Find the string (concat R (regexp-quote S)) somewhere in this buffer."
520 (let ((l (save-excursion
521 (goto-char (point-min))
523 (when (search-forward-regexp (concat r (regexp-quote s) "\\_>")
525 (match-beginning 0))))))
531 (defun sotlisp--beginning-of-defun ()
532 "`push-mark' and move above this defun."
536 (unless (looking-at "^;;;###autoload\\s-*\n")
539 (defun sotlisp--function-at-point ()
540 "Return name of `function-called-at-point'."
542 (ignore-errors (forward-sexp -1)
543 (looking-at-p "#'")))
544 (thing-at-point 'symbol)
545 (let ((fcap (function-called-at-point)))
548 (thing-at-point 'symbol)))))
550 (defun sotlisp-find-or-define-function (&optional prefix)
551 "If symbol under point is a defined function, go to it, otherwise define it.
552 Essentially `find-function' on steroids.
554 If you write in your code the name of a function you haven't
555 defined yet, just place point on its name and hit \\[sotlisp-find-or-define-function]
556 and a defun will be inserted with point inside it. After that,
557 you can just hit `pop-mark' to go back to where you were.
558 With a PREFIX argument, creates a `defmacro' instead.
560 If the function under point is already defined this just calls
561 `find-function', with one exception:
562 if there's a defun (or equivalent) for this function in the
563 current buffer, we go to that even if it's not where the
564 global definition comes from (this is useful if you're
565 writing an Emacs package that also happens to be installed
568 With a prefix argument, defines a `defmacro' instead of a `defun'."
570 (let ((name (sotlisp--function-at-point)))
571 (unless (and name (sotlisp--find-in-buffer "(def\\(un\\|macro\\|alias\\) " name))
572 (let ((name-s (intern-soft name)))
574 (find-function name-s)
575 (sotlisp--beginning-of-defun)
576 (insert "(def" (if prefix "macro" "un")
578 (save-excursion (insert ")\n \"\"\n )\n\n")))))))
580 (defun sotlisp-find-or-define-variable (&optional prefix)
581 "If symbol under point is a defined variable, go to it, otherwise define it.
582 Essentially `find-variable' on steroids.
584 If you write in your code the name of a variable you haven't
585 defined yet, place point on its name and hit \\[sotlisp-find-or-define-variable]
586 and a `defcustom' will be created with point inside. After that,
587 you can just `pop-mark' to go back to where you were. With a
588 PREFIX argument, creates a `defvar' instead.
590 If the variable under point is already defined this just calls
591 `find-variable', with one exception:
592 if there's a defvar (or equivalent) for this variable in the
593 current buffer, we go to that even if it's not where the
594 global definition comes from (this is useful if you're
595 writing an Emacs package that also happens to be installed
598 With a prefix argument, defines a `defvar' instead of a `defcustom'."
600 (let ((name (symbol-name (variable-at-point t))))
601 (unless (sotlisp--find-in-buffer "(def\\(custom\\|const\\|var\\) " name)
602 (unless (and (symbolp (variable-at-point))
603 (ignore-errors (find-variable (variable-at-point)) t))
604 (let ((name (thing-at-point 'symbol)))
605 (sotlisp--beginning-of-defun)
606 (insert "(def" (if prefix "var" "custom")
610 (if prefix "" "\n :type 'boolean")
615 (defun sotlisp-uncomment-sexp (&optional n)
616 "Uncomment a sexp around point."
618 (let* ((initial-point (point-marker))
619 (inhibit-field-text-motion t)
622 (when (elt (syntax-ppss) 4)
623 (re-search-backward comment-start-skip
624 (line-beginning-position)
626 (setq p (point-marker))
627 (comment-forward (point-max))
631 (while (and (not (bobp))
632 (= end (save-excursion
633 (comment-forward (point-max))
636 (goto-char (line-end-position))
637 (re-search-backward comment-start-skip
638 (line-beginning-position)
641 (while (looking-at comment-start-skip)
643 (unless (looking-at "[\n\r[:blank]]")
647 (uncomment-region beg end)
649 ;; Indentify the "top-level" sexp inside the comment.
651 (while (>= (point) beg)
652 (backward-prefix-chars)
653 (skip-chars-backward "\r\n[:blank:]")
654 (setq p (point-marker))
656 ;; Re-comment everything before it.
658 (comment-region beg p))
659 ;; And everything after it.
661 (forward-sexp (or n 1))
662 (skip-chars-forward "\r\n[:blank:]")
665 (comment-region (point) end))
666 ;; If this is a closing delimiter, pull it up.
668 (skip-chars-forward "\r\n[:blank:]")
669 (when (eq 5 (car (syntax-after (point))))
670 (delete-indentation))))
671 ;; Without a prefix, it's more useful to leave point where
674 (goto-char initial-point))))
676 (defun sotlisp--comment-sexp-raw ()
677 "Comment the sexp at point or ahead of point."
678 (pcase (or (bounds-of-thing-at-point 'sexp)
680 (skip-chars-forward "\r\n[:blank:]")
681 (bounds-of-thing-at-point 'sexp)))
684 (skip-chars-forward "\r\n[:blank:]")
686 (comment-region l r))
687 (skip-chars-forward "\r\n[:blank:]"))))
689 (defun sotlisp-comment-or-uncomment-sexp (&optional n)
690 "Comment the sexp at point and move past it.
691 If already inside (or before) a comment, uncomment instead.
692 With a prefix argument N, (un)comment that many sexps."
694 (if (or (elt (syntax-ppss) 4)
696 (skip-chars-forward "\r\n[:blank:]")
701 (sotlisp-uncomment-sexp n)
702 (dotimes (_ (or n 1))
703 (sotlisp--comment-sexp-raw))))
706 ;;; sotlisp.el ends here