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

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