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