]> code.delx.au - gnu-emacs-elpa/blob - sotlisp.el
After expanding, eat up space ahead if convenient
[gnu-emacs-elpa] / sotlisp.el
1 ;;; sotlisp.el --- Write lisp at the speed of thought. -*- lexical-binding: t; -*-
2
3 ;; Copyright (C) 2014 Free Software Foundation, Inc.
4
5 ;; Author: Artur Malabarba <bruce.connor.am@gmail.com>
6 ;; URL: https://github.com/Malabarba/speed-of-thought-lisp
7 ;; Keywords: convenience, lisp
8 ;; Package-Requires: ((emacs "24.1"))
9 ;; Version: 1.1
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 <http://www.gnu.org/licenses/>.
23
24 ;;; Commentary:
25 ;;
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.
29 ;;
30 ;; The mode is quite simple, and is composed of two parts:
31 ;;
32 ;;; Abbrevs
33 ;;
34 ;; A large number of abbrevs which expand function
35 ;; initials to their name. A few examples:
36 ;;
37 ;; - wcb -> with-current-buffer
38 ;; - i -> insert
39 ;; - r -> require '
40 ;; - a -> and
41 ;;
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).
48 ;;
49 ;;; Commands
50 ;;
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.
55 ;;
56 ;; - M-RET :: Break line, and insert "()" with point in the middle.
57 ;; - C-RET :: Do `forward-up-list', then do M-RET.
58 ;;
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.
62 ;;
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.
66 ;;
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.
71 ;;
72 ;;; Small Example
73 ;;
74 ;; With the above (assuming you use something like paredit or
75 ;; electric-pair-mode), if you write:
76 ;;
77 ;; ( w t b M-RET i SPC text
78 ;;
79 ;; You get
80 ;;
81 ;; (with-temp-buffer (insert text))
82
83 \f
84 ;;; Code:
85
86 ;;; Predicates
87 (defun sotlisp--auto-paired-p ()
88 "Non-nil if this buffer auto-inserts parentheses."
89 (or (bound-and-true-p electric-pair-mode)
90 (bound-and-true-p paredit-mode)
91 (bound-and-true-p smartparens-mode)))
92
93 (defun sotlisp--function-form-p ()
94 "Non-nil if point is at the start of a sexp.
95 Specially, avoids matching inside argument lists."
96 (and (eq (char-before) ?\()
97 (not (looking-back "(\\(defun\\s-+.*\\|lambda\\s-+\\)("))
98 (not (string-match (rx (syntax symbol)) (string last-command-event)))))
99
100 (defun sotlisp--function-quote-p ()
101 "Non-nil if point is at a sharp-quote."
102 (looking-back "#'"))
103
104 (defun sotlisp--function-p ()
105 "Non-nil if point is at reasonable place for a function name.
106 Returns non-nil if, after moving backwards by a sexp, either
107 `sotlisp--function-form-p' or `sotlisp--function-quote-p' return
108 non-nil."
109 (save-excursion
110 (ignore-errors
111 (skip-chars-backward (rx alnum))
112 (or (sotlisp--function-form-p)
113 (sotlisp--function-quote-p)))))
114
115 (defun sotlisp--whitespace-p ()
116 "Non-nil if current `self-insert'ed char is whitespace."
117 (ignore-errors
118 (string-match (rx space) (string last-command-event))))
119
120 \f
121 ;;; Expansion logic
122 (defvar sotlisp--needs-moving nil
123 "Will `sotlisp--move-to-$' move point after insertion?")
124
125 (defun sotlisp--move-to-$ ()
126 "Move backwards until `$' and delete it.
127 Point is left where the `$' char was. Does nothing if variable
128 `sotlisp-mode' is nil."
129 (when (bound-and-true-p speed-of-thought-mode)
130 (when sotlisp--needs-moving
131 (setq sotlisp--needs-moving nil)
132 (skip-chars-backward "^\\$")
133 (delete-char -1))))
134
135 (add-hook 'post-command-hook #'sotlisp--move-to-$ 'append)
136
137 (defun sotlisp--maybe-skip-closing-paren ()
138 "Move past `)' if variable `electric-pair-mode' is enabled."
139 (when (and (char-after ?\))
140 (sotlisp--auto-paired-p))
141 (forward-char 1)))
142
143 (defun sotlisp--post-expansion-cleanup ()
144 "Do some processing conditioned on the expansion done.
145 If the command that triggered the expansion was a whitespace
146 char, perform the steps below and return t.
147
148 If the expansion ended in a $, delete it and call
149 `sotlisp--maybe-skip-closing-paren'.
150 If it ended in a space and there's a space ahead, delete the
151 space ahead."
152 ;; Inform `expand-abbrev' that `self-insert-command' should not
153 ;; trigger, by returning non-nil on SPC.
154 (when (sotlisp--whitespace-p)
155 ;; And maybe move out of closing paren if expansion ends with $.
156 (if (eq (char-before) ?$)
157 (progn (delete-char -1)
158 (setq sotlisp--needs-moving nil)
159 (sotlisp--maybe-skip-closing-paren))
160 (when (and (string-match (rx space) (string (char-after)))
161 (string-match (rx space) (string (char-before))))
162 (delete-char 1)))
163 t))
164
165 (defvar sotlisp--function-table (make-hash-table :test #'equal)
166 "Table where function abbrev expansions are stored.")
167
168 (defun sotlisp--expand-function ()
169 "Expand the function abbrev before point.
170 See `sotlisp-define-function-abbrev'."
171 (let ((r (point)))
172 (skip-chars-backward (rx alnum))
173 (let* ((name (buffer-substring (point) r))
174 (expansion (gethash name sotlisp--function-table)))
175 (delete-region (point) r)
176 (if (sotlisp--function-quote-p)
177 ;; After #' use the simple expansion.
178 (insert (sotlisp--simplify-function-expansion expansion))
179 ;; Inside a form, use the full expansion.
180 (insert expansion)
181 (when (string-match "\\$" expansion)
182 (setq sotlisp--needs-moving t))))
183 ;; Must be last.
184 (sotlisp--post-expansion-cleanup)))
185
186 (put 'sotlisp--expand-function 'no-self-insert t)
187
188 (defun sotlisp--simplify-function-expansion (expansion)
189 "Take a substring of EXPANSION up to first space.
190 The space char is not included. Any \"$\" are also removed."
191 (replace-regexp-in-string
192 "\\$" ""
193 (substring expansion 0 (string-match " " expansion))))
194
195 \f
196 ;;; Abbrev definitions
197 (defconst sotlisp--default-function-abbrevs
198 '(
199 ("a" . "and ")
200 ("ah" . "add-hook '")
201 ("atl" . "add-to-list '")
202 ("bb" . "bury-buffer")
203 ("bc" . "forward-char -1")
204 ("bfn" . "buffer-file-name")
205 ("bl" . "buffer-list$")
206 ("blp" . "buffer-live-p ")
207 ("bn" . "buffer-name")
208 ("bod" . "beginning-of-defun")
209 ("bol" . "forward-line 0$")
210 ("bp" . "boundp '")
211 ("bs" . "buffer-string$")
212 ("bsn" . "buffer-substring-no-properties")
213 ("bss" . "buffer-substring ")
214 ("bw" . "forward-word -1")
215 ("c" . "concat ")
216 ("ca" . "char-after$")
217 ("cb" . "current-buffer$")
218 ("cc" . "condition-case er\n$\n(error nil)")
219 ("ci" . "call-interactively ")
220 ("cip" . "called-interactively-p 'any")
221 ("csv" . "customize-save-variable '")
222 ("d" . "delete-char 1")
223 ("dc" . "delete-char 1")
224 ("dcu" . "defcustom $ t\n \"\"\n :type 'boolean")
225 ("df" . "defun $ ()\n \"\"\n ")
226 ("dfa" . "defface $ \n '((t))\n \"\"\n ")
227 ("dfc" . "defcustom $ t\n \"\"\n :type 'boolean")
228 ("dff" . "defface $ \n '((t))\n \"\"\n ")
229 ("dfv" . "defvar $ t\n \"\"")
230 ("dk" . "define-key ")
231 ("dl" . "dolist (it $)")
232 ("dmp" . "derived-mode-p '")
233 ("dr" . "delete-region ")
234 ("dv" . "defvar $ t\n \"\"")
235 ("e" . "error \"$\"")
236 ("efn" . "expand-file-name ")
237 ("eol" . "end-of-line")
238 ("f" . "format \"$\"")
239 ("fb" . "fboundp '")
240 ("fbp" . "fboundp '")
241 ("fc" . "forward-char 1")
242 ("ff" . "find-file ")
243 ("fl" . "forward-line 1")
244 ("fp" . "functionp ")
245 ("frp" . "file-readable-p ")
246 ("fs" . "forward-sexp 1")
247 ("fw" . "forward-word 1")
248 ("g" . "goto-char ")
249 ("gc" . "goto-char ")
250 ("gsk" . "global-set-key ")
251 ("i" . "insert ")
252 ("ie" . "ignore-errors ")
253 ("ii" . "interactive")
254 ("ir" . "indent-region ")
255 ("jcl" . "justify-current-line ")
256 ("jl" . "delete-indentation")
257 ("jos" . "just-one-space")
258 ("jr" . "json-read$")
259 ("jtr" . "jump-to-register ")
260 ("k" . "kbd \"$\"")
261 ("kb" . "kill-buffer")
262 ("kn" . "kill-new ")
263 ("kp" . "keywordp ")
264 ("l" . "lambda ($)")
265 ("la" . "looking-at \"$\"")
266 ("lap" . "looking-at-p \"$\"")
267 ("lb" . "looking-back \"$\"")
268 ("lbp" . "line-beginning-position")
269 ("lep" . "line-end-position")
270 ("let" . "let (($))")
271 ("lp" . "listp ")
272 ("m" . "message \"$%s\"")
273 ("mb" . "match-beginning 0")
274 ("me" . "match-end 0")
275 ("ms" . "match-string 0")
276 ("msn" . "match-string-no-properties 0")
277 ("msnp" . "match-string-no-properties 0")
278 ("msp" . "match-string-no-properties 0")
279 ("n" . "not ")
280 ("nai" . "newline-and-indent$")
281 ("nl" . "forward-line 1")
282 ("np" . "numberp ")
283 ("ntr" . "narrow-to-region ")
284 ("ow" . "other-window 1")
285 ("p" . "point$")
286 ("pm" . "point-marker$")
287 ("pa" . "point-max$")
288 ("pg" . "plist-get ")
289 ("pi" . "point-min$")
290 ("r" . "require '")
291 ("ra" . "use-region-p$")
292 ("rap" . "use-region-p$")
293 ("rb" . "region-beginning")
294 ("re" . "region-end")
295 ("rh" . "remove-hook '")
296 ("rm" . "replace-match \"$\"")
297 ("ro" . "regexp-opt ")
298 ("rq" . "regexp-quote ")
299 ("rris" . "replace-regexp-in-string ")
300 ("rrs" . "replace-regexp-in-string ")
301 ("rs" . "while (search-forward $ nil t)\n(replace-match \"\") nil t)")
302 ("rsb" . "re-search-backward $ nil 'noerror")
303 ("rsf" . "re-search-forward $ nil 'noerror")
304 ("s" . "setq ")
305 ("sb" . "search-backward $ nil 'noerror")
306 ("sbr" . "search-backward-regexp $ nil 'noerror")
307 ("scb" . "skip-chars-backward \"$\\r\\n[:blank:]\"")
308 ("scf" . "skip-chars-forward \"$\\r\\n[:blank:]\"")
309 ("se" . "save-excursion")
310 ("sf" . "search-forward $ nil 'noerror")
311 ("sfr" . "search-forward-regexp $ nil 'noerror")
312 ("sic" . "self-insert-command")
313 ("sl" . "string<")
314 ("sm" . "string-match \"$\"")
315 ("smd" . "save-match-data")
316 ("sn" . "symbol-name ")
317 ("sp" . "stringp ")
318 ("sq" . "string= ")
319 ("sr" . "save-restriction")
320 ("ss" . "substring ")
321 ("ssn" . "substring-no-properties ")
322 ("ssnp" . "substring-no-properties ")
323 ("stb" . "switch-to-buffer ")
324 ("sw" . "selected-window$")
325 ("syp" . "symbolp ")
326 ("tap" . "thing-at-point 'symbol")
327 ("u" . "unless ")
328 ("ul" . "up-list")
329 ("up" . "unwind-protect\n(progn $)")
330 ("urp" . "use-region-p$")
331 ("w" . "when ")
332 ("wcb" . "with-current-buffer ")
333 ("wf" . "write-file ")
334 ("wh" . "while ")
335 ("wl" . "window-list nil 'nominibuffer")
336 ("we" . "window-end")
337 ("ws" . "window-start")
338 ("wtb" . "with-temp-buffer")
339 ("wtf" . "with-temp-file ")
340 )
341 "Alist of (ABBREV . EXPANSION) used by `sotlisp'.")
342
343 (defun sotlisp-define-function-abbrev (name expansion)
344 "Define a function abbrev expanding NAME to EXPANSION.
345 This abbrev will only be expanded in places where a function name is
346 sensible. Roughly, this is right after a `(' or a `#''.
347
348 If EXPANSION is any string, it doesn't have to be the just the
349 name of a function. In particular:
350 - if it contains a `$', this char will not be inserted and
351 point will be moved to its position after expansion.
352 - if it contains a space, only a substring of it up to the
353 first space is inserted when expanding after a `#'' (this is done
354 by defining two different abbrevs).
355
356 For instance, if one defines
357 (sotlisp-define-function-abbrev \"d\" \"delete-char 1\")
358
359 then triggering `expand-abbrev' after \"d\" expands in the
360 following way:
361 (d => (delete-char 1
362 #'d => #'delete-char"
363 (define-abbrev emacs-lisp-mode-abbrev-table
364 name t #'sotlisp--expand-function
365 ;; Don't override user abbrevs
366 :system t
367 ;; Only expand in function places.
368 :enable-function #'sotlisp--function-p)
369 (puthash name expansion sotlisp--function-table))
370
371 (defun sotlisp-erase-all-abbrevs ()
372 "Undefine all abbrevs defined by `sotlisp'."
373 (interactive)
374 (maphash (lambda (x _) (define-abbrev emacs-lisp-mode-abbrev-table x nil))
375 sotlisp--function-table))
376
377 (defun sotlisp-define-all-abbrevs ()
378 "Define all abbrevs in `sotlisp--default-function-abbrevs'."
379 (interactive)
380 (mapc (lambda (x) (sotlisp-define-function-abbrev (car x) (cdr x)))
381 sotlisp--default-function-abbrevs))
382
383 \f
384 ;;; The global minor-mode
385 (defvar speed-of-thought-turn-on-hook '()
386 "Hook run once when `speed-of-thought-mode' is enabled.
387 Note that `speed-of-thought-mode' is global, so this is not run
388 on every buffer.
389
390 See `sotlisp-turn-on-everywhere' for an example of what a
391 function in this hook should do.")
392
393 (defvar speed-of-thought-turn-off-hook '()
394 "Hook run once when `speed-of-thought-mode' is disabled.
395 Note that `speed-of-thought-mode' is global, so this is not run
396 on every buffer.
397
398 See `sotlisp-turn-on-everywhere' for an example of what a
399 function in this hook should do.")
400
401 ;;;###autoload
402 (define-minor-mode speed-of-thought-mode
403 nil nil nil nil
404 :global t
405 (run-hooks (if speed-of-thought-mode
406 'speed-of-thought-turn-on-hook
407 'speed-of-thought-turn-off-hook)))
408
409 ;;;###autoload
410 (defun speed-of-thought-hook-in (on off)
411 "Add functions ON and OFF to `speed-of-thought-mode' hooks.
412 If `speed-of-thought-mode' is already on, call ON."
413 (add-hook 'speed-of-thought-turn-on-hook on)
414 (add-hook 'speed-of-thought-turn-off-hook off)
415 (when speed-of-thought-mode (funcall on)))
416
417 \f
418 ;;; The local minor-mode
419 (define-minor-mode sotlisp-mode
420 nil nil " SoT"
421 '(([M-return] . sotlisp-newline-and-parentheses)
422 ([C-return] . sotlisp-downlist-newline-and-parentheses)
423 ("\C-cf" . sotlisp-find-or-define-function)
424 ("\C-cv" . sotlisp-find-or-define-variable)))
425
426 (defun sotlisp-turn-on-everywhere ()
427 "Call-once function to turn on sotlisp everywhere.
428 Calls `sotlisp-mode' on all `emacs-lisp-mode' buffers, and sets
429 up a hook and abbrevs."
430 (add-hook 'emacs-lisp-mode-hook #'sotlisp-mode)
431 (sotlisp-define-all-abbrevs)
432 (mapc (lambda (b)
433 (with-current-buffer b
434 (when (derived-mode-p 'emacs-lisp-mode)
435 (sotlisp-mode 1))))
436 (buffer-list)))
437
438 (defun sotlisp-turn-off-everywhere ()
439 "Call-once function to turn off sotlisp everywhere.
440 Removes `sotlisp-mode' from all `emacs-lisp-mode' buffers, and
441 removes hooks and abbrevs."
442 (remove-hook 'emacs-lisp-mode-hook #'sotlisp-mode)
443 (sotlisp-erase-all-abbrevs)
444 (mapc (lambda (b)
445 (with-current-buffer b
446 (when (derived-mode-p 'emacs-lisp-mode)
447 (sotlisp-mode -1))))
448 (buffer-list)))
449
450 (speed-of-thought-hook-in #'sotlisp-turn-on-everywhere #'sotlisp-turn-off-everywhere)
451
452 \f
453 ;;; Commands
454 (defun sotlisp-newline-and-parentheses ()
455 "`newline-and-indent' then insert a pair of parentheses."
456 (interactive)
457 (point)
458 (ignore-errors (expand-abbrev))
459 (newline-and-indent)
460 (insert "()")
461 (forward-char -1))
462
463 (defun sotlisp-downlist-newline-and-parentheses ()
464 "`up-list', `newline-and-indent', then insert a parentheses pair."
465 (interactive)
466 (ignore-errors (expand-abbrev))
467 (up-list)
468 (newline-and-indent)
469 (insert "()")
470 (forward-char -1))
471
472 (defun sotlisp--find-in-buffer (r s)
473 "Find the string (concat R (regexp-quote S)) somewhere in this buffer."
474 (let ((l (save-excursion
475 (goto-char (point-min))
476 (save-match-data
477 (when (search-forward-regexp (concat r (regexp-quote s) "\\_>")
478 nil :noerror)
479 (match-beginning 0))))))
480 (when l
481 (push-mark)
482 (goto-char l)
483 l)))
484
485 (defun sotlisp--beginning-of-defun ()
486 "`push-mark' and move above this defun."
487 (push-mark)
488 (beginning-of-defun)
489 (when (looking-back "^;;;###autoload\\s-*\n")
490 (forward-line -1)))
491
492 (defun sotlisp--function-at-point ()
493 "Return name of `function-called-at-point'."
494 (if (save-excursion
495 (ignore-errors (forward-sexp -1)
496 (looking-at-p "#'")))
497 (thing-at-point 'symbol)
498 (let ((fcap (function-called-at-point)))
499 (if fcap
500 (symbol-name fcap)
501 (thing-at-point 'symbol)))))
502
503 (defun sotlisp-find-or-define-function (&optional prefix)
504 "If symbol under point is a defined function, go to it, otherwise define it.
505 Essentially `find-function' on steroids.
506
507 If you write in your code the name of a function you haven't
508 defined yet, just place point on its name and hit \\[sotlisp-find-or-define-function]
509 and a defun will be inserted with point inside it. After that,
510 you can just hit `pop-mark' to go back to where you were.
511 With a PREFIX argument, creates a `defmacro' instead.
512
513 If the function under point is already defined this just calls
514 `find-function', with one exception:
515 if there's a defun (or equivalent) for this function in the
516 current buffer, we go to that even if it's not where the
517 global definition comes from (this is useful if you're
518 writing an Emacs package that also happens to be installed
519 through package.el).
520
521 With a prefix argument, defines a `defmacro' instead of a `defun'."
522 (interactive "P")
523 (let ((name (sotlisp--function-at-point)))
524 (unless (and name (sotlisp--find-in-buffer "(def\\(un\\|macro\\|alias\\) " name))
525 (let ((name-s (intern-soft name)))
526 (if (fboundp name-s)
527 (find-function name-s)
528 (sotlisp--beginning-of-defun)
529 (insert "(def" (if prefix "macro" "un")
530 " " name " (")
531 (save-excursion (insert ")\n \"\"\n )\n\n")))))))
532
533 (defun sotlisp-find-or-define-variable (&optional prefix)
534 "If symbol under point is a defined variable, go to it, otherwise define it.
535 Essentially `find-variable' on steroids.
536
537 If you write in your code the name of a variable you haven't
538 defined yet, place point on its name and hit \\[sotlisp-find-or-define-variable]
539 and a `defcustom' will be created with point inside. After that,
540 you can just `pop-mark' to go back to where you were. With a
541 PREFIX argument, creates a `defvar' instead.
542
543 If the variable under point is already defined this just calls
544 `find-variable', with one exception:
545 if there's a defvar (or equivalent) for this variable in the
546 current buffer, we go to that even if it's not where the
547 global definition comes from (this is useful if you're
548 writing an Emacs package that also happens to be installed
549 through package.el).
550
551 With a prefix argument, defines a `defvar' instead of a `defcustom'."
552 (interactive "P")
553 (let ((name (symbol-name (variable-at-point t))))
554 (unless (sotlisp--find-in-buffer "(def\\(custom\\|const\\|var\\) " name)
555 (unless (and (symbolp (variable-at-point))
556 (ignore-errors (find-variable (variable-at-point)) t))
557 (let ((name (thing-at-point 'symbol)))
558 (sotlisp--beginning-of-defun)
559 (insert "(def" (if prefix "var" "custom")
560 " " name " t")
561 (save-excursion
562 (insert "\n \"\""
563 (if prefix "" "\n :type 'boolean")
564 ")\n\n")))))))
565
566 (provide 'sotlisp)
567 ;;; sotlisp.el ends here
568