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

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