code.delx.au - gnu-emacs-elpa/blob - 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 ;; Keywords: convenience, lisp
   7 ;; Package-Requires: ((emacs "24.1"))
   8
   9 ;; This program is free software; you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation, either version 3 of the License, or
  12 ;; (at your option) any later version.
  13
  14 ;; This program is distributed in the hope that it will be useful,
  15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;; GNU General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  21
  22 ;;; Commentary:
  23 ;;
  24 ;; This defines a new global minor-mode `speed-of-thought-mode', which
  25 ;; activates locally on any supported buffer.  Currently, only
  26 ;; `emacs-lisp-mode' buffers are supported.
  27 ;;
  28 ;; The mode is quite simple, and is composed of two parts:
  29 ;;
  30 ;;; Abbrevs
  31 ;;
  32 ;; A large number of abbrevs which expand function
  33 ;; initials to their name.  A few examples:
  34 ;;
  35 ;; - wcb -> with-current-buffer
  36 ;; - i -> insert
  37 ;; - r -> require '
  38 ;; - a -> and
  39 ;;
  40 ;; However, these are defined in a way such that they ONLY expand in a
  41 ;; place where you would use a function, so hitting SPC after "(r"
  42 ;; expands to "(require '", but hitting SPC after "(delete-region r" will
  43 ;; NOT expand the `r', because that's obviously not a function.
  44 ;; Furtheromre, "#'r" will expand to "#'require" (note how it ommits that
  45 ;; extra quote, since it would be useless here).
  46 ;;
  47 ;;; Commands
  48 ;;
  49 ;; It also defines 4 commands, which really fit into this "follow the
  50 ;; thought-flow" way of writing.  The bindings are as follows, I
  51 ;; understand these don't fully adhere to conventions, and I'd
  52 ;; appreaciate suggestions on better bindings.
  53 ;;
  54 ;; - M-RET :: Break line, and insert "()" with point in the middle.
  55 ;; - C-RET :: Do `forward-up-list', then do M-RET.
  56 ;;
  57 ;; Hitting RET followed by a `(' was one of the most common key sequences
  58 ;; for me while writing elisp, so giving it a quick-to-hit key was a
  59 ;; significant improvement.
  60 ;;
  61 ;; - C-c f :: Find function under point.  If it is not defined, create a
  62 ;; definition for it below the current function and leave point inside.
  63 ;; - C-c v :: Same, but for variable.
  64 ;;
  65 ;; With these commands, you just write your code as you think of it.  Once
  66 ;; you hit a "stop-point" of sorts in your tought flow, you hit `C-c f/v`
  67 ;; on any undefined functions/variables, write their definitions, and hit
  68 ;; `C-u C-SPC` to go back to the main function.
  69 ;;
  70 ;;; Small Example
  71 ;;
  72 ;; With the above (assuming you use something like paredit or
  73 ;; electric-pair-mode), if you write:
  74 ;;
  75 ;;   ( w t b M-RET i SPC text
  76 ;;
  77 ;; You get
  78 ;;
  79 ;;   (with-temp-buffer (insert text))
  80
  81 \f
  82 ;;; Code:
  83 (eval-when-compile
  84   (require 'subr-x))
  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 (defvar sotlisp--function-table (make-hash-table :test #'equal)
 144   "Table where function abbrev expansions are stored.")
 145
 146 (defun sotlisp--expand-function ()
 147   "Expand the function abbrev before point.
 148 See `sotlisp-define-function-abbrev'."
 149   (let ((r (point)))
 150     (skip-chars-backward (rx alnum))
 151     (let* ((name (buffer-substring (point) r))
 152            (expansion (gethash name sotlisp--function-table)))
 153       (delete-region (point) r)
 154       (if (sotlisp--function-quote-p)
 155           ;; After #' use the simple expansion.
 156           (insert (sotlisp--simplify-function-expansion expansion))
 157         ;; Inside a form, use the full expansion.
 158         (insert expansion)
 159         (when (string-match "\\$" expansion)
 160           (setq sotlisp--needs-moving t))))
 161     ;; Inform `expand-abbrev' that `self-insert-command' should not
 162     ;; trigger, by returning non-nil on SPC.
 163     (when (sotlisp--whitespace-p)
 164       ;; And maybe move out of closing paren if expansion ends with $.
 165       (when (eq (char-before) ?$)
 166         (delete-char -1)
 167         (setq sotlisp--needs-moving nil)
 168         (sotlisp--maybe-skip-closing-paren))
 169       t)))
 170
 171 (put 'sotlisp--expand-function 'no-self-insert t)
 172
 173 (defun sotlisp--simplify-function-expansion (expansion)
 174   "Take a substring of EXPANSION up to first space.
 175 The space char is not included.  Any \"$\" are also removed."
 176   (replace-regexp-in-string
 177    "\\$" ""
 178    (substring expansion 0 (string-match " " expansion))))
 179
 180 \f
 181 ;;; Abbrev definitions
 182 (defconst sotlisp--default-function-abbrevs
 183   '(
 184     ("a" . "and ")
 185     ("ah" . "add-hook '")
 186     ("atl" . "add-to-list '")
 187     ("bb" . "bury-buffer")
 188     ("bc" . "forward-char -1")
 189     ("bfn" . "buffer-file-name")
 190     ("bn" . "buffer-name")
 191     ("bl" . "buffer-list$")
 192     ("bod" . "beginning-of-defun")
 193     ("bp" . "boundp '")
 194     ("bs" . "buffer-string$")
 195     ("bss" . "buffer-substring ")
 196     ("bw" . "forward-word -1")
 197     ("c" . "concat ")
 198     ("ca" . "char-after$")
 199     ("cc" . "condition-case er\n$\n(error nil)")
 200     ("ci" . "call-interactively ")
 201     ("cip" . "called-interactively-p 'any")
 202     ("csv" . "customize-save-variable '")
 203     ("d" . "delete-char 1")
 204     ("df" . "delete-file ")
 205     ("dl" . "dolist (it $)")
 206     ("dk" . "define-key ")
 207     ("dmp" . "derived-mode-p '")
 208     ("dr" . "delete-region ")
 209     ("e" . "error \"$\"")
 210     ("efn" . "expand-file-name ")
 211     ("f" . "format \"$\"")
 212     ("fb" . "fboundp '")
 213     ("fbp" . "fboundp '")
 214     ("fc" . "forward-char 1")
 215     ("ff" . "find-file ")
 216     ("fl" . "forward-line 1")
 217     ("fp" . "functionp ")
 218     ("frp" . "file-readable-p ")
 219     ("fs" . "forward-sexp 1")
 220     ("fw" . "forward-word 1")
 221     ("g" . "goto-char ")
 222     ("gc" . "goto-char ")
 223     ("gsk" . "global-set-key ")
 224     ("i" . "insert ")
 225     ("ie" . "ignore-errors ")
 226     ("k" . "kbd \"$\"")
 227     ("kb" . "kill-buffer")
 228     ("l" . "lambda ($)")
 229     ("la" . "looking-at \"$\"")
 230     ("lap" . "looking-at-p \"$\"")
 231     ("lb" . "looking-back \"$\"")
 232     ("let" . "let (($))")
 233     ("lp" . "listp ")
 234     ("m" . "message \"$%s\"")
 235     ("mb" . "match-beginning 0")
 236     ("me" . "match-end 0")
 237     ("ms" . "match-string 0")
 238     ("msnp" . "match-string-no-properties 0")
 239     ("n" . "not ")
 240     ("nl" . "forward-line 1")
 241     ("np" . "numberp ")
 242     ("ow" . "other-window 1")
 243     ("p" . "point$")
 244     ("pa" . "point-max$")
 245     ("pi" . "point-min$")
 246     ("r" . "require '")
 247     ("rh" . "remove-hook '")
 248     ("rm" . "replace-match \"$\"")
 249     ("rq" . "regexp-quote \"$\"")
 250     ("rris" . "replace-regexp-in-string ")
 251     ("rrs" . "replace-regexp-in-string ")
 252     ("rs" . "while (search-forward $ nil t)\n(replace-match \"\") nil t)")
 253     ("s" . "setq ")
 254     ("s=" . "string= ")
 255     ("sb" . "search-backward \"$\"")
 256     ("sbr" . "search-backward-regexp \"$\"")
 257     ("scb" . "skip-chars-backward \"$\r\n[:blank:]\"")
 258     ("scf" . "skip-chars-forward \"$\r\n[:blank:]\"")
 259     ("se" . "save-excursion")
 260     ("sf" . "search-forward \"$\"")
 261     ("sfr" . "search-forward-regexp \"$\"")
 262     ("sm" . "string-match \"$\"")
 263     ("smd" . "save-match-data")
 264     ("sn" . "symbol-name ")
 265     ("sp" . "stringp ")
 266     ("sr" . "save-restriction")
 267     ("ss" . "substring ")
 268     ("stb" . "switch-to-buffer ")
 269     ("sw" . "select-window ")
 270     ("tap" . "thing-at-point 'symbol")
 271     ("u" . "unless ")
 272     ("up" . "unwind-protect ")
 273     ("w" . "when ")
 274     ("wcb" . "with-current-buffer ")
 275     ("wf" . "write-file ")
 276     ("wh" . "while ")
 277     ("wl" . "window-list nil 'nominibuffer")
 278     ("wtb" . "with-temp-buffer")
 279     ("wtf" . "with-temp-file")
 280     )
 281   "Alist of (ABBREV . EXPANSION) used by `sotlisp'.")
 282
 283 (defun sotlisp-define-function-abbrev (name expansion)
 284   "Define a function abbrev expanding NAME to EXPANSION.
 285 This abbrev will only be expanded in places where a function name is
 286 sensible.  Roughly, this is right after a `(' or a `#''.
 287
 288 If EXPANSION is any string, it doesn't have to be the just the
 289 name of a function.  In particular:
 290   - if it contains a `$', this char will not be inserted and
 291     point will be moved to its position after expansion.
 292   - if it contains a space, only a substring of it up to the
 293 first space is inserted when expanding after a `#'' (this is done
 294 by defining two different abbrevs).
 295
 296 For instance, if one defines
 297    (sotlisp-define-function-abbrev \"d\" \"delete-char 1\")
 298
 299 then triggering `expand-abbrev' after \"d\" expands in the
 300 following way:
 301    (d    => (delete-char 1
 302    #'d   => #'delete-char"
 303   (define-abbrev emacs-lisp-mode-abbrev-table
 304     name t #'sotlisp--expand-function
 305     ;; Don't override user abbrevs
 306     :system t
 307     ;; Only expand in function places.
 308     :enable-function #'sotlisp--function-p)
 309   (puthash name expansion sotlisp--function-table))
 310
 311 (defun sotlisp-erase-all-abbrevs ()
 312   "Undefine all abbrevs defined by `sotlisp'."
 313   (interactive)
 314   (maphash (lambda (x _) (define-abbrev emacs-lisp-mode-abbrev-table x nil))
 315            sotlisp--function-table))
 316
 317 (defun sotlisp-define-all-abbrevs ()
 318   "Define all abbrevs in `sotlisp--default-function-abbrevs'."
 319   (interactive)
 320   (mapc (lambda (x) (sotlisp-define-function-abbrev (car x) (cdr x)))
 321     sotlisp--default-function-abbrevs))
 322
 323 \f
 324 ;;; The global minor-mode
 325 (defvar speed-of-thought-turn-on-hook '(sotlisp-turn-on-everywhere)
 326   "Hook run once when `speed-of-thought-mode' is enabled.
 327 Note that `speed-of-thought-mode' is global, so this is not run
 328 on every buffer.
 329
 330 See `sotlisp-turn-on-everywhere' for an example of what a
 331 function in this hook should do.")
 332
 333 (defvar speed-of-thought-turn-off-hook '(sotlisp-turn-off-everywhere)
 334   "Hook run once when `speed-of-thought-mode' is disabled.
 335 Note that `speed-of-thought-mode' is global, so this is not run
 336 on every buffer.
 337
 338 See `sotlisp-turn-on-everywhere' for an example of what a
 339 function in this hook should do.")
 340
 341 ;;;###autoload
 342 (define-minor-mode speed-of-thought-mode nil nil nil nil
 343   :global t
 344   (run-hooks (if speed-of-thought-mode
 345                  'speed-of-thought-turn-on-hook
 346                'speed-of-thought-turn-off-hook)))
 347
 348 \f
 349 ;;; The local minor-mode
 350 (defun sotlisp-turn-on-everywhere ()
 351   "Call-once function to turn on sotlisp everywhere.
 352 Calls `sotlisp-mode' on all `emacs-lisp-mode' buffers, and sets
 353 up a hook and abbrevs."
 354   (add-hook 'emacs-lisp-mode-hook #'sotlisp-mode)
 355   (sotlisp-define-all-abbrevs)
 356   (mapc (lambda (b)
 357           (with-current-buffer b
 358             (when (derived-mode-p 'emacs-lisp-mode)
 359               (sotlisp-mode 1))))
 360     (buffer-list)))
 361
 362 (defun sotlisp-turn-off-everywhere ()
 363   "Call-once function to turn off sotlisp everywhere.
 364 Removes `sotlisp-mode' from all `emacs-lisp-mode' buffers, and
 365 removes hooks and abbrevs."
 366   (remove-hook 'emacs-lisp-mode-hook #'sotlisp-mode)
 367   (sotlisp-erase-all-abbrevs)
 368   (mapc (lambda (b)
 369           (with-current-buffer b
 370             (when (derived-mode-p 'emacs-lisp-mode)
 371               (sotlisp-mode -1))))
 372     (buffer-list)))
 373
 374 (define-minor-mode sotlisp-mode nil nil " SoT"
 375   '(([M-return] . sotlisp-newline-and-parentheses)
 376     ([C-return] . sotlisp-downlist-newline-and-parentheses)
 377     ("\C-cf"    . sotlisp-find-or-define-function)
 378     ("\C-cv"    . sotlisp-find-or-define-variable)))
 379
 380 \f
 381 ;;; Commands
 382 (defun sotlisp-newline-and-parentheses ()
 383   "`newline-and-indent' then insert a pair of parentheses."
 384   (interactive)
 385   (point)
 386   (ignore-errors (expand-abbrev))
 387   (newline-and-indent)
 388   (insert "()")
 389   (forward-char -1))
 390
 391 (defun sotlisp-downlist-newline-and-parentheses ()
 392   "`up-list', `newline-and-indent', then insert a parentheses pair."
 393   (interactive)
 394   (ignore-errors (expand-abbrev))
 395   (up-list)
 396   (newline-and-indent)
 397   (insert "()")
 398   (forward-char -1))
 399
 400 (defun sotlisp--find-in-buffer (r s)
 401   "Find the string (concat R (regexp-quote S)) somewhere in this buffer."
 402   (let ((l (save-excursion
 403              (goto-char (point-min))
 404              (save-match-data
 405                (when (search-forward-regexp (concat r (regexp-quote s) "\\_>")
 406                                             nil :noerror)
 407                  (match-beginning 0))))))
 408     (when l
 409       (push-mark)
 410       (goto-char l)
 411       l)))
 412
 413 (defun sotlisp--beginning-of-defun ()
 414   "`push-mark' and move above this defun."
 415   (push-mark)
 416   (beginning-of-defun)
 417   (when (looking-back "^;;;###autoload\\s-*\n")
 418     (forward-line -1)))
 419
 420 (defun sotlisp--function-at-point ()
 421   "Return name of `function-called-at-point'."
 422   (if (save-excursion
 423         (ignore-errors (forward-sexp -1)
 424                        (looking-at-p "#'")))
 425       (thing-at-point 'symbol)
 426     (if-let ((fcap (function-called-at-point)))
 427         (symbol-name fcap)
 428       (thing-at-point 'symbol))))
 429
 430 (defun sotlisp-find-or-define-function (&optional prefix)
 431   "If symbol under point is a defined function, go to it, otherwise define it.
 432 Essentially `find-function' on steroids.
 433
 434 If you write in your code the name of a function you haven't
 435 defined yet, just place point on its name and hit \\[sotlisp-find-or-define-function]
 436 and a defun will be inserted with point inside it.  After that,
 437 you can just hit `pop-mark' to go back to where you were.
 438 With a PREFIX argument, creates a `defmacro' instead.
 439
 440 If the function under point is already defined this just calls
 441 `find-function', with one exception:
 442     if there's a defun (or equivalent) for this function in the
 443     current buffer, we go to that even if it's not where the
 444     global definition comes from (this is useful if you're
 445     writing an Emacs package that also happens to be installed
 446     through package.el).
 447
 448 With a prefix argument, defines a `defmacro' instead of a `defun'."
 449   (interactive "P")
 450   (let ((name (sotlisp--function-at-point)))
 451     (unless (and name (sotlisp--find-in-buffer "(def\\(un\\|macro\\|alias\\) " name))
 452       (let ((name-s (intern-soft name)))
 453         (if (fboundp name-s)
 454             (find-function name-s)
 455           (sotlisp--beginning-of-defun)
 456           (insert "(def" (if prefix "macro" "un")
 457                   " " name " (")
 458           (save-excursion (insert ")\n  \"\"\n  )\n\n")))))))
 459
 460 (defun sotlisp-find-or-define-variable (&optional prefix)
 461   "If symbol under point is a defined variable, go to it, otherwise define it.
 462 Essentially `find-variable' on steroids.
 463
 464 If you write in your code the name of a variable you haven't
 465 defined yet, place point on its name and hit \\[sotlisp-find-or-define-variable]
 466 and a `defcustom' will be created with point inside.  After that,
 467 you can just `pop-mark' to go back to where you were.  With a
 468 PREFIX argument, creates a `defvar' instead.
 469
 470 If the variable under point is already defined this just calls
 471 `find-variable', with one exception:
 472     if there's a defvar (or equivalent) for this variable in the
 473     current buffer, we go to that even if it's not where the
 474     global definition comes from (this is useful if you're
 475     writing an Emacs package that also happens to be installed
 476     through package.el).
 477
 478 With a prefix argument, defines a `defvar' instead of a `defcustom'."
 479   (interactive "P")
 480   (let ((name (symbol-name (variable-at-point t))))
 481     (unless (sotlisp--find-in-buffer "(def\\(custom\\|const\\|var\\) " name)
 482       (unless (and (symbolp (variable-at-point))
 483                    (ignore-errors (find-variable (variable-at-point)) t))
 484         (let ((name (thing-at-point 'symbol)))
 485           (sotlisp--beginning-of-defun)
 486           (insert "(def" (if prefix "var" "custom")
 487                   " " name " t")
 488           (save-excursion
 489             (insert "\n  \"\""
 490                     (if prefix "" "\n  :type 'boolean")
 491                     ")\n\n")))))))
 492
 493 (provide 'sotlisp)
 494 ;;; sotlisp.el ends here
 495