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