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