code.delx.au - gnu-emacs-elpa/blob - packages/sotlisp/sotlisp.el

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