-;;; sotlisp.el --- Write lisp at the speed of thought. -*- lexical-binding: t; -*-\r
-\r
-;; Copyright (C) 2014 Free Software Foundation, Inc.\r
-\r
-;; Author: Artur Malabarba <bruce.connor.am@gmail.com>\r
-;; URL: https://github.com/Malabarba/speed-of-thought-lisp\r
-;; Keywords: convenience, lisp\r
-;; Package-Requires: ((emacs "24.1"))\r
-;; Version: 1.0\r
-\r
-;; This program is free software; you can redistribute it and/or modify\r
-;; it under the terms of the GNU General Public License as published by\r
-;; the Free Software Foundation, either version 3 of the License, or\r
-;; (at your option) any later version.\r
-\r
-;; This program is distributed in the hope that it will be useful,\r
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of\r
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\r
-;; GNU General Public License for more details.\r
-\r
-;; You should have received a copy of the GNU General Public License\r
-;; along with this program. If not, see <http://www.gnu.org/licenses/>.\r
-\r
-;;; Commentary:\r
-;;\r
-;; This defines a new global minor-mode `speed-of-thought-mode', which\r
-;; activates locally on any supported buffer. Currently, only\r
-;; `emacs-lisp-mode' buffers are supported.\r
-;;\r
-;; The mode is quite simple, and is composed of two parts:\r
-;;\r
-;;; Abbrevs\r
-;;\r
-;; A large number of abbrevs which expand function\r
-;; initials to their name. A few examples:\r
-;; \r
-;; - wcb -> with-current-buffer\r
-;; - i -> insert\r
-;; - r -> require '\r
-;; - a -> and\r
-;; \r
-;; However, these are defined in a way such that they ONLY expand in a\r
-;; place where you would use a function, so hitting SPC after "(r"\r
-;; expands to "(require '", but hitting SPC after "(delete-region r"\r
-;; will NOT expand the `r', because that's obviously not a function.\r
-;; Furtheromre, "#'r" will expand to "#'require" (note how it ommits\r
-;; that extra quote, since it would be useless here).\r
-;;\r
-;;; Commands\r
-;;\r
-;; It also defines 4 commands, which really fit into this "follow the\r
-;; thought-flow" way of writing. The bindings are as follows, I\r
-;; understand these don't fully adhere to conventions, and I'd\r
-;; appreciate suggestions on better bindings.\r
-;; \r
-;; - M-RET :: Break line, and insert "()" with point in the middle.\r
-;; - C-RET :: Do `forward-up-list', then do M-RET.\r
-;; \r
-;; Hitting RET followed by a `(' was one of the most common key sequences\r
-;; for me while writing elisp, so giving it a quick-to-hit key was a\r
-;; significant improvement.\r
-;; \r
-;; - C-c f :: Find function under point. If it is not defined, create a\r
-;; definition for it below the current function and leave point inside.\r
-;; - C-c v :: Same, but for variable.\r
-;; \r
-;; With these commands, you just write your code as you think of it. Once\r
-;; you hit a "stop-point" of sorts in your tought flow, you hit `C-c f/v`\r
-;; on any undefined functions/variables, write their definitions, and hit\r
-;; `C-u C-SPC` to go back to the main function.\r
-;; \r
-;;; Small Example\r
-;;\r
-;; With the above (assuming you use something like paredit or\r
-;; electric-pair-mode), if you write:\r
-;;\r
-;; ( w t b M-RET i SPC text\r
-;; \r
-;; You get\r
-;; \r
-;; (with-temp-buffer (insert text))\r
-\r
-\f\r
-;;; Code:\r
-\r
-;;; Predicates\r
-(defun sotlisp--auto-paired-p ()\r
- "Non-nil if this buffer auto-inserts parentheses."\r
- (or (bound-and-true-p electric-pair-mode)\r
- (bound-and-true-p paredit-mode)\r
- (bound-and-true-p smartparens-mode)))\r
-\r
-(defun sotlisp--function-form-p ()\r
- "Non-nil if point is at the start of a sexp.\r
-Specially, avoids matching inside argument lists."\r
- (and (eq (char-before) ?\()\r
- (not (looking-back "(\\(defun\\s-+.*\\|lambda\\s-+\\)("))\r
- (not (string-match (rx (syntax symbol)) (string last-command-event)))))\r
-\r
-(defun sotlisp--function-quote-p ()\r
- "Non-nil if point is at a sharp-quote."\r
- (looking-back "#'"))\r
-\r
-(defun sotlisp--function-p ()\r
- "Non-nil if point is at reasonable place for a function name.\r
-Returns non-nil if, after moving backwards by a sexp, either\r
-`sotlisp--function-form-p' or `sotlisp--function-quote-p' return\r
-non-nil."\r
- (save-excursion\r
- (ignore-errors\r
- (skip-chars-backward (rx alnum))\r
- (or (sotlisp--function-form-p)\r
- (sotlisp--function-quote-p)))))\r
-\r
-(defun sotlisp--whitespace-p ()\r
- "Non-nil if current `self-insert'ed char is whitespace."\r
- (ignore-errors\r
- (string-match (rx space) (string last-command-event))))\r
-\r
-\f\r
-;;; Expansion logic\r
-(defvar sotlisp--needs-moving nil\r
- "Will `sotlisp--move-to-$' move point after insertion?")\r
-\r
-(defun sotlisp--move-to-$ ()\r
- "Move backwards until `$' and delete it.\r
-Point is left where the `$' char was. Does nothing if variable\r
-`sotlisp-mode' is nil."\r
- (when (bound-and-true-p speed-of-thought-mode)\r
- (when sotlisp--needs-moving\r
- (setq sotlisp--needs-moving nil)\r
- (skip-chars-backward "^\\$")\r
- (delete-char -1))))\r
-\r
-(add-hook 'post-command-hook #'sotlisp--move-to-$ 'append)\r
-\r
-(defun sotlisp--maybe-skip-closing-paren ()\r
- "Move past `)' if variable `electric-pair-mode' is enabled."\r
- (when (and (char-after ?\))\r
- (sotlisp--auto-paired-p))\r
- (forward-char 1)))\r
-\r
-(defvar sotlisp--function-table (make-hash-table :test #'equal)\r
- "Table where function abbrev expansions are stored.")\r
-\r
-(defun sotlisp--expand-function ()\r
- "Expand the function abbrev before point.\r
-See `sotlisp-define-function-abbrev'."\r
- (let ((r (point)))\r
- (skip-chars-backward (rx alnum))\r
- (let* ((name (buffer-substring (point) r))\r
- (expansion (gethash name sotlisp--function-table)))\r
- (delete-region (point) r)\r
- (if (sotlisp--function-quote-p)\r
- ;; After #' use the simple expansion.\r
- (insert (sotlisp--simplify-function-expansion expansion))\r
- ;; Inside a form, use the full expansion.\r
- (insert expansion)\r
- (when (string-match "\\$" expansion)\r
- (setq sotlisp--needs-moving t))))\r
- ;; Inform `expand-abbrev' that `self-insert-command' should not\r
- ;; trigger, by returning non-nil on SPC.\r
- (when (sotlisp--whitespace-p)\r
- ;; And maybe move out of closing paren if expansion ends with $.\r
- (when (eq (char-before) ?$)\r
- (delete-char -1)\r
- (setq sotlisp--needs-moving nil)\r
- (sotlisp--maybe-skip-closing-paren))\r
- t)))\r
-\r
-(put 'sotlisp--expand-function 'no-self-insert t)\r
-\r
-(defun sotlisp--simplify-function-expansion (expansion)\r
- "Take a substring of EXPANSION up to first space.\r
-The space char is not included. Any \"$\" are also removed."\r
- (replace-regexp-in-string\r
- "\\$" ""\r
- (substring expansion 0 (string-match " " expansion))))\r
-\r
-\f\r
-;;; Abbrev definitions\r
-(defconst sotlisp--default-function-abbrevs\r
- '(\r
- ("a" . "and ")\r
- ("ah" . "add-hook '")\r
- ("atl" . "add-to-list '")\r
- ("bb" . "bury-buffer")\r
- ("bc" . "forward-char -1")\r
- ("bfn" . "buffer-file-name")\r
- ("bl" . "buffer-list$")\r
- ("blp" . "buffer-live-p ")\r
- ("bn" . "buffer-name")\r
- ("bod" . "beginning-of-defun")\r
- ("bol" . "forward-line 0$")\r
- ("bp" . "boundp '")\r
- ("bs" . "buffer-string$")\r
- ("bsn" . "buffer-substring-no-properties")\r
- ("bss" . "buffer-substring ")\r
- ("bw" . "forward-word -1")\r
- ("c" . "concat ")\r
- ("ca" . "char-after$")\r
- ("cb" . "current-buffer$")\r
- ("cc" . "condition-case er\n$\n(error nil)")\r
- ("ci" . "call-interactively ")\r
- ("cip" . "called-interactively-p 'any")\r
- ("csv" . "customize-save-variable '")\r
- ("d" . "delete-char 1")\r
- ("dc" . "delete-char 1")\r
- ("dcu" . "defcustom $ t\n \"\"\n :type 'boolean")\r
- ("df" . "defun $ ()\n \"\"\n ")\r
- ("dfa" . "defface $ \n '((t))\n \"\"\n ")\r
- ("dfc" . "defcustom $ t\n \"\"\n :type 'boolean")\r
- ("dff" . "defface $ \n '((t))\n \"\"\n ")\r
- ("dfv" . "defvar $ t\n \"\"")\r
- ("dk" . "define-key ")\r
- ("dl" . "dolist (it $)")\r
- ("dmp" . "derived-mode-p '")\r
- ("dr" . "delete-region ")\r
- ("dv" . "defvar $ t\n \"\"")\r
- ("e" . "error \"$\"")\r
- ("efn" . "expand-file-name ")\r
- ("eol" . "end-of-line")\r
- ("f" . "format \"$\"")\r
- ("fb" . "fboundp '")\r
- ("fbp" . "fboundp '")\r
- ("fc" . "forward-char 1")\r
- ("ff" . "find-file ")\r
- ("fl" . "forward-line 1")\r
- ("fp" . "functionp ")\r
- ("frp" . "file-readable-p ")\r
- ("fs" . "forward-sexp 1")\r
- ("fw" . "forward-word 1")\r
- ("g" . "goto-char ")\r
- ("gc" . "goto-char ")\r
- ("gsk" . "global-set-key ")\r
- ("i" . "insert ")\r
- ("ie" . "ignore-errors ")\r
- ("ii" . "interactive")\r
- ("ir" . "indent-region ")\r
- ("jcl" . "justify-current-line ")\r
- ("jl" . "delete-indentation")\r
- ("jos" . "just-one-space")\r
- ("jr" . "json-read$")\r
- ("jtr" . "jump-to-register ")\r
- ("k" . "kbd \"$\"")\r
- ("kb" . "kill-buffer")\r
- ("kn" . "kill-new ")\r
- ("kp" . "keywordp ")\r
- ("l" . "lambda ($)")\r
- ("la" . "looking-at \"$\"")\r
- ("lap" . "looking-at-p \"$\"")\r
- ("lb" . "looking-back \"$\"")\r
- ("lbp" . "line-beginning-position")\r
- ("lep" . "line-end-position")\r
- ("let" . "let (($))")\r
- ("lp" . "listp ")\r
- ("m" . "message \"$%s\"")\r
- ("mb" . "match-beginning 0")\r
- ("me" . "match-end 0")\r
- ("ms" . "match-string 0")\r
- ("msn" . "match-string-no-properties 0")\r
- ("msnp" . "match-string-no-properties 0")\r
- ("msp" . "match-string-no-properties 0")\r
- ("n" . "not ")\r
- ("nai" . "newline-and-indent$")\r
- ("nl" . "forward-line 1")\r
- ("np" . "numberp ")\r
- ("ntr" . "narrow-to-region ")\r
- ("ow" . "other-window 1")\r
- ("p" . "point$")\r
- ("pm" . "point-marker$")\r
- ("pa" . "point-max$")\r
- ("pg" . "plist-get ")\r
- ("pi" . "point-min$")\r
- ("r" . "require '")\r
- ("ra" . "use-region-p$")\r
- ("rap" . "use-region-p$")\r
- ("rb" . "region-beginning")\r
- ("re" . "region-end")\r
- ("rh" . "remove-hook '")\r
- ("rm" . "replace-match \"$\"")\r
- ("ro" . "regexp-opt ")\r
- ("rq" . "regexp-quote ")\r
- ("rris" . "replace-regexp-in-string ")\r
- ("rrs" . "replace-regexp-in-string ")\r
- ("rs" . "while (search-forward $ nil t)\n(replace-match \"\") nil t)")\r
- ("rsb" . "re-search-backward $ nil 'noerror")\r
- ("rsf" . "re-search-forward $ nil 'noerror")\r
- ("s" . "setq ")\r
- ("sb" . "search-backward $ nil 'noerror")\r
- ("sbr" . "search-backward-regexp $ nil 'noerror")\r
- ("scb" . "skip-chars-backward \"$\\r\\n[:blank:]\"")\r
- ("scf" . "skip-chars-forward \"$\\r\\n[:blank:]\"")\r
- ("se" . "save-excursion")\r
- ("sf" . "search-forward $ nil 'noerror")\r
- ("sfr" . "search-forward-regexp $ nil 'noerror")\r
- ("sic" . "self-insert-command")\r
- ("sl" . "string<")\r
- ("sm" . "string-match \"$\"")\r
- ("smd" . "save-match-data")\r
- ("sn" . "symbol-name ")\r
- ("sp" . "stringp ")\r
- ("sq" . "string= ")\r
- ("sr" . "save-restriction")\r
- ("ss" . "substring ")\r
- ("ssn" . "substring-no-properties ")\r
- ("ssnp" . "substring-no-properties ")\r
- ("stb" . "switch-to-buffer ")\r
- ("sw" . "selected-window$")\r
- ("syp" . "symbolp ")\r
- ("tap" . "thing-at-point 'symbol")\r
- ("u" . "unless ")\r
- ("ul" . "up-list")\r
- ("up" . "unwind-protect\n(progn $)")\r
- ("urp" . "use-region-p$")\r
- ("w" . "when ")\r
- ("wcb" . "with-current-buffer ")\r
- ("wf" . "write-file ")\r
- ("wh" . "while ")\r
- ("wl" . "window-list nil 'nominibuffer")\r
- ("we" . "window-end")\r
- ("ws" . "window-start")\r
- ("wtb" . "with-temp-buffer")\r
- ("wtf" . "with-temp-file ")\r
- )\r
- "Alist of (ABBREV . EXPANSION) used by `sotlisp'.")\r
-\r
-(defun sotlisp-define-function-abbrev (name expansion)\r
- "Define a function abbrev expanding NAME to EXPANSION.\r
-This abbrev will only be expanded in places where a function name is\r
-sensible. Roughly, this is right after a `(' or a `#''.\r
-\r
-If EXPANSION is any string, it doesn't have to be the just the\r
-name of a function. In particular:\r
- - if it contains a `$', this char will not be inserted and\r
- point will be moved to its position after expansion.\r
- - if it contains a space, only a substring of it up to the\r
-first space is inserted when expanding after a `#'' (this is done\r
-by defining two different abbrevs).\r
-\r
-For instance, if one defines\r
- (sotlisp-define-function-abbrev \"d\" \"delete-char 1\")\r
-\r
-then triggering `expand-abbrev' after \"d\" expands in the\r
-following way:\r
- (d => (delete-char 1\r
- #'d => #'delete-char"\r
- (define-abbrev emacs-lisp-mode-abbrev-table\r
- name t #'sotlisp--expand-function\r
- ;; Don't override user abbrevs\r
- :system t\r
- ;; Only expand in function places.\r
- :enable-function #'sotlisp--function-p)\r
- (puthash name expansion sotlisp--function-table))\r
-\r
-(defun sotlisp-erase-all-abbrevs ()\r
- "Undefine all abbrevs defined by `sotlisp'."\r
- (interactive)\r
- (maphash (lambda (x _) (define-abbrev emacs-lisp-mode-abbrev-table x nil))\r
- sotlisp--function-table))\r
-\r
-(defun sotlisp-define-all-abbrevs ()\r
- "Define all abbrevs in `sotlisp--default-function-abbrevs'."\r
- (interactive)\r
- (mapc (lambda (x) (sotlisp-define-function-abbrev (car x) (cdr x)))\r
- sotlisp--default-function-abbrevs))\r
-\r
-\f\r
-;;; The global minor-mode\r
-(defvar speed-of-thought-turn-on-hook '(sotlisp-turn-on-everywhere)\r
- "Hook run once when `speed-of-thought-mode' is enabled.\r
-Note that `speed-of-thought-mode' is global, so this is not run\r
-on every buffer.\r
-\r
-See `sotlisp-turn-on-everywhere' for an example of what a\r
-function in this hook should do.")\r
-\r
-(defvar speed-of-thought-turn-off-hook '(sotlisp-turn-off-everywhere)\r
- "Hook run once when `speed-of-thought-mode' is disabled.\r
-Note that `speed-of-thought-mode' is global, so this is not run\r
-on every buffer.\r
-\r
-See `sotlisp-turn-on-everywhere' for an example of what a\r
-function in this hook should do.")\r
-\r
-;;;###autoload\r
-(define-minor-mode speed-of-thought-mode nil nil nil nil\r
- :global t\r
- (run-hooks (if speed-of-thought-mode\r
- 'speed-of-thought-turn-on-hook\r
- 'speed-of-thought-turn-off-hook)))\r
-\r
-\f\r
-;;; The local minor-mode\r
-(defun sotlisp-turn-on-everywhere ()\r
- "Call-once function to turn on sotlisp everywhere.\r
-Calls `sotlisp-mode' on all `emacs-lisp-mode' buffers, and sets\r
-up a hook and abbrevs."\r
- (add-hook 'emacs-lisp-mode-hook #'sotlisp-mode)\r
- (sotlisp-define-all-abbrevs)\r
- (mapc (lambda (b)\r
- (with-current-buffer b\r
- (when (derived-mode-p 'emacs-lisp-mode)\r
- (sotlisp-mode 1))))\r
- (buffer-list)))\r
-\r
-(defun sotlisp-turn-off-everywhere ()\r
- "Call-once function to turn off sotlisp everywhere.\r
-Removes `sotlisp-mode' from all `emacs-lisp-mode' buffers, and\r
-removes hooks and abbrevs."\r
- (remove-hook 'emacs-lisp-mode-hook #'sotlisp-mode)\r
- (sotlisp-erase-all-abbrevs)\r
- (mapc (lambda (b)\r
- (with-current-buffer b\r
- (when (derived-mode-p 'emacs-lisp-mode)\r
- (sotlisp-mode -1))))\r
- (buffer-list)))\r
-\r
-(define-minor-mode sotlisp-mode nil nil " SoT"\r
- '(([M-return] . sotlisp-newline-and-parentheses)\r
- ([C-return] . sotlisp-downlist-newline-and-parentheses)\r
- ("\C-cf" . sotlisp-find-or-define-function)\r
- ("\C-cv" . sotlisp-find-or-define-variable)))\r
-\r
-\f\r
-;;; Commands\r
-(defun sotlisp-newline-and-parentheses ()\r
- "`newline-and-indent' then insert a pair of parentheses."\r
- (interactive)\r
- (point)\r
- (ignore-errors (expand-abbrev))\r
- (newline-and-indent)\r
- (insert "()")\r
- (forward-char -1))\r
-\r
-(defun sotlisp-downlist-newline-and-parentheses ()\r
- "`up-list', `newline-and-indent', then insert a parentheses pair."\r
- (interactive)\r
- (ignore-errors (expand-abbrev))\r
- (up-list)\r
- (newline-and-indent)\r
- (insert "()")\r
- (forward-char -1))\r
-\r
-(defun sotlisp--find-in-buffer (r s)\r
- "Find the string (concat R (regexp-quote S)) somewhere in this buffer."\r
- (let ((l (save-excursion\r
- (goto-char (point-min))\r
- (save-match-data\r
- (when (search-forward-regexp (concat r (regexp-quote s) "\\_>")\r
- nil :noerror)\r
- (match-beginning 0))))))\r
- (when l\r
- (push-mark)\r
- (goto-char l)\r
- l)))\r
-\r
-(defun sotlisp--beginning-of-defun ()\r
- "`push-mark' and move above this defun."\r
- (push-mark)\r
- (beginning-of-defun)\r
- (when (looking-back "^;;;###autoload\\s-*\n")\r
- (forward-line -1)))\r
-\r
-(defun sotlisp--function-at-point ()\r
- "Return name of `function-called-at-point'."\r
- (if (save-excursion\r
- (ignore-errors (forward-sexp -1)\r
- (looking-at-p "#'")))\r
- (thing-at-point 'symbol)\r
- (let ((fcap (function-called-at-point)))\r
- (if fcap\r
- (symbol-name fcap)\r
- (thing-at-point 'symbol)))))\r
-\r
-(defun sotlisp-find-or-define-function (&optional prefix)\r
- "If symbol under point is a defined function, go to it, otherwise define it.\r
-Essentially `find-function' on steroids.\r
-\r
-If you write in your code the name of a function you haven't\r
-defined yet, just place point on its name and hit \\[sotlisp-find-or-define-function]\r
-and a defun will be inserted with point inside it. After that,\r
-you can just hit `pop-mark' to go back to where you were.\r
-With a PREFIX argument, creates a `defmacro' instead.\r
-\r
-If the function under point is already defined this just calls\r
-`find-function', with one exception:\r
- if there's a defun (or equivalent) for this function in the\r
- current buffer, we go to that even if it's not where the\r
- global definition comes from (this is useful if you're\r
- writing an Emacs package that also happens to be installed\r
- through package.el).\r
-\r
-With a prefix argument, defines a `defmacro' instead of a `defun'."\r
- (interactive "P")\r
- (let ((name (sotlisp--function-at-point)))\r
- (unless (and name (sotlisp--find-in-buffer "(def\\(un\\|macro\\|alias\\) " name))\r
- (let ((name-s (intern-soft name)))\r
- (if (fboundp name-s)\r
- (find-function name-s)\r
- (sotlisp--beginning-of-defun)\r
- (insert "(def" (if prefix "macro" "un")\r
- " " name " (")\r
- (save-excursion (insert ")\n \"\"\n )\n\n")))))))\r
-\r
-(defun sotlisp-find-or-define-variable (&optional prefix)\r
- "If symbol under point is a defined variable, go to it, otherwise define it.\r
-Essentially `find-variable' on steroids.\r
-\r
-If you write in your code the name of a variable you haven't\r
-defined yet, place point on its name and hit \\[sotlisp-find-or-define-variable]\r
-and a `defcustom' will be created with point inside. After that,\r
-you can just `pop-mark' to go back to where you were. With a\r
-PREFIX argument, creates a `defvar' instead.\r
-\r
-If the variable under point is already defined this just calls\r
-`find-variable', with one exception:\r
- if there's a defvar (or equivalent) for this variable in the\r
- current buffer, we go to that even if it's not where the\r
- global definition comes from (this is useful if you're\r
- writing an Emacs package that also happens to be installed\r
- through package.el).\r
-\r
-With a prefix argument, defines a `defvar' instead of a `defcustom'."\r
- (interactive "P")\r
- (let ((name (symbol-name (variable-at-point t))))\r
- (unless (sotlisp--find-in-buffer "(def\\(custom\\|const\\|var\\) " name)\r
- (unless (and (symbolp (variable-at-point))\r
- (ignore-errors (find-variable (variable-at-point)) t))\r
- (let ((name (thing-at-point 'symbol)))\r
- (sotlisp--beginning-of-defun)\r
- (insert "(def" (if prefix "var" "custom")\r
- " " name " t")\r
- (save-excursion\r
- (insert "\n \"\""\r
- (if prefix "" "\n :type 'boolean")\r
- ")\n\n")))))))\r
-\r
-(provide 'sotlisp)\r
-;;; sotlisp.el ends here\r
-\r
+;;; sotlisp.el --- Write lisp at the speed of thought. -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2014 Free Software Foundation, Inc.
+
+;; Author: Artur Malabarba <bruce.connor.am@gmail.com>
+;; URL: https://github.com/Malabarba/speed-of-thought-lisp
+;; Keywords: convenience, lisp
+;; Package-Requires: ((emacs "24.1"))
+;; Version: 1.0
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; This defines a new global minor-mode `speed-of-thought-mode', which
+;; activates locally on any supported buffer. Currently, only
+;; `emacs-lisp-mode' buffers are supported.
+;;
+;; The mode is quite simple, and is composed of two parts:
+;;
+;;; Abbrevs
+;;
+;; A large number of abbrevs which expand function
+;; initials to their name. A few examples:
+;;
+;; - wcb -> with-current-buffer
+;; - i -> insert
+;; - r -> require '
+;; - a -> and
+;;
+;; However, these are defined in a way such that they ONLY expand in a
+;; place where you would use a function, so hitting SPC after "(r"
+;; expands to "(require '", but hitting SPC after "(delete-region r"
+;; will NOT expand the `r', because that's obviously not a function.
+;; Furtheromre, "#'r" will expand to "#'require" (note how it ommits
+;; that extra quote, since it would be useless here).
+;;
+;;; Commands
+;;
+;; It also defines 4 commands, which really fit into this "follow the
+;; thought-flow" way of writing. The bindings are as follows, I
+;; understand these don't fully adhere to conventions, and I'd
+;; appreciate suggestions on better bindings.
+;;
+;; - M-RET :: Break line, and insert "()" with point in the middle.
+;; - C-RET :: Do `forward-up-list', then do M-RET.
+;;
+;; Hitting RET followed by a `(' was one of the most common key sequences
+;; for me while writing elisp, so giving it a quick-to-hit key was a
+;; significant improvement.
+;;
+;; - C-c f :: Find function under point. If it is not defined, create a
+;; definition for it below the current function and leave point inside.
+;; - C-c v :: Same, but for variable.
+;;
+;; With these commands, you just write your code as you think of it. Once
+;; you hit a "stop-point" of sorts in your tought flow, you hit `C-c f/v`
+;; on any undefined functions/variables, write their definitions, and hit
+;; `C-u C-SPC` to go back to the main function.
+;;
+;;; Small Example
+;;
+;; With the above (assuming you use something like paredit or
+;; electric-pair-mode), if you write:
+;;
+;; ( w t b M-RET i SPC text
+;;
+;; You get
+;;
+;; (with-temp-buffer (insert text))
+
+\f
+;;; Code:
+
+;;; Predicates
+(defun sotlisp--auto-paired-p ()
+ "Non-nil if this buffer auto-inserts parentheses."
+ (or (bound-and-true-p electric-pair-mode)
+ (bound-and-true-p paredit-mode)
+ (bound-and-true-p smartparens-mode)))
+
+(defun sotlisp--function-form-p ()
+ "Non-nil if point is at the start of a sexp.
+Specially, avoids matching inside argument lists."
+ (and (eq (char-before) ?\()
+ (not (looking-back "(\\(defun\\s-+.*\\|lambda\\s-+\\)("))
+ (not (string-match (rx (syntax symbol)) (string last-command-event)))))
+
+(defun sotlisp--function-quote-p ()
+ "Non-nil if point is at a sharp-quote."
+ (looking-back "#'"))
+
+(defun sotlisp--function-p ()
+ "Non-nil if point is at reasonable place for a function name.
+Returns non-nil if, after moving backwards by a sexp, either
+`sotlisp--function-form-p' or `sotlisp--function-quote-p' return
+non-nil."
+ (save-excursion
+ (ignore-errors
+ (skip-chars-backward (rx alnum))
+ (or (sotlisp--function-form-p)
+ (sotlisp--function-quote-p)))))
+
+(defun sotlisp--whitespace-p ()
+ "Non-nil if current `self-insert'ed char is whitespace."
+ (ignore-errors
+ (string-match (rx space) (string last-command-event))))
+
+\f
+;;; Expansion logic
+(defvar sotlisp--needs-moving nil
+ "Will `sotlisp--move-to-$' move point after insertion?")
+
+(defun sotlisp--move-to-$ ()
+ "Move backwards until `$' and delete it.
+Point is left where the `$' char was. Does nothing if variable
+`sotlisp-mode' is nil."
+ (when (bound-and-true-p speed-of-thought-mode)
+ (when sotlisp--needs-moving
+ (setq sotlisp--needs-moving nil)
+ (skip-chars-backward "^\\$")
+ (delete-char -1))))
+
+(add-hook 'post-command-hook #'sotlisp--move-to-$ 'append)
+
+(defun sotlisp--maybe-skip-closing-paren ()
+ "Move past `)' if variable `electric-pair-mode' is enabled."
+ (when (and (char-after ?\))
+ (sotlisp--auto-paired-p))
+ (forward-char 1)))
+
+(defvar sotlisp--function-table (make-hash-table :test #'equal)
+ "Table where function abbrev expansions are stored.")
+
+(defun sotlisp--expand-function ()
+ "Expand the function abbrev before point.
+See `sotlisp-define-function-abbrev'."
+ (let ((r (point)))
+ (skip-chars-backward (rx alnum))
+ (let* ((name (buffer-substring (point) r))
+ (expansion (gethash name sotlisp--function-table)))
+ (delete-region (point) r)
+ (if (sotlisp--function-quote-p)
+ ;; After #' use the simple expansion.
+ (insert (sotlisp--simplify-function-expansion expansion))
+ ;; Inside a form, use the full expansion.
+ (insert expansion)
+ (when (string-match "\\$" expansion)
+ (setq sotlisp--needs-moving t))))
+ ;; Inform `expand-abbrev' that `self-insert-command' should not
+ ;; trigger, by returning non-nil on SPC.
+ (when (sotlisp--whitespace-p)
+ ;; And maybe move out of closing paren if expansion ends with $.
+ (when (eq (char-before) ?$)
+ (delete-char -1)
+ (setq sotlisp--needs-moving nil)
+ (sotlisp--maybe-skip-closing-paren))
+ t)))
+
+(put 'sotlisp--expand-function 'no-self-insert t)
+
+(defun sotlisp--simplify-function-expansion (expansion)
+ "Take a substring of EXPANSION up to first space.
+The space char is not included. Any \"$\" are also removed."
+ (replace-regexp-in-string
+ "\\$" ""
+ (substring expansion 0 (string-match " " expansion))))
+
+\f
+;;; Abbrev definitions
+(defconst sotlisp--default-function-abbrevs
+ '(
+ ("a" . "and ")
+ ("ah" . "add-hook '")
+ ("atl" . "add-to-list '")
+ ("bb" . "bury-buffer")
+ ("bc" . "forward-char -1")
+ ("bfn" . "buffer-file-name")
+ ("bl" . "buffer-list$")
+ ("blp" . "buffer-live-p ")
+ ("bn" . "buffer-name")
+ ("bod" . "beginning-of-defun")
+ ("bol" . "forward-line 0$")
+ ("bp" . "boundp '")
+ ("bs" . "buffer-string$")
+ ("bsn" . "buffer-substring-no-properties")
+ ("bss" . "buffer-substring ")
+ ("bw" . "forward-word -1")
+ ("c" . "concat ")
+ ("ca" . "char-after$")
+ ("cb" . "current-buffer$")
+ ("cc" . "condition-case er\n$\n(error nil)")
+ ("ci" . "call-interactively ")
+ ("cip" . "called-interactively-p 'any")
+ ("csv" . "customize-save-variable '")
+ ("d" . "delete-char 1")
+ ("dc" . "delete-char 1")
+ ("dcu" . "defcustom $ t\n \"\"\n :type 'boolean")
+ ("df" . "defun $ ()\n \"\"\n ")
+ ("dfa" . "defface $ \n '((t))\n \"\"\n ")
+ ("dfc" . "defcustom $ t\n \"\"\n :type 'boolean")
+ ("dff" . "defface $ \n '((t))\n \"\"\n ")
+ ("dfv" . "defvar $ t\n \"\"")
+ ("dk" . "define-key ")
+ ("dl" . "dolist (it $)")
+ ("dmp" . "derived-mode-p '")
+ ("dr" . "delete-region ")
+ ("dv" . "defvar $ t\n \"\"")
+ ("e" . "error \"$\"")
+ ("efn" . "expand-file-name ")
+ ("eol" . "end-of-line")
+ ("f" . "format \"$\"")
+ ("fb" . "fboundp '")
+ ("fbp" . "fboundp '")
+ ("fc" . "forward-char 1")
+ ("ff" . "find-file ")
+ ("fl" . "forward-line 1")
+ ("fp" . "functionp ")
+ ("frp" . "file-readable-p ")
+ ("fs" . "forward-sexp 1")
+ ("fw" . "forward-word 1")
+ ("g" . "goto-char ")
+ ("gc" . "goto-char ")
+ ("gsk" . "global-set-key ")
+ ("i" . "insert ")
+ ("ie" . "ignore-errors ")
+ ("ii" . "interactive")
+ ("ir" . "indent-region ")
+ ("jcl" . "justify-current-line ")
+ ("jl" . "delete-indentation")
+ ("jos" . "just-one-space")
+ ("jr" . "json-read$")
+ ("jtr" . "jump-to-register ")
+ ("k" . "kbd \"$\"")
+ ("kb" . "kill-buffer")
+ ("kn" . "kill-new ")
+ ("kp" . "keywordp ")
+ ("l" . "lambda ($)")
+ ("la" . "looking-at \"$\"")
+ ("lap" . "looking-at-p \"$\"")
+ ("lb" . "looking-back \"$\"")
+ ("lbp" . "line-beginning-position")
+ ("lep" . "line-end-position")
+ ("let" . "let (($))")
+ ("lp" . "listp ")
+ ("m" . "message \"$%s\"")
+ ("mb" . "match-beginning 0")
+ ("me" . "match-end 0")
+ ("ms" . "match-string 0")
+ ("msn" . "match-string-no-properties 0")
+ ("msnp" . "match-string-no-properties 0")
+ ("msp" . "match-string-no-properties 0")
+ ("n" . "not ")
+ ("nai" . "newline-and-indent$")
+ ("nl" . "forward-line 1")
+ ("np" . "numberp ")
+ ("ntr" . "narrow-to-region ")
+ ("ow" . "other-window 1")
+ ("p" . "point$")
+ ("pm" . "point-marker$")
+ ("pa" . "point-max$")
+ ("pg" . "plist-get ")
+ ("pi" . "point-min$")
+ ("r" . "require '")
+ ("ra" . "use-region-p$")
+ ("rap" . "use-region-p$")
+ ("rb" . "region-beginning")
+ ("re" . "region-end")
+ ("rh" . "remove-hook '")
+ ("rm" . "replace-match \"$\"")
+ ("ro" . "regexp-opt ")
+ ("rq" . "regexp-quote ")
+ ("rris" . "replace-regexp-in-string ")
+ ("rrs" . "replace-regexp-in-string ")
+ ("rs" . "while (search-forward $ nil t)\n(replace-match \"\") nil t)")
+ ("rsb" . "re-search-backward $ nil 'noerror")
+ ("rsf" . "re-search-forward $ nil 'noerror")
+ ("s" . "setq ")
+ ("sb" . "search-backward $ nil 'noerror")
+ ("sbr" . "search-backward-regexp $ nil 'noerror")
+ ("scb" . "skip-chars-backward \"$\\r\\n[:blank:]\"")
+ ("scf" . "skip-chars-forward \"$\\r\\n[:blank:]\"")
+ ("se" . "save-excursion")
+ ("sf" . "search-forward $ nil 'noerror")
+ ("sfr" . "search-forward-regexp $ nil 'noerror")
+ ("sic" . "self-insert-command")
+ ("sl" . "string<")
+ ("sm" . "string-match \"$\"")
+ ("smd" . "save-match-data")
+ ("sn" . "symbol-name ")
+ ("sp" . "stringp ")
+ ("sq" . "string= ")
+ ("sr" . "save-restriction")
+ ("ss" . "substring ")
+ ("ssn" . "substring-no-properties ")
+ ("ssnp" . "substring-no-properties ")
+ ("stb" . "switch-to-buffer ")
+ ("sw" . "selected-window$")
+ ("syp" . "symbolp ")
+ ("tap" . "thing-at-point 'symbol")
+ ("u" . "unless ")
+ ("ul" . "up-list")
+ ("up" . "unwind-protect\n(progn $)")
+ ("urp" . "use-region-p$")
+ ("w" . "when ")
+ ("wcb" . "with-current-buffer ")
+ ("wf" . "write-file ")
+ ("wh" . "while ")
+ ("wl" . "window-list nil 'nominibuffer")
+ ("we" . "window-end")
+ ("ws" . "window-start")
+ ("wtb" . "with-temp-buffer")
+ ("wtf" . "with-temp-file ")
+ )
+ "Alist of (ABBREV . EXPANSION) used by `sotlisp'.")
+
+(defun sotlisp-define-function-abbrev (name expansion)
+ "Define a function abbrev expanding NAME to EXPANSION.
+This abbrev will only be expanded in places where a function name is
+sensible. Roughly, this is right after a `(' or a `#''.
+
+If EXPANSION is any string, it doesn't have to be the just the
+name of a function. In particular:
+ - if it contains a `$', this char will not be inserted and
+ point will be moved to its position after expansion.
+ - if it contains a space, only a substring of it up to the
+first space is inserted when expanding after a `#'' (this is done
+by defining two different abbrevs).
+
+For instance, if one defines
+ (sotlisp-define-function-abbrev \"d\" \"delete-char 1\")
+
+then triggering `expand-abbrev' after \"d\" expands in the
+following way:
+ (d => (delete-char 1
+ #'d => #'delete-char"
+ (define-abbrev emacs-lisp-mode-abbrev-table
+ name t #'sotlisp--expand-function
+ ;; Don't override user abbrevs
+ :system t
+ ;; Only expand in function places.
+ :enable-function #'sotlisp--function-p)
+ (puthash name expansion sotlisp--function-table))
+
+(defun sotlisp-erase-all-abbrevs ()
+ "Undefine all abbrevs defined by `sotlisp'."
+ (interactive)
+ (maphash (lambda (x _) (define-abbrev emacs-lisp-mode-abbrev-table x nil))
+ sotlisp--function-table))
+
+(defun sotlisp-define-all-abbrevs ()
+ "Define all abbrevs in `sotlisp--default-function-abbrevs'."
+ (interactive)
+ (mapc (lambda (x) (sotlisp-define-function-abbrev (car x) (cdr x)))
+ sotlisp--default-function-abbrevs))
+
+\f
+;;; The global minor-mode
+(defvar speed-of-thought-turn-on-hook '(sotlisp-turn-on-everywhere)
+ "Hook run once when `speed-of-thought-mode' is enabled.
+Note that `speed-of-thought-mode' is global, so this is not run
+on every buffer.
+
+See `sotlisp-turn-on-everywhere' for an example of what a
+function in this hook should do.")
+
+(defvar speed-of-thought-turn-off-hook '(sotlisp-turn-off-everywhere)
+ "Hook run once when `speed-of-thought-mode' is disabled.
+Note that `speed-of-thought-mode' is global, so this is not run
+on every buffer.
+
+See `sotlisp-turn-on-everywhere' for an example of what a
+function in this hook should do.")
+
+;;;###autoload
+(define-minor-mode speed-of-thought-mode nil nil nil nil
+ :global t
+ (run-hooks (if speed-of-thought-mode
+ 'speed-of-thought-turn-on-hook
+ 'speed-of-thought-turn-off-hook)))
+
+\f
+;;; The local minor-mode
+(defun sotlisp-turn-on-everywhere ()
+ "Call-once function to turn on sotlisp everywhere.
+Calls `sotlisp-mode' on all `emacs-lisp-mode' buffers, and sets
+up a hook and abbrevs."
+ (add-hook 'emacs-lisp-mode-hook #'sotlisp-mode)
+ (sotlisp-define-all-abbrevs)
+ (mapc (lambda (b)
+ (with-current-buffer b
+ (when (derived-mode-p 'emacs-lisp-mode)
+ (sotlisp-mode 1))))
+ (buffer-list)))
+
+(defun sotlisp-turn-off-everywhere ()
+ "Call-once function to turn off sotlisp everywhere.
+Removes `sotlisp-mode' from all `emacs-lisp-mode' buffers, and
+removes hooks and abbrevs."
+ (remove-hook 'emacs-lisp-mode-hook #'sotlisp-mode)
+ (sotlisp-erase-all-abbrevs)
+ (mapc (lambda (b)
+ (with-current-buffer b
+ (when (derived-mode-p 'emacs-lisp-mode)
+ (sotlisp-mode -1))))
+ (buffer-list)))
+
+(define-minor-mode sotlisp-mode nil nil " SoT"
+ '(([M-return] . sotlisp-newline-and-parentheses)
+ ([C-return] . sotlisp-downlist-newline-and-parentheses)
+ ("\C-cf" . sotlisp-find-or-define-function)
+ ("\C-cv" . sotlisp-find-or-define-variable)))
+
+\f
+;;; Commands
+(defun sotlisp-newline-and-parentheses ()
+ "`newline-and-indent' then insert a pair of parentheses."
+ (interactive)
+ (point)
+ (ignore-errors (expand-abbrev))
+ (newline-and-indent)
+ (insert "()")
+ (forward-char -1))
+
+(defun sotlisp-downlist-newline-and-parentheses ()
+ "`up-list', `newline-and-indent', then insert a parentheses pair."
+ (interactive)
+ (ignore-errors (expand-abbrev))
+ (up-list)
+ (newline-and-indent)
+ (insert "()")
+ (forward-char -1))
+
+(defun sotlisp--find-in-buffer (r s)
+ "Find the string (concat R (regexp-quote S)) somewhere in this buffer."
+ (let ((l (save-excursion
+ (goto-char (point-min))
+ (save-match-data
+ (when (search-forward-regexp (concat r (regexp-quote s) "\\_>")
+ nil :noerror)
+ (match-beginning 0))))))
+ (when l
+ (push-mark)
+ (goto-char l)
+ l)))
+
+(defun sotlisp--beginning-of-defun ()
+ "`push-mark' and move above this defun."
+ (push-mark)
+ (beginning-of-defun)
+ (when (looking-back "^;;;###autoload\\s-*\n")
+ (forward-line -1)))
+
+(defun sotlisp--function-at-point ()
+ "Return name of `function-called-at-point'."
+ (if (save-excursion
+ (ignore-errors (forward-sexp -1)
+ (looking-at-p "#'")))
+ (thing-at-point 'symbol)
+ (let ((fcap (function-called-at-point)))
+ (if fcap
+ (symbol-name fcap)
+ (thing-at-point 'symbol)))))
+
+(defun sotlisp-find-or-define-function (&optional prefix)
+ "If symbol under point is a defined function, go to it, otherwise define it.
+Essentially `find-function' on steroids.
+
+If you write in your code the name of a function you haven't
+defined yet, just place point on its name and hit \\[sotlisp-find-or-define-function]
+and a defun will be inserted with point inside it. After that,
+you can just hit `pop-mark' to go back to where you were.
+With a PREFIX argument, creates a `defmacro' instead.
+
+If the function under point is already defined this just calls
+`find-function', with one exception:
+ if there's a defun (or equivalent) for this function in the
+ current buffer, we go to that even if it's not where the
+ global definition comes from (this is useful if you're
+ writing an Emacs package that also happens to be installed
+ through package.el).
+
+With a prefix argument, defines a `defmacro' instead of a `defun'."
+ (interactive "P")
+ (let ((name (sotlisp--function-at-point)))
+ (unless (and name (sotlisp--find-in-buffer "(def\\(un\\|macro\\|alias\\) " name))
+ (let ((name-s (intern-soft name)))
+ (if (fboundp name-s)
+ (find-function name-s)
+ (sotlisp--beginning-of-defun)
+ (insert "(def" (if prefix "macro" "un")
+ " " name " (")
+ (save-excursion (insert ")\n \"\"\n )\n\n")))))))
+
+(defun sotlisp-find-or-define-variable (&optional prefix)
+ "If symbol under point is a defined variable, go to it, otherwise define it.
+Essentially `find-variable' on steroids.
+
+If you write in your code the name of a variable you haven't
+defined yet, place point on its name and hit \\[sotlisp-find-or-define-variable]
+and a `defcustom' will be created with point inside. After that,
+you can just `pop-mark' to go back to where you were. With a
+PREFIX argument, creates a `defvar' instead.
+
+If the variable under point is already defined this just calls
+`find-variable', with one exception:
+ if there's a defvar (or equivalent) for this variable in the
+ current buffer, we go to that even if it's not where the
+ global definition comes from (this is useful if you're
+ writing an Emacs package that also happens to be installed
+ through package.el).
+
+With a prefix argument, defines a `defvar' instead of a `defcustom'."
+ (interactive "P")
+ (let ((name (symbol-name (variable-at-point t))))
+ (unless (sotlisp--find-in-buffer "(def\\(custom\\|const\\|var\\) " name)
+ (unless (and (symbolp (variable-at-point))
+ (ignore-errors (find-variable (variable-at-point)) t))
+ (let ((name (thing-at-point 'symbol)))
+ (sotlisp--beginning-of-defun)
+ (insert "(def" (if prefix "var" "custom")
+ " " name " t")
+ (save-excursion
+ (insert "\n \"\""
+ (if prefix "" "\n :type 'boolean")
+ ")\n\n")))))))
+
+(provide 'sotlisp)
+;;; sotlisp.el ends here
+