From: Artur Malabarba Date: Sat, 7 Mar 2015 23:37:45 +0000 (-0300) Subject: Merge branch 'master' of git+ssh://git.sv.gnu.org/srv/git/emacs/elpa X-Git-Url: https://code.delx.au/gnu-emacs-elpa/commitdiff_plain/5736e852fd48a0f1ba1c328dd4d03e3fa008a406?hp=-c Merge branch 'master' of git+ssh://git.sv.gnu.org/srv/git/emacs/elpa --- 5736e852fd48a0f1ba1c328dd4d03e3fa008a406 diff --combined packages/sotlisp/sotlisp.el index 1b5891119,afbc3ad66..61d598e4d --- a/packages/sotlisp/sotlisp.el +++ b/packages/sotlisp/sotlisp.el @@@ -1,534 -1,536 +1,533 @@@ - ;;; sotlisp.el --- Write lisp at the speed of thought. -*- lexical-binding: t; -*- - - ;; Copyright (C) 2014 Free Software Foundation, Inc. - - ;; Author: Artur Malabarba - ;; Keywords: convenience, lisp - ;; Package-Requires: ((emacs "24.1")) - - ;; 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 . - - ;;; 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)) - - - ;;; 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)))) - - - ;;; 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)))) - - - ;;; 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$") - ("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 ") - ("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$") - ("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") - ("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)) - - - ;;; 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))) - - - ;;; 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))) - - - ;;; 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 - + ;;; sotlisp.el --- Write lisp at the speed of thought. -*- lexical-binding: t; -*- + + ;; Copyright (C) 2014, 2015 Free Software Foundation, Inc. + + ;; Author: Artur Malabarba + ;; Keywords: convenience, lisp + ;; Package-Requires: ((emacs "24.1")) + ;; Version: 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 . + + ;;; 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)) + + + ;;; Code: -(eval-when-compile - (require 'subr-x)) + + ;;; 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)))) + + + ;;; 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)))) + + + ;;; 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$") + ("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 ") + ("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$") + ("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") + ("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)) + + + ;;; 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))) + + + ;;; 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))) + + + ;;; 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) - (if-let ((fcap (function-called-at-point))) - (symbol-name fcap) - (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 -