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