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