1 ;;; -*- Mode: Emacs-Lisp; outline-regexp: "
\f\n;;;;+" -*-
3 ;;;;;; Paredit: Parenthesis-Editing Minor Mode
6 ;;; Copyright (c) 2008, Taylor R. Campbell
8 ;;; Redistribution and use in source and binary forms, with or without
9 ;;; modification, are permitted provided that the following conditions
12 ;;; * Redistributions of source code must retain the above copyright
13 ;;; notice, this list of conditions and the following disclaimer.
15 ;;; * Redistributions in binary form must reproduce the above copyright
16 ;;; notice, this list of conditions and the following disclaimer in
17 ;;; the documentation and/or other materials provided with the
20 ;;; * Neither the names of the authors nor the names of contributors
21 ;;; may be used to endorse or promote products derived from this
22 ;;; software without specific prior written permission.
24 ;;; THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS
25 ;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
26 ;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
27 ;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY
28 ;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
29 ;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
30 ;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
31 ;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
32 ;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
33 ;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
34 ;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
36 ;;; This file is permanently stored at
37 ;;; <http://mumble.net/~campbell/emacs/paredit-21.el>.
39 ;;; The currently released version of paredit is available at
40 ;;; <http://mumble.net/~campbell/emacs/paredit.el>.
42 ;;; The latest beta version of paredit is available at
43 ;;; <http://mumble.net/~campbell/emacs/paredit-beta.el>.
45 ;;; Release notes are available at
46 ;;; <http://mumble.net/~campbell/emacs/paredit.release>.
48 ;;; Install paredit by placing `paredit.el' in `/path/to/elisp', a
49 ;;; directory of your choice, and adding to your .emacs file:
51 ;;; (add-to-list 'load-path "/path/to/elisp")
52 ;;; (autoload 'paredit-mode "paredit"
53 ;;; "Minor mode for pseudo-structurally editing Lisp code."
56 ;;; Toggle Paredit Mode with `M-x paredit-mode RET', or enable it
57 ;;; always in a major mode `M' (e.g., `lisp' or `scheme') with:
59 ;;; (add-hook M-mode-hook (lambda () (paredit-mode +1)))
61 ;;; Customize paredit using `eval-after-load':
63 ;;; (eval-after-load 'paredit
64 ;;; '(progn ...redefine keys, &c....))
66 ;;; Paredit should run in GNU Emacs 21 or later and XEmacs 21.5 or
67 ;;; later. Paredit is highly unlikely to work in earlier versions of
68 ;;; GNU Emacs, and it may have obscure problems in earlier versions of
69 ;;; XEmacs due to the way its syntax parser reports conditions, as a
70 ;;; result of which the code that uses the syntax parser must mask all
71 ;;; error conditions, not just those generated by the syntax parser.
73 ;;; Questions, bug reports, comments, feature suggestions, &c., may be
74 ;;; addressed via email to the author's surname at mumble.net or via
75 ;;; IRC to the user named Riastradh on irc.freenode.net in the #paredit
78 ;;; Please contact the author rather than forking your own versions, to
79 ;;; prevent the dissemination of random variants floating about the
80 ;;; internet unbeknownst to the author. Laziness is not an excuse:
81 ;;; your laziness costs me confusion and time trying to support
82 ;;; paredit, so if you fork paredit, you make the world a worse place.
84 ;;; *** WARNING *** IMPORTANT *** DO NOT SUBMIT BUGS BEFORE READING ***
86 ;;; If you plan to submit a bug report, where some sequence of keys in
87 ;;; Paredit Mode, or some sequence of paredit commands, doesn't do what
88 ;;; you wanted, then it is helpful to isolate an example in a very
89 ;;; small buffer, and it is **ABSOLUTELY**ESSENTIAL** that you supply,
90 ;;; along with the sequence of keys or commands,
92 ;;; (1) the version of Emacs,
93 ;;; (2) the version of paredit.el[*], and
94 ;;; (3) the **COMPLETE** state of the buffer used to reproduce the
95 ;;; problem, including major mode, minor modes, local key
96 ;;; bindings, entire contents of the buffer, leading line breaks
99 ;;; It is often extremely difficult to reproduce problems, especially
100 ;;; with commands like `paredit-kill'. If you do not supply **ALL** of
101 ;;; this information, then it is highly probable that I cannot
102 ;;; reproduce your problem no matter how hard I try, and the effect of
103 ;;; submitting a bug without this information is only to waste your
104 ;;; time and mine. So, please, include all of the above information.
106 ;;; [*] If you are using a beta version of paredit, be sure that you
107 ;;; are using the *latest* edition of the beta version, available
108 ;;; at <http://mumble.net/~campbell/emacs/paredit-beta.el>. If you
109 ;;; are not using a beta version, then upgrade either to that or to
110 ;;; the latest release version; I cannot support older versions,
111 ;;; and I can't fathom any reason why you might be using them. So
112 ;;; the answer to item (2) should be either `release' or `beta'.
114 ;;; The paredit minor mode, Paredit Mode, binds a number of simple
115 ;;; keys, notably `(', `)', `"', and `\', to commands that more
116 ;;; carefully insert S-expression structures in the buffer. The
117 ;;; parenthesis delimiter keys (round or square) are defined to insert
118 ;;; parenthesis pairs and move past the closing delimiter,
119 ;;; respectively; the double-quote key is multiplexed to do both, and
120 ;;; also to insert an escape if within a string; and backslashes prompt
121 ;;; the user for the next character to input, because a lone backslash
122 ;;; can break structure inadvertently. These all have their ordinary
123 ;;; behaviour when inside comments, and, outside comments, if truly
124 ;;; necessary, you can insert them literally with `C-q'.
126 ;;; The key bindings are designed so that when typing new code in
127 ;;; Paredit Mode, you can generally use exactly the same keystrokes as
128 ;;; you would have used without Paredit Mode. Earlier versions of
129 ;;; paredit.el did not conform to this, because Paredit Mode bound `)'
130 ;;; to a command that would insert a newline. Now `)' is bound to a
131 ;;; command that does not insert a newline, and `M-)' is bound to the
132 ;;; command that inserts a newline. To revert to the former behaviour,
133 ;;; add the following forms to an `eval-after-load' form for paredit.el
134 ;;; in your .emacs file:
136 ;;; (define-key paredit-mode-map (kbd ")")
137 ;;; 'paredit-close-round-and-newline)
138 ;;; (define-key paredit-mode-map (kbd "M-)")
139 ;;; 'paredit-close-round)
141 ;;; Paredit Mode also binds the usual keys for deleting and killing, so
142 ;;; that they will not destroy any S-expression structure by killing or
143 ;;; deleting only one side of a parenthesis or quote pair. If the
144 ;;; point is on a closing delimiter, `DEL' will move left over it; if
145 ;;; it is on an opening delimiter, `C-d' will move right over it. Only
146 ;;; if the point is between a pair of delimiters will `C-d' or `DEL'
147 ;;; delete them, and in that case it will delete both simultaneously.
148 ;;; `M-d' and `M-DEL' kill words, but skip over any S-expression
149 ;;; structure. `C-k' kills from the start of the line, either to the
150 ;;; line's end, if it contains only balanced expressions; to the first
151 ;;; closing delimiter, if the point is within a form that ends on the
152 ;;; line; or up to the end of the last expression that starts on the
153 ;;; line after the point.
155 ;;; The behaviour of the commands for deleting and killing can be
156 ;;; overridden by passing a `C-u' prefix argument: `C-u DEL' will
157 ;;; delete a character backward, `C-u C-d' will delete a character
158 ;;; forward, and `C-u C-k' will kill text from the point to the end of
159 ;;; the line, irrespective of the S-expression structure in the buffer.
160 ;;; This can be used to fix mistakes in a buffer, but should generally
163 ;;; Paredit performs automatic reindentation as locally as possible, to
164 ;;; avoid interfering with custom indentation used elsewhere in some
165 ;;; S-expression. Only the advanced S-expression manipulation commands
166 ;;; automatically reindent, and only the forms that were immediately
167 ;;; operated upon (and their subforms).
169 ;;; This code is written for clarity, not efficiency. It frequently
170 ;;; walks over S-expressions redundantly. If you have problems with
171 ;;; the time it takes to execute some of the commands, let me know, but
172 ;;; first be sure that what you're doing is reasonable: it is
173 ;;; preferable to avoid immense S-expressions in code anyway.
175 ;;; This assumes Unix-style LF line endings.
177 (defconst paredit-version 21)
178 (defconst paredit-beta-p nil)
182 (defun paredit-xemacs-p ()
183 ;; No idea where I got this definition from. Edward O'Connor
184 ;; (hober in #emacs) suggested the current definition.
185 ;; (and (boundp 'running-xemacs)
189 (defun paredit-gnu-emacs-p ()
190 ;++ This could probably be improved.
191 (not (paredit-xemacs-p)))
193 (defmacro xcond (&rest clauses)
195 Signal an error if no clause matches."
197 (t (error "XCOND lost."))))
199 (defalias 'paredit-warn (if (fboundp 'warn) 'warn 'message))
201 (defvar paredit-sexp-error-type
204 (condition-case condition
206 (error (if (eq (car condition) 'error)
207 (paredit-warn "%s%s%s%s%s"
208 "Paredit is unable to discriminate"
209 " S-expression parse errors from"
211 " This may cause obscure problems. "
212 " Please upgrade Emacs."))
215 (defmacro paredit-handle-sexp-errors (body &rest handler)
218 (,paredit-sexp-error-type ,@handler)))
220 (put 'paredit-handle-sexp-errors 'lisp-indent-function 1)
222 (defmacro paredit-ignore-sexp-errors (&rest body)
223 `(paredit-handle-sexp-errors (progn ,@body)
226 (put 'paredit-ignore-sexp-errors 'lisp-indent-function 0)
230 ;;;; Minor Mode Definition
232 (defvar paredit-mode-map (make-sparse-keymap)
233 "Keymap for the paredit minor mode.")
235 (define-minor-mode paredit-mode
236 "Minor mode for pseudo-structurally editing Lisp code.
237 \\<paredit-mode-map>"
239 ;; If we're enabling paredit-mode, the prefix to this code that
240 ;; DEFINE-MINOR-MODE inserts will have already set PAREDIT-MODE to
241 ;; true. If this is the case, then first check the parentheses, and
242 ;; if there are any imbalanced ones we must inhibit the activation of
243 ;; paredit mode. We skip the check, though, if the user supplied a
244 ;; prefix argument interactively.
245 (if (and paredit-mode
246 (not current-prefix-arg))
247 (if (not (fboundp 'check-parens))
248 (paredit-warn "`check-parens' is not defined; %s"
249 "be careful of malformed S-expressions.")
250 (condition-case condition
252 (error (setq paredit-mode nil)
253 (signal (car condition) (cdr condition)))))))
255 ;;; Old functions from when there was a different mode for emacs -nw.
257 (defun enable-paredit-mode ()
258 "Turn on pseudo-structural editing of Lisp code.
260 Deprecated: use `paredit-mode' instead."
264 (defun disable-paredit-mode ()
265 "Turn off pseudo-structural editing of Lisp code.
267 Deprecated: use `paredit-mode' instead."
271 (defvar paredit-backward-delete-key
272 (xcond ((paredit-xemacs-p) "BS")
273 ((paredit-gnu-emacs-p) "DEL")))
275 (defvar paredit-forward-delete-keys
276 (xcond ((paredit-xemacs-p) '("DEL"))
277 ((paredit-gnu-emacs-p) '("<delete>" "<deletechar>"))))
281 ;;; Separating the definition and initialization of this variable
282 ;;; simplifies the development of paredit, since re-evaluating DEFVAR
283 ;;; forms doesn't actually do anything.
285 (defvar paredit-commands nil
286 "List of paredit commands with their keys and examples.")
288 ;;; Each specifier is of the form:
289 ;;; (key[s] function (example-input example-output) ...)
290 ;;; where key[s] is either a single string suitable for passing to KBD
291 ;;; or a list of such strings. Entries in this list may also just be
292 ;;; strings, in which case they are headings for the next entries.
294 (progn (setq paredit-commands
296 "Basic Insertion Commands"
297 ("(" paredit-open-round
300 ("(foo \"bar |baz\" quux)"
301 "(foo \"bar (|baz\" quux)"))
302 (")" paredit-close-round
303 ("(a b |c )" "(a b c)|")
305 "; Hello,)| world!"))
306 ("M-)" paredit-close-round-and-newline
311 ("[" paredit-open-square
314 ("(foo \"bar |baz\" quux)"
315 "(foo \"bar [baz\" quux)"))
316 ("]" paredit-close-square
317 ("(define-key keymap [frob| ] 'frobnicate)"
318 "(define-key keymap [frob]| 'frobnicate)")
321 ("\"" paredit-doublequote
322 ("(frob grovel |full lexical)"
323 "(frob grovel \"|\" full lexical)")
324 ("(foo \"bar |baz\" quux)"
325 "(foo \"bar \\\"|baz\" quux)"))
326 ("M-\"" paredit-meta-doublequote
327 ("(foo \"bar |baz\" quux)"
328 "(foo \"bar baz\"\n |quux)")
329 ("(foo |(bar #\\x \"baz \\\\ quux\") zot)"
330 ,(concat "(foo \"|(bar #\\\\x \\\"baz \\\\"
331 "\\\\ quux\\\")\" zot)")))
332 ("\\" paredit-backslash
333 ("(string #|)\n ; Escaping character... (x)"
335 ("\"foo|bar\"\n ; Escaping character... (\")"
337 ("M-;" paredit-comment-dwim
342 (" (foo bar)\n|\n (baz quux)"
343 " (foo bar)\n ;; |\n (baz quux)")
344 (" (foo bar) |(baz quux)"
345 " (foo bar)\n ;; |\n (baz quux)")
346 ("|(defun hello-world ...)"
347 ";;; |\n(defun hello-world ...)"))
349 ("C-j" paredit-newline
350 ("(let ((n (frobbotz))) |(display (+ n 1)\nport))"
351 ,(concat "(let ((n (frobbotz)))"
352 "\n |(display (+ n 1)"
356 (("C-d" ,@paredit-forward-delete-keys)
357 paredit-forward-delete
358 ("(quu|x \"zot\")" "(quu| \"zot\")")
362 ("(foo (|) bar)" "(foo | bar)")
363 ("|(foo bar)" "(|foo bar)"))
364 (,paredit-backward-delete-key
365 paredit-backward-delete
366 ("(\"zot\" q|uux)" "(\"zot\" |uux)")
370 ("(foo (|) bar)" "(foo | bar)")
371 ("(foo bar)|" "(foo bar|)"))
373 ("(foo bar)| ; Useless comment!"
375 ("(|foo bar) ; Useful comment!"
376 "(|) ; Useful comment!")
377 ("|(foo bar) ; Useless line!"
379 ("(foo \"|bar baz\"\n quux)"
380 "(foo \"|\"\n quux)"))
381 ("M-d" paredit-forward-kill-word
386 (";;;| Frobnicate\n(defun frobnicate ...)"
387 ";;;|\n(defun frobnicate ...)"
388 ";;;\n(| frobnicate ...)"))
389 (,(concat "M-" paredit-backward-delete-key)
390 paredit-backward-kill-word
391 ("(foo bar) ; baz\n(quux)|"
392 "(foo bar) ; baz\n(|)"
397 "Movement & Navigation"
398 ("C-M-f" paredit-forward
399 ("(foo |(bar baz) quux)"
400 "(foo (bar baz)| quux)")
403 ("C-M-b" paredit-backward
404 ("(foo (bar baz)| quux)"
405 "(foo |(bar baz) quux)")
408 ;;;("C-M-u" backward-up-list) ; These two are built-in.
409 ;;;("C-M-d" down-list)
410 ("C-M-p" backward-down-list) ; Built-in, these are FORWARD-
411 ("C-M-n" up-list) ; & BACKWARD-LIST, which have
412 ; no need given C-M-f & C-M-b.
414 "Depth-Changing Commands"
415 ("M-(" paredit-wrap-round
418 ("M-s" paredit-splice-sexp
419 ("(foo (bar| baz) quux)"
420 "(foo bar| baz quux)"))
421 (("M-<up>" "ESC <up>")
422 paredit-splice-sexp-killing-backward
423 ("(foo (let ((x 5)) |(sqrt n)) bar)"
424 "(foo (sqrt n) bar)"))
425 (("M-<down>" "ESC <down>")
426 paredit-splice-sexp-killing-forward
429 ("M-r" paredit-raise-sexp
430 ("(dynamic-wind in (lambda () |body) out)"
431 "(dynamic-wind in |body out)"
436 paredit-forward-slurp-sexp
437 ("(foo (bar |baz) quux zot)"
438 "(foo (bar |baz quux) zot)")
439 ("(a b ((c| d)) e f)"
440 "(a b ((c| d) e) f)"))
442 paredit-forward-barf-sexp
443 ("(foo (bar |baz quux) zot)"
444 "(foo (bar |baz) quux zot)"))
445 (("C-(" "C-M-<left>" "ESC C-<left>")
446 paredit-backward-slurp-sexp
447 ("(foo bar (baz| quux) zot)"
448 "(foo (bar baz| quux) zot)")
449 ("(a b ((c| d)) e f)"
450 "(a (b (c| d)) e f)"))
451 (("C-{" "C-M-<right>" "ESC C-<right>")
452 paredit-backward-barf-sexp
453 ("(foo (bar baz |quux) zot)"
454 "(foo bar (baz |quux) zot)"))
456 "Miscellaneous Commands"
457 ("M-S" paredit-split-sexp
460 ("\"Hello, |world!\""
461 "\"Hello, \"| \"world!\""))
462 ("M-J" paredit-join-sexps
465 ("\"Hello, \"| \"world!\""
466 "\"Hello, |world!\"")
469 ("C-c C-M-l" paredit-recentre-on-sexp)
470 ("M-q" paredit-reindent-defun)
474 ;;;;; Command Examples
477 (defmacro paredit-do-commands (vars string-case &rest body)
478 (let ((spec (nth 0 vars))
481 (examples (nth 3 vars)))
482 `(dolist (,spec paredit-commands)
485 (let ((,keys (let ((k (car ,spec)))
486 (cond ((stringp k) (list k))
488 (t (error "Invalid paredit command %s."
491 (,examples (cddr ,spec)))
494 (put 'paredit-do-commands 'lisp-indent-function 2))
496 (defun paredit-define-keys ()
497 (paredit-do-commands (spec keys fn examples)
500 (define-key paredit-mode-map (read-kbd-macro key) fn))))
502 (defun paredit-function-documentation (fn)
503 (let ((original-doc (get fn 'paredit-original-documentation))
504 (doc (documentation fn 'function-documentation)))
506 (progn (put fn 'paredit-original-documentation doc)
509 (defun paredit-annotate-mode-with-examples ()
511 (list (paredit-function-documentation 'paredit-mode))))
512 (paredit-do-commands (spec keys fn examples)
513 (push (concat "\n
\f\n" spec "\n")
515 (let ((name (symbol-name fn)))
516 (if (string-match (symbol-name 'paredit-) name)
517 (push (concat "\n\n\\[" name "]\t" name
519 (mapconcat (lambda (example)
528 "\n (no examples)\n"))
530 (put 'paredit-mode 'function-documentation
531 (apply 'concat (reverse contents))))
532 ;; PUT returns the huge string we just constructed, which we don't
533 ;; want it to return.
536 (defun paredit-annotate-functions-with-examples ()
537 (paredit-do-commands (spec keys fn examples)
539 (put fn 'function-documentation
540 (concat (paredit-function-documentation fn)
541 "\n\n\\<paredit-mode-map>\\[" (symbol-name fn) "]\n"
542 (mapconcat (lambda (example)
553 (defun paredit-insert-html-examples ()
554 "Insert HTML for a paredit quick reference table."
557 (lambda (&rest lines)
558 (mapc (lambda (line) (insert line) (newline))
562 (mapconcat 'paredit-html-quote keys ", ")))
565 (concat "<table><tr><td><pre>"
566 (mapconcat 'paredit-html-quote
568 (concat "</pre></td></tr><tr><td>"
569 " --->"
570 "</td></tr><tr><td><pre>"))
571 "</pre></td></tr></table>")))
573 (paredit-do-commands (spec keys fn examples)
574 (progn (if (not firstp)
575 (insert "</table>\n")
577 (funcall insert-lines
578 (concat "<h3>" spec "</h3>")
579 "<table border=\"1\" cellpadding=\"1\">"
585 (let ((name (symbol-name fn)))
586 (if (string-match (symbol-name 'paredit-) name)
587 (funcall insert-lines
589 (concat " <td><tt>" name "</tt></td>")
590 (concat " <td align=\"center\">"
591 (funcall html-keys keys)
595 (mapconcat html-example examples
600 (insert "</table>\n"))
602 (defun paredit-html-quote (string)
604 (dotimes (i (length string))
605 (insert (let ((c (elt string i)))
606 (cond ((eq c ?\<) "<")
609 ((eq c ?\') "'")
610 ((eq c ?\") """)
614 ;;;; Delimiter Insertion
617 (defun paredit-conc-name (&rest strings)
618 (intern (apply 'concat strings)))
620 (defmacro define-paredit-pair (open close name)
622 (defun ,(paredit-conc-name "paredit-open-" name) (&optional n)
623 ,(concat "Insert a balanced " name " pair.
624 With a prefix argument N, put the closing " name " after N
625 S-expressions forward.
626 If the region is active, `transient-mark-mode' is enabled, and the
627 region's start and end fall in the same parenthesis depth, insert a
628 " name " pair around the region.
629 If in a string or a comment, insert a single " name ".
630 If in a character literal, do nothing. This prevents changing what was
631 in the character literal to a meaningful delimiter unintentionally.")
633 (cond ((or (paredit-in-string-p)
634 (paredit-in-comment-p))
636 ((not (paredit-in-char-p))
637 (paredit-insert-pair n ,open ,close 'goto-char))))
638 (defun ,(paredit-conc-name "paredit-close-" name) ()
639 ,(concat "Move past one closing delimiter and reindent.
640 \(Agnostic to the specific closing delimiter.)
641 If in a string or comment, insert a single closing " name ".
642 If in a character literal, do nothing. This prevents changing what was
643 in the character literal to a meaningful delimiter unintentionally.")
645 (paredit-move-past-close ,close))
646 (defun ,(paredit-conc-name "paredit-close-" name "-and-newline") ()
647 ,(concat "Move past one closing delimiter, add a newline,"
649 If there was a margin comment after the closing delimiter, preserve it
652 (paredit-move-past-close-and-newline ,close))
653 (defun ,(paredit-conc-name "paredit-wrap-" name)
655 ,(concat "Wrap the following S-expression.
656 See `paredit-wrap-sexp' for more details.")
658 (paredit-wrap-sexp argument ,open ,close))
659 (add-to-list 'paredit-wrap-commands
660 ',(paredit-conc-name "paredit-wrap-" name)))))
662 (defvar paredit-wrap-commands '(paredit-wrap-sexp)
663 "List of paredit commands that wrap S-expressions.
664 Used by `paredit-yank-pop'; for internal paredit use only.")
666 (define-paredit-pair ?\( ?\) "round")
667 (define-paredit-pair ?\[ ?\] "square")
668 (define-paredit-pair ?\{ ?\} "curly")
669 (define-paredit-pair ?\< ?\> "angled")
671 ;;; Aliases for the old names.
673 (defalias 'paredit-open-parenthesis 'paredit-open-round)
674 (defalias 'paredit-close-parenthesis 'paredit-close-round)
675 (defalias 'paredit-close-parenthesis-and-newline
676 'paredit-close-round-and-newline)
678 (defalias 'paredit-open-bracket 'paredit-open-square)
679 (defalias 'paredit-close-bracket 'paredit-close-square)
680 (defalias 'paredit-close-bracket-and-newline
681 'paredit-close-square-and-newline)
683 (defun paredit-move-past-close (close)
684 (cond ((or (paredit-in-string-p)
685 (paredit-in-comment-p))
687 ((not (paredit-in-char-p))
688 (paredit-move-past-close-and-reindent close)
689 (paredit-blink-paren-match nil))))
691 (defun paredit-move-past-close-and-newline (close)
692 (if (or (paredit-in-string-p)
693 (paredit-in-comment-p))
695 (if (paredit-in-char-p) (forward-char))
696 (paredit-move-past-close-and-reindent close)
697 (let ((comment.point (paredit-find-comment-on-line)))
703 (indent-to (cdr comment.point))
704 (insert (car comment.point)))))
706 (paredit-ignore-sexp-errors (indent-sexp))
707 (paredit-blink-paren-match t)))
709 (defun paredit-find-comment-on-line ()
710 "Find a margin comment on the current line.
711 Return nil if there is no such comment or if there is anything but
712 whitespace until such a comment.
713 If such a comment exists, delete the comment (including all leading
714 whitespace) and return a cons whose car is the comment as a string
715 and whose cdr is the point of the comment's initial semicolon,
716 relative to the start of the line."
718 (paredit-skip-whitespace t (point-at-eol))
719 (and (eq ?\; (char-after))
720 (not (eq ?\; (char-after (1+ (point)))))
721 (not (or (paredit-in-string-p)
722 (paredit-in-char-p)))
723 (let* ((start ;Move to before the semicolon.
724 (progn (backward-char) (point)))
726 (buffer-substring start (point-at-eol))))
727 (paredit-skip-whitespace nil (point-at-bol))
728 (delete-region (point) (point-at-eol))
729 (cons comment (- start (point-at-bol)))))))
731 (defun paredit-insert-pair (n open close forward)
733 (and (paredit-region-active-p)
734 (paredit-region-safe-for-insert-p)))
738 (prog1 (region-end) (goto-char (region-beginning))))))
739 (let ((spacep (paredit-space-for-delimiter-p nil open)))
740 (if spacep (insert " "))
743 ;; Move past the desired region.
744 (cond (n (funcall forward
746 (forward-sexp (prefix-numeric-value n))
748 (regionp (funcall forward (+ end (if spacep 2 1)))))
750 (if (paredit-space-for-delimiter-p t close)
753 (defun paredit-region-safe-for-insert-p ()
755 (let ((beginning (region-beginning))
757 (goto-char beginning)
758 (let* ((beginning-state (paredit-current-parse-state))
760 (parse-partial-sexp beginning end nil nil beginning-state)))
761 (and (= (nth 0 beginning-state) ; 0. depth in parens
763 (eq (nth 3 beginning-state) ; 3. non-nil if inside a
764 (nth 3 end-state)) ; string
765 (eq (nth 4 beginning-state) ; 4. comment status, yada
767 (eq (nth 5 beginning-state) ; 5. t if following char
768 (nth 5 end-state))))))) ; quote
770 (defun paredit-space-for-delimiter-p (endp delimiter)
771 ;; If at the buffer limit, don't insert a space. If there is a word,
772 ;; symbol, other quote, or non-matching parenthesis delimiter (i.e. a
773 ;; close when want an open the string or an open when we want to
774 ;; close the string), do insert a space.
775 (and (not (if endp (eobp) (bobp)))
776 (memq (char-syntax (if endp (char-after) (char-before)))
778 (let ((matching (matching-paren delimiter)))
779 (and matching (char-syntax matching)))))))
781 (defun paredit-move-past-close-and-reindent (close)
782 (let ((open (paredit-missing-close)))
784 (if (eq close (matching-paren open))
786 (message "Missing closing delimiter: %c" close)
788 (error "Mismatched missing closing delimiter: %c ... %c"
790 (let ((orig (point)))
792 (if (catch 'return ; This CATCH returns T if it
793 (while t ; should delete leading spaces
794 (save-excursion ; and NIL if not.
795 (let ((before-paren (1- (point))))
796 (back-to-indentation)
797 (cond ((not (eq (point) before-paren))
798 ;; Can't call PAREDIT-DELETE-LEADING-WHITESPACE
799 ;; here -- we must return from SAVE-EXCURSION
802 ((save-excursion (forward-line -1)
804 (paredit-in-comment-p))
805 ;; Moving the closing delimiter any further
806 ;; would put it into a comment, so we just
807 ;; indent the closing delimiter where it is and
808 ;; abort the loop, telling its continuation that
809 ;; no leading whitespace should be deleted.
812 (t (delete-indentation)))))))
813 (paredit-delete-leading-whitespace))))
815 (defun paredit-missing-close ()
817 (paredit-handle-sexp-errors (backward-up-list)
818 (error "Not inside a list."))
819 (let ((open (char-after)))
820 (paredit-handle-sexp-errors (progn (forward-sexp) nil)
823 (defun paredit-delete-leading-whitespace ()
824 ;; This assumes that we're on the closing delimiter already.
827 (while (let ((syn (char-syntax (char-before))))
828 (and (or (eq syn ?\ ) (eq syn ?-)) ; whitespace syntax
829 ;; The above line is a perfect example of why the
830 ;; following test is necessary.
831 (not (paredit-in-char-p (1- (point))))))
832 (backward-delete-char 1))))
834 (defun paredit-blink-paren-match (another-line-p)
835 (if (and blink-matching-paren
836 (or (not show-paren-mode) another-line-p))
837 (paredit-ignore-sexp-errors
841 ;; SHOW-PAREN-MODE inhibits any blinking, so we disable it
843 (let ((show-paren-mode nil))
844 (blink-matching-open))))))
846 (defun paredit-doublequote (&optional n)
847 "Insert a pair of double-quotes.
848 With a prefix argument N, wrap the following N S-expressions in
849 double-quotes, escaping intermediate characters if necessary.
850 If the region is active, `transient-mark-mode' is enabled, and the
851 region's start and end fall in the same parenthesis depth, insert a
852 pair of double-quotes around the region, again escaping intermediate
853 characters if necessary.
854 Inside a comment, insert a literal double-quote.
855 At the end of a string, move past the closing double-quote.
856 In the middle of a string, insert a backslash-escaped double-quote.
857 If in a character literal, do nothing. This prevents accidentally
858 changing a what was in the character literal to become a meaningful
859 delimiter unintentionally."
861 (cond ((paredit-in-string-p)
862 (if (eq (cdr (paredit-string-start+end-points))
864 (forward-char) ; We're on the closing quote.
866 ((paredit-in-comment-p)
868 ((not (paredit-in-char-p))
869 (paredit-insert-pair n ?\" ?\" 'paredit-forward-for-quote))))
871 (defun paredit-meta-doublequote (&optional n)
872 "Move to the end of the string, insert a newline, and indent.
873 If not in a string, act as `paredit-doublequote'; if no prefix argument
874 is specified and the region is not active or `transient-mark-mode' is
875 disabled, the default is to wrap one S-expression, however, not
878 (if (not (paredit-in-string-p))
879 (paredit-doublequote (or n
880 (and (not (paredit-region-active-p))
882 (let ((start+end (paredit-string-start+end-points)))
883 (goto-char (1+ (cdr start+end)))
886 (paredit-ignore-sexp-errors (indent-sexp)))))
888 (defun paredit-forward-for-quote (end)
889 (let ((state (paredit-current-parse-state)))
890 (while (< (point) end)
891 (let ((new-state (parse-partial-sexp (point) (1+ (point))
893 (if (paredit-in-string-p new-state)
894 (if (not (paredit-in-string-escape-p))
895 (setq state new-state)
896 ;; Escape character: turn it into an escaped escape
897 ;; character by appending another backslash.
899 ;; Now the point is after both escapes, and we want to
900 ;; rescan from before the first one to after the second
903 (parse-partial-sexp (- (point) 2) (point)
905 ;; Advance the end point, since we just inserted a new
908 ;; String: escape by inserting a backslash before the quote.
911 ;; The point is now between the escape and the quote, and we
912 ;; want to rescan from before the escape to after the quote.
914 (parse-partial-sexp (1- (point)) (1+ (point))
916 ;; Advance the end point for the same reason as above.
917 (setq end (1+ end)))))))
919 ;;;; Escape Insertion
921 (defun paredit-backslash ()
922 "Insert a backslash followed by a character to escape."
925 ;; This funny conditional is necessary because PAREDIT-IN-COMMENT-P
926 ;; assumes that PAREDIT-IN-STRING-P already returned false; otherwise
927 ;; it may give erroneous answers.
928 (if (or (paredit-in-string-p)
929 (not (paredit-in-comment-p)))
931 (unwind-protect (setq delp
932 (call-interactively 'paredit-escape))
933 ;; We need this in an UNWIND-PROTECT so that the backlash is
934 ;; left in there *only* if PAREDIT-ESCAPE return NIL normally
935 ;; -- in any other case, such as the user hitting C-g or an
936 ;; error occurring, we must delete the backslash to avoid
937 ;; leaving a dangling escape. (This control structure is a
939 (if delp (backward-delete-char 1))))))
941 ;;; This auxiliary interactive function returns true if the backslash
942 ;;; should be deleted and false if not.
944 (defun paredit-escape (char)
945 ;; I'm too lazy to figure out how to do this without a separate
946 ;; interactive function.
947 (interactive "cEscaping character...")
948 (if (eq char 127) ; The backslash was a typo, so
949 t ; the luser wants to delete it.
950 (insert char) ; (Is there a better way to
951 nil)) ; express the rubout char?
952 ; ?\^? works, but ugh...)
954 ;;; The placement of these functions in this file is totally random.
956 (defun paredit-newline ()
957 "Insert a newline and indent it.
958 This is like `newline-and-indent', but it not only indents the line
959 that the point is on but also the S-expression following the point,
961 Move forward one character first if on an escaped character.
962 If in a string, just insert a literal newline."
964 (if (paredit-in-string-p)
966 (if (and (not (paredit-in-comment-p)) (paredit-in-char-p))
969 ;; Indent the following S-expression, but don't signal an error if
970 ;; there's only a closing delimiter after the point.
971 (paredit-ignore-sexp-errors (indent-sexp))))
973 (defun paredit-reindent-defun (&optional argument)
974 "Reindent the definition that the point is on.
975 If the point is in a string or a comment, fill the paragraph instead,
976 and with a prefix argument, justify as well."
978 (if (or (paredit-in-string-p)
979 (paredit-in-comment-p))
980 (fill-paragraph argument)
985 ;;;; Comment Insertion
987 (defun paredit-comment-dwim (&optional argument)
988 "Call the Lisp comment command you want (Do What I Mean).
989 This is like `comment-dwim', but it is specialized for Lisp editing.
990 If transient mark mode is enabled and the mark is active, comment or
991 uncomment the selected region, depending on whether it was entirely
992 commented not not already.
993 If there is already a comment on the current line, with no prefix
994 argument, indent to that comment; with a prefix argument, kill that
996 Otherwise, insert a comment appropriate for the context and ensure that
997 any code following the comment is moved to the next line.
998 At the top level, where indentation is calculated to be at column 0,
999 insert a triple-semicolon comment; within code, where the indentation
1000 is calculated to be non-zero, and on the line there is either no code
1001 at all or code after the point, insert a double-semicolon comment;
1002 and if the point is after all code on the line, insert a single-
1003 semicolon margin comment at `comment-column'."
1005 (paredit-initialize-comment-dwim)
1006 (cond ((paredit-region-active-p)
1007 (comment-or-uncomment-region (region-beginning)
1010 ((paredit-comment-on-line-p)
1012 (comment-kill (if (integerp argument) argument nil))
1014 (t (paredit-insert-comment))))
1016 ;;; This is all a horrible, horrible hack, primarily for GNU Emacs 21,
1017 ;;; in which there is no `comment-or-uncomment-region'.
1019 (defun paredit-initialize-comment-dwim ()
1020 (require 'newcomment)
1021 (if (not (fboundp 'comment-or-uncomment-region))
1022 (defalias 'comment-or-uncomment-region
1023 (lambda (beginning end &optional argument)
1024 (interactive "*r\nP")
1025 (funcall (if (save-excursion (goto-char beginning)
1026 (comment-forward (point-max))
1030 beginning end argument))))
1031 (defalias 'paredit-initialize-comment-dwim 'comment-normalize-vars)
1032 (comment-normalize-vars))
1034 (defun paredit-comment-on-line-p ()
1037 (let ((comment-p nil))
1038 ;; Search forward for a comment beginning. If there is one, set
1039 ;; COMMENT-P to true; if not, it will be nil.
1040 (while (progn (setq comment-p
1041 (search-forward ";" (point-at-eol)
1045 (or (paredit-in-string-p)
1046 (paredit-in-char-p (1- (point))))))
1050 (defun paredit-insert-comment ()
1052 (save-excursion (paredit-skip-whitespace t (point-at-eol))
1055 (save-excursion (paredit-skip-whitespace nil (point-at-bol))
1058 ;; We have to use EQ 0 here and not ZEROP because ZEROP
1059 ;; signals an error if its argument is non-numeric, but
1060 ;; CALCULATE-LISP-INDENT may return nil.
1061 (eq (let ((indent (calculate-lisp-indent)))
1066 ;; Top-level comment
1067 (progn (if code-after-p (save-excursion (newline)))
1071 (progn (if code-before-p
1072 ;++ Why NEWLINE-AND-INDENT here and not just
1073 ;++ NEWLINE, or PAREDIT-NEWLINE?
1074 (newline-and-indent))
1077 ;; Move the following code. (NEWLINE-AND-INDENT will
1078 ;; delete whitespace after the comment, though, so use
1079 ;; NEWLINE & LISP-INDENT-LINE manually here.)
1080 (save-excursion (newline)
1081 (lisp-indent-line)))
1083 (progn (indent-to comment-column
1084 1) ; 1 -> force one leading space
1087 ;;;; Character Deletion
1089 (defun paredit-forward-delete (&optional argument)
1090 "Delete a character forward or move forward over a delimiter.
1091 If on an opening S-expression delimiter, move forward into the
1093 If on a closing S-expression delimiter, refuse to delete unless the
1094 S-expression is empty, in which case delete the whole S-expression.
1095 With a numeric prefix argument N, delete N characters forward.
1096 With a `C-u' prefix argument, simply delete a character forward,
1097 without regard for delimiter balancing."
1099 (cond ((or (consp argument) (eobp))
1101 ((integerp argument)
1103 (paredit-backward-delete argument)
1104 (while (> argument 0)
1105 (paredit-forward-delete)
1106 (setq argument (- argument 1)))))
1107 ((paredit-in-string-p)
1108 (paredit-forward-delete-in-string))
1109 ((paredit-in-comment-p)
1110 ;++ What to do here? This could move a partial S-expression
1111 ;++ into a comment and thereby invalidate the file's form,
1112 ;++ or move random text out of a comment.
1114 ((paredit-in-char-p) ; Escape -- delete both chars.
1115 (backward-delete-char 1)
1117 ((eq (char-after) ?\\ ) ; ditto
1119 ((let ((syn (char-syntax (char-after))))
1123 (paredit-handle-sexp-errors (progn (forward-sexp) t)
1126 (message "Deleting spurious opening delimiter.")
1128 ((and (not (paredit-in-char-p (1- (point))))
1129 (eq (char-syntax (char-after)) ?\) )
1130 (eq (char-before) (matching-paren (char-after))))
1131 (backward-delete-char 1) ; Empty list -- delete both
1132 (delete-char 1)) ; delimiters.
1133 ;; Just delete a single character, if it's not a closing
1134 ;; delimiter. (The character literal case is already handled
1136 ((not (eq (char-syntax (char-after)) ?\) ))
1139 (defun paredit-forward-delete-in-string ()
1140 (let ((start+end (paredit-string-start+end-points)))
1141 (cond ((not (eq (point) (cdr start+end)))
1142 ;; If it's not the close-quote, it's safe to delete. But
1143 ;; first handle the case that we're in a string escape.
1144 (cond ((paredit-in-string-escape-p)
1145 ;; We're right after the backslash, so backward
1146 ;; delete it before deleting the escaped character.
1147 (backward-delete-char 1))
1148 ((eq (char-after) ?\\ )
1149 ;; If we're not in a string escape, but we are on a
1150 ;; backslash, it must start the escape for the next
1151 ;; character, so delete the backslash before deleting
1152 ;; the next character.
1155 ((eq (1- (point)) (car start+end))
1156 ;; If it is the close-quote, delete only if we're also right
1157 ;; past the open-quote (i.e. it's empty), and then delete
1158 ;; both quotes. Otherwise we refuse to delete it.
1159 (backward-delete-char 1)
1162 (defun paredit-backward-delete (&optional argument)
1163 "Delete a character backward or move backward over a delimiter.
1164 If on a closing S-expression delimiter, move backward into the
1166 If on an opening S-expression delimiter, refuse to delete unless the
1167 S-expression is empty, in which case delete the whole S-expression.
1168 With a numeric prefix argument N, delete N characters backward.
1169 With a `C-u' prefix argument, simply delete a character backward,
1170 without regard for delimiter balancing."
1172 (cond ((or (consp argument) (bobp))
1173 ;++ Should this untabify?
1174 (backward-delete-char 1))
1175 ((integerp argument)
1177 (paredit-forward-delete (- 0 argument))
1178 (while (> argument 0)
1179 (paredit-backward-delete)
1180 (setq argument (- argument 1)))))
1181 ((paredit-in-string-p)
1182 (paredit-backward-delete-in-string))
1183 ((paredit-in-comment-p)
1184 (backward-delete-char 1))
1185 ((paredit-in-char-p) ; Escape -- delete both chars.
1186 (backward-delete-char 1)
1188 ((paredit-in-char-p (1- (point)))
1189 (backward-delete-char 2)) ; ditto
1190 ((let ((syn (char-syntax (char-before))))
1194 (paredit-handle-sexp-errors (progn (backward-sexp) t)
1197 (message "Deleting spurious closing delimiter.")
1198 (backward-delete-char 1)))
1199 ((and (eq (char-syntax (char-before)) ?\( )
1200 (eq (char-after) (matching-paren (char-before))))
1201 (backward-delete-char 1) ; Empty list -- delete both
1202 (delete-char 1)) ; delimiters.
1203 ;; Delete it, unless it's an opening delimiter. The case of
1204 ;; character literals is already handled by now.
1205 ((not (eq (char-syntax (char-before)) ?\( ))
1206 (backward-delete-char-untabify 1))))
1208 (defun paredit-backward-delete-in-string ()
1209 (let ((start+end (paredit-string-start+end-points)))
1210 (cond ((not (eq (1- (point)) (car start+end)))
1211 ;; If it's not the open-quote, it's safe to delete.
1212 (if (paredit-in-string-escape-p)
1213 ;; If we're on a string escape, since we're about to
1214 ;; delete the backslash, we must first delete the
1217 (backward-delete-char 1)
1218 (if (paredit-in-string-escape-p)
1219 ;; If, after deleting a character, we find ourselves in
1220 ;; a string escape, we must have deleted the escaped
1221 ;; character, and the backslash is behind the point, so
1222 ;; backward delete it.
1223 (backward-delete-char 1)))
1224 ((eq (point) (cdr start+end))
1225 ;; If it is the open-quote, delete only if we're also right
1226 ;; past the close-quote (i.e. it's empty), and then delete
1227 ;; both quotes. Otherwise we refuse to delete it.
1228 (backward-delete-char 1)
1233 (defun paredit-kill (&optional argument)
1234 "Kill a line as if with `kill-line', but respecting delimiters.
1235 In a string, act exactly as `kill-line' but do not kill past the
1236 closing string delimiter.
1237 On a line with no S-expressions on it starting after the point or
1238 within a comment, act exactly as `kill-line'.
1239 Otherwise, kill all S-expressions that start after the point.
1240 With a `C-u' prefix argument, just do the standard `kill-line'.
1241 With a numeric prefix argument N, do `kill-line' that many times."
1244 (kill-line (if (integerp argument) argument 1)))
1245 ((paredit-in-string-p)
1246 (paredit-kill-line-in-string))
1247 ((or (paredit-in-comment-p)
1249 (paredit-skip-whitespace t (point-at-eol))
1250 (or (eq (char-after) ?\; )
1252 ;** Be careful about trailing backslashes.
1254 (t (paredit-kill-sexps-on-line))))
1256 (defun paredit-kill-line-in-string ()
1257 (if (save-excursion (paredit-skip-whitespace t (point-at-eol))
1261 ;; Be careful not to split an escape sequence.
1262 (if (paredit-in-string-escape-p)
1264 (let ((beginning (point)))
1265 (while (not (or (eolp)
1266 (eq (char-after) ?\" )))
1268 ;; Skip past escaped characters.
1269 (if (eq (char-before) ?\\ )
1271 (kill-region beginning (point))))))
1273 (defun paredit-kill-sexps-on-line ()
1274 (if (paredit-in-char-p) ; Move past the \ and prefix.
1275 (backward-char 2)) ; (# in Scheme/CL, ? in elisp)
1276 (let ((beginning (point))
1277 (eol (point-at-eol)))
1278 (let ((end-of-list-p (paredit-forward-sexps-to-kill beginning eol)))
1279 ;; If we got to the end of the list and it's on the same line,
1280 ;; move backward past the closing delimiter before killing. (This
1281 ;; allows something like killing the whitespace in ( ).)
1282 (if end-of-list-p (progn (up-list) (backward-char)))
1284 (paredit-kill-sexps-on-whole-line beginning)
1285 (kill-region beginning
1286 ;; If all of the S-expressions were on one line,
1287 ;; i.e. we're still on that line after moving past
1288 ;; the last one, kill the whole line, including
1289 ;; any comments; otherwise just kill to the end of
1290 ;; the last S-expression we found. Be sure,
1291 ;; though, not to kill any closing parentheses.
1292 (if (and (not end-of-list-p)
1293 (eq (point-at-eol) eol))
1297 ;;; Please do not try to understand this code unless you have a VERY
1298 ;;; good reason to do so. I gave up trying to figure it out well
1299 ;;; enough to explain it, long ago.
1301 (defun paredit-forward-sexps-to-kill (beginning eol)
1302 (let ((end-of-list-p nil)
1304 ;; Move to the end of the last S-expression that started on this
1305 ;; line, or to the closing delimiter if the last S-expression in
1306 ;; this list is on the line.
1309 ;; This and the `kill-whole-line' business below fix a bug that
1310 ;; inhibited any S-expression at the very end of the buffer
1311 ;; (with no trailing newline) from being deleted. It's a
1312 ;; bizarre fix that I ought to document at some point, but I am
1313 ;; too busy at the moment to do so.
1314 (if (and kill-whole-line (eobp)) (throw 'return nil))
1316 (paredit-handle-sexp-errors (forward-sexp)
1318 (setq end-of-list-p (eq (point-at-eol) eol))
1319 (throw 'return nil))
1320 (if (or (and (not firstp)
1321 (not kill-whole-line)
1323 (paredit-handle-sexp-errors
1324 (progn (backward-sexp) nil)
1326 (not (eq (point-at-eol) eol)))
1327 (throw 'return nil)))
1330 (not kill-whole-line)
1332 (throw 'return nil))
1336 (defun paredit-kill-sexps-on-whole-line (beginning)
1337 (kill-region beginning
1338 (or (save-excursion ; Delete trailing indentation...
1339 (paredit-skip-whitespace t)
1340 (and (not (eq (char-after) ?\; ))
1342 ;; ...or just use the point past the newline, if
1343 ;; we encounter a comment.
1345 (cond ((save-excursion (paredit-skip-whitespace nil (point-at-bol))
1347 ;; Nothing but indentation before the point, so indent it.
1349 ((eobp) nil) ; Protect the CHAR-SYNTAX below against NIL.
1350 ;; Insert a space to avoid invalid joining if necessary.
1351 ((let ((syn-before (char-syntax (char-before)))
1352 (syn-after (char-syntax (char-after))))
1353 (or (and (eq syn-before ?\) ) ; Separate opposing
1354 (eq syn-after ?\( )) ; parentheses,
1355 (and (eq syn-before ?\" ) ; string delimiter
1356 (eq syn-after ?\" )) ; pairs,
1357 (and (memq syn-before '(?_ ?w)) ; or word or symbol
1358 (memq syn-after '(?_ ?w))))) ; constituents.
1363 ;;; This is tricky and asymmetrical because backward parsing is
1364 ;;; extraordinarily difficult or impossible, so we have to implement
1365 ;;; killing in both directions by parsing forward.
1367 (defun paredit-forward-kill-word ()
1368 "Kill a word forward, skipping over intervening delimiters."
1370 (let ((beginning (point)))
1371 (skip-syntax-forward " -")
1372 (let* ((parse-state (paredit-current-parse-state))
1373 (state (paredit-kill-word-state parse-state 'char-after)))
1374 (while (not (or (eobp)
1375 (eq ?w (char-syntax (char-after)))))
1377 (progn (forward-char 1) (paredit-current-parse-state))
1378 ;; (parse-partial-sexp (point) (1+ (point))
1379 ;; nil nil parse-state)
1381 (let* ((old-state state)
1383 (paredit-kill-word-state parse-state 'char-after)))
1384 (cond ((not (eq old-state new-state))
1386 (paredit-kill-word-hack old-state
1390 (paredit-kill-word-state parse-state
1392 (setq beginning (point)))))))
1393 (goto-char beginning)
1396 (defun paredit-backward-kill-word ()
1397 "Kill a word backward, skipping over any intervening delimiters."
1400 (eq (char-syntax (char-before)) ?w)))
1401 (let ((end (point)))
1404 (goto-char (min end (point)))
1405 (let* ((parse-state (paredit-current-parse-state))
1407 (paredit-kill-word-state parse-state 'char-before)))
1408 (while (and (< (point) end)
1411 (parse-partial-sexp (point) (1+ (point))
1412 nil nil parse-state))
1414 (paredit-kill-word-state parse-state
1416 (progn (backward-char 1) nil)))))
1417 (if (and (eq state 'comment)
1418 (eq ?\# (char-after (point)))
1419 (eq ?\| (char-before (point))))
1420 (backward-char 1)))))
1421 (backward-kill-word 1))
1423 ;;;;;; Word-Killing Auxiliaries
1425 (defun paredit-kill-word-state (parse-state adjacent-char-fn)
1426 (cond ((paredit-in-comment-p parse-state) 'comment)
1427 ((paredit-in-string-p parse-state) 'string)
1428 ((memq (char-syntax (funcall adjacent-char-fn))
1433 ;;; This optionally advances the point past any comment delimiters that
1434 ;;; should probably not be touched, based on the last state change and
1435 ;;; the characters around the point. It returns a new parse state,
1436 ;;; starting from the PARSE-STATE parameter.
1438 (defun paredit-kill-word-hack (old-state new-state parse-state)
1439 (cond ((and (not (eq old-state 'comment))
1440 (not (eq new-state 'comment))
1441 (not (paredit-in-string-escape-p))
1442 (eq ?\# (char-before))
1443 (eq ?\| (char-after)))
1445 (paredit-current-parse-state)
1446 ;; (parse-partial-sexp (point) (1+ (point))
1447 ;; nil nil parse-state)
1449 ((and (not (eq old-state 'comment))
1450 (eq new-state 'comment)
1451 (eq ?\; (char-before)))
1452 (skip-chars-forward ";")
1453 (paredit-current-parse-state)
1454 ;; (parse-partial-sexp (point) (save-excursion
1455 ;; (skip-chars-forward ";"))
1456 ;; nil nil parse-state)
1460 ;;;; Cursor and Screen Movement
1463 (defmacro defun-saving-mark (name bvl doc &rest body)
1466 ,(xcond ((paredit-xemacs-p)
1468 ((paredit-gnu-emacs-p)
1472 (defun-saving-mark paredit-forward ()
1473 "Move forward an S-expression, or up an S-expression forward.
1474 If there are no more S-expressions in this one before the closing
1475 delimiter, move past that closing delimiter; otherwise, move forward
1476 past the S-expression following the point."
1477 (paredit-handle-sexp-errors
1479 ;++ Is it necessary to use UP-LIST and not just FORWARD-CHAR?
1480 (if (paredit-in-string-p) (forward-char) (up-list))))
1482 (defun-saving-mark paredit-backward ()
1483 "Move backward an S-expression, or up an S-expression backward.
1484 If there are no more S-expressions in this one before the opening
1485 delimiter, move past that opening delimiter backward; otherwise, move
1486 move backward past the S-expression preceding the point."
1487 (paredit-handle-sexp-errors
1489 (if (paredit-in-string-p) (backward-char) (backward-up-list))))
1491 ;;; Why is this not in lisp.el?
1493 (defun backward-down-list (&optional arg)
1494 "Move backward and descend into one level of parentheses.
1495 With ARG, do this that many times.
1496 A negative argument means move forward but still descend a level."
1498 (down-list (- (or arg 1))))
1500 ;;; Thanks to Marco Baringer for suggesting & writing this function.
1502 (defun paredit-recentre-on-sexp (&optional n)
1503 "Recentre the screen on the S-expression following the point.
1504 With a prefix argument N, encompass all N S-expressions forward."
1508 (let ((end-point (point)))
1510 (let* ((start-point (point))
1511 (start-line (count-lines (point-min) (point)))
1512 (lines-on-sexps (count-lines start-point end-point)))
1513 (goto-line (+ start-line (/ lines-on-sexps 2)))
1516 (defun paredit-focus-on-defun ()
1517 "Moves display to the top of the definition at point."
1519 (beginning-of-defun)
1522 ;;;; Depth-Changing Commands: Wrapping, Splicing, & Raising
1524 (defun paredit-wrap-sexp (&optional argument open close)
1525 "Wrap the following S-expression.
1526 If a `C-u' prefix argument is given, wrap all S-expressions following
1527 the point until the end of the buffer or of the enclosing list.
1528 If a numeric prefix argument N is given, wrap N S-expressions.
1529 Automatically indent the newly wrapped S-expression.
1530 As a special case, if the point is at the end of a list, simply insert
1531 a parenthesis pair, rather than inserting a lone opening delimiter
1532 and then signalling an error, in the interest of preserving
1534 By default OPEN and CLOSE are round delimiters."
1536 (paredit-lose-if-not-in-sexp 'paredit-wrap-sexp)
1537 (let ((open (or open ?\( ))
1538 (close (or close ?\) )))
1539 (paredit-handle-sexp-errors
1540 ((lambda (n) (paredit-insert-pair n open close 'goto-char))
1541 (cond ((integerp argument) argument)
1542 ((consp argument) (paredit-count-sexps-forward))
1543 ((paredit-region-active-p) nil)
1547 (save-excursion (backward-up-list) (indent-sexp)))
1549 (defun paredit-count-sexps-forward ()
1552 (paredit-ignore-sexp-errors
1558 (defun paredit-yank-pop (&optional argument)
1559 "Replace just-yanked text with the next item in the kill ring.
1560 If this command follows a `yank', just run `yank-pop'.
1561 If this command follows a `paredit-wrap-sexp', or any other paredit
1562 wrapping command (see `paredit-wrap-commands'), run `yank' and
1563 reindent the enclosing S-expression.
1564 If this command is repeated, run `yank-pop' and reindent the enclosing
1567 The argument is passed on to `yank' or `yank-pop'; see their
1568 documentation for details."
1570 (cond ((eq last-command 'yank)
1571 (yank-pop argument))
1572 ((memq last-command paredit-wrap-commands)
1574 ;; `yank' futzes with `this-command'.
1575 (setq this-command 'paredit-yank-pop)
1576 (save-excursion (backward-up-list) (indent-sexp)))
1577 ((eq last-command 'paredit-yank-pop)
1578 ;; Pretend we just did a `yank', so that we can use
1579 ;; `yank-pop' without duplicating its definition.
1580 (setq last-command 'yank)
1582 ;; Return to our original state.
1583 (setq last-command 'paredit-yank-pop)
1584 (setq this-command 'paredit-yank-pop)
1585 (save-excursion (backward-up-list) (indent-sexp)))
1586 (t (error "Last command was not a yank or a wrap: %s" last-command))))
1588 ;;; Thanks to Marco Baringer for the suggestion of a prefix argument
1589 ;;; for PAREDIT-SPLICE-SEXP. (I, Taylor R. Campbell, however, still
1590 ;;; implemented it, in case any of you lawyer-folk get confused by the
1591 ;;; remark in the top of the file about explicitly noting code written
1592 ;;; by other people.)
1594 (defun paredit-splice-sexp (&optional argument)
1595 "Splice the list that the point is on by removing its delimiters.
1596 With a prefix argument as in `C-u', kill all S-expressions backward in
1597 the current list before splicing all S-expressions forward into the
1599 With two prefix arguments as in `C-u C-u', kill all S-expressions
1600 forward in the current list before splicing all S-expressions
1601 backward into the enclosing list.
1602 With a numerical prefix argument N, kill N S-expressions backward in
1603 the current list before splicing the remaining S-expressions into the
1604 enclosing list. If N is negative, kill forward.
1605 Inside a string, unescape all backslashes, or signal an error if doing
1606 so would invalidate the buffer's structure."
1608 (if (paredit-in-string-p)
1609 (paredit-splice-string argument)
1611 (paredit-kill-surrounding-sexps-for-splice argument)
1612 (backward-up-list) ; Go up to the beginning...
1614 (forward-sexp) ; Go forward an expression, to
1615 (backward-delete-char 1)) ; delete the end delimiter.
1616 (delete-char 1) ; ...to delete the open char.
1617 (paredit-ignore-sexp-errors
1618 (backward-up-list) ; Reindent, now that the
1619 (indent-sexp))))) ; structure has changed.
1621 (defun paredit-kill-surrounding-sexps-for-splice (argument)
1622 (cond ((or (paredit-in-string-p)
1623 (paredit-in-comment-p))
1624 (error "Invalid context for splicing S-expressions."))
1625 ((or (not argument) (eq argument 0)) nil)
1626 ((or (numberp argument) (eq argument '-))
1627 ;; Kill S-expressions before/after the point by saving the
1628 ;; point, moving across them, and killing the region.
1629 (let* ((argument (if (eq argument '-) -1 argument))
1630 (saved (paredit-point-at-sexp-boundary (- argument))))
1632 (paredit-ignore-sexp-errors (backward-sexp argument))
1633 (paredit-hack-kill-region saved (point))))
1635 (let ((v (car argument)))
1636 (if (= v 4) ;One `C-u'.
1637 ;; Move backward until we hit the open paren; then
1638 ;; kill that selected region.
1639 (let ((end (point)))
1640 (paredit-ignore-sexp-errors
1643 (paredit-hack-kill-region (point) end))
1644 ;; Move forward until we hit the close paren; then
1645 ;; kill that selected region.
1646 (let ((beginning (point)))
1647 (paredit-ignore-sexp-errors
1650 (paredit-hack-kill-region beginning (point))))))
1651 (t (error "Bizarre prefix argument `%s'." argument))))
1653 (defun paredit-splice-sexp-killing-backward (&optional n)
1654 "Splice the list the point is on by removing its delimiters, and
1655 also kill all S-expressions before the point in the current list.
1656 With a prefix argument N, kill only the preceding N S-expressions."
1658 (paredit-splice-sexp (if n
1659 (prefix-numeric-value n)
1662 (defun paredit-splice-sexp-killing-forward (&optional n)
1663 "Splice the list the point is on by removing its delimiters, and
1664 also kill all S-expressions after the point in the current list.
1665 With a prefix argument N, kill only the following N S-expressions."
1667 (paredit-splice-sexp (if n
1668 (- (prefix-numeric-value n))
1671 (defun paredit-raise-sexp (&optional n)
1672 "Raise the following S-expression in a tree, deleting its siblings.
1673 With a prefix argument N, raise the following N S-expressions. If N
1674 is negative, raise the preceding N S-expressions."
1676 (paredit-lose-if-not-in-sexp 'paredit-raise-sexp)
1677 ;; Select the S-expressions we want to raise in a buffer substring.
1678 (let* ((bound (save-excursion (forward-sexp n) (point)))
1679 (sexps (if (and n (< n 0))
1680 (buffer-substring bound
1681 (paredit-point-at-sexp-end))
1682 (buffer-substring (paredit-point-at-sexp-start)
1684 ;; Move up to the list we're raising those S-expressions out of and
1687 (delete-region (point) (save-excursion (forward-sexp) (point)))
1688 (save-excursion (insert sexps)) ; Insert & reindent the sexps.
1689 (save-excursion (let ((n (abs (or n 1))))
1691 (paredit-forward-and-indent)
1692 (setq n (1- n)))))))
1694 (defun paredit-convolute-sexp (&optional n)
1695 "Convolute S-expressions.
1696 Save the S-expressions preceding point and delete them.
1697 Splice the S-expressions following point.
1698 Wrap the enclosing list in a new list prefixed by the saved text.
1699 With a prefix argument N, move up N lists before wrapping."
1701 (paredit-lose-if-not-in-sexp 'paredit-convolute-sexp)
1702 (let (open close) ;++ Is this a good idea?
1704 (let ((end (point)))
1705 (paredit-ignore-sexp-errors
1706 (while (not (bobp)) (backward-sexp)))
1707 (prog1 (buffer-substring (point) end)
1709 (save-excursion (forward-sexp)
1710 (setq close (char-before))
1711 (backward-delete-char 1))
1712 (setq open (char-after))
1713 (delete-region (point) end)))))
1714 (backward-up-list n)
1715 (paredit-insert-pair 1 open close 'goto-char)
1718 (paredit-ignore-sexp-errors (indent-sexp)))))
1720 (defun paredit-splice-string (argument)
1721 (let ((original-point (point))
1722 (start+end (paredit-string-start+end-points)))
1723 (let ((start (car start+end))
1724 (end (cdr start+end)))
1725 ;; START and END both lie before the respective quote
1726 ;; characters, which we want to delete; thus we increment START
1727 ;; by one to extract the string, and we increment END by one to
1728 ;; delete the string.
1729 (let* ((escaped-string
1730 (cond ((not (consp argument))
1731 (buffer-substring (1+ start) end))
1732 ((= 4 (car argument))
1733 (buffer-substring original-point end))
1735 (buffer-substring (1+ start) original-point))))
1737 (paredit-unescape-string escaped-string)))
1738 (if (not unescaped-string)
1739 (error "Unspliceable string.")
1742 (delete-region start (1+ end))
1743 (insert unescaped-string))
1744 (if (not (and (consp argument)
1745 (= 4 (car argument))))
1746 (goto-char (- original-point 1))))))))
1748 (defun paredit-unescape-string (string)
1751 (goto-char (point-min))
1752 (while (and (not (eobp))
1753 ;; nil -> no bound; t -> no errors.
1754 (search-forward "\\" nil t))
1757 (condition-case condition
1758 (progn (check-parens) (buffer-string))
1761 ;;;; Slurpage & Barfage
1763 (defun paredit-forward-slurp-sexp ()
1764 "Add the S-expression following the current list into that list
1765 by moving the closing delimiter.
1766 Automatically reindent the newly slurped S-expression with respect to
1767 its new enclosing form.
1768 If in a string, move the opening double-quote forward by one
1769 S-expression and escape any intervening characters as necessary,
1770 without altering any indentation or formatting."
1773 (cond ((or (paredit-in-comment-p)
1774 (paredit-in-char-p))
1775 (error "Invalid context for slurping S-expressions."))
1776 ((paredit-in-string-p)
1777 (paredit-forward-slurp-into-string))
1779 (paredit-forward-slurp-into-list)))))
1781 (defun paredit-forward-slurp-into-list ()
1782 (up-list) ; Up to the end of the list to
1783 (let ((close (char-before))) ; save and delete the closing
1784 (backward-delete-char 1) ; delimiter.
1785 (catch 'return ; Go to the end of the desired
1786 (while t ; S-expression, going up a
1787 (paredit-handle-sexp-errors ; list if it's not in this,
1788 (progn (paredit-forward-and-indent)
1789 (throw 'return nil))
1791 (setq close ; adjusting for mixed
1792 (prog1 (char-before) ; delimiters as necessary,
1793 (backward-delete-char 1)
1795 (insert close))) ; to insert that delimiter.
1797 (defun paredit-forward-slurp-into-string ()
1798 (goto-char (1+ (cdr (paredit-string-start+end-points))))
1799 ;; Signal any errors that we might get first, before mucking with the
1800 ;; buffer's contents.
1801 (save-excursion (forward-sexp))
1802 (let ((close (char-before)))
1803 (backward-delete-char 1)
1804 (paredit-forward-for-quote (save-excursion (forward-sexp) (point)))
1807 (defun paredit-forward-barf-sexp ()
1808 "Remove the last S-expression in the current list from that list
1809 by moving the closing delimiter.
1810 Automatically reindent the newly barfed S-expression with respect to
1811 its new enclosing form."
1813 (paredit-lose-if-not-in-sexp 'paredit-forward-slurp-sexp)
1815 (up-list) ; Up to the end of the list to
1816 (let ((close (char-before))) ; save and delete the closing
1817 (backward-delete-char 1) ; delimiter.
1818 (paredit-ignore-sexp-errors ; Go back to where we want to
1819 (backward-sexp)) ; insert the delimiter.
1820 (paredit-skip-whitespace nil) ; Skip leading whitespace.
1822 (error "Barfing all subexpressions with no open-paren?"))
1823 ((paredit-in-comment-p) ; Don't put the close-paren in
1824 (newline-and-indent))) ; a comment.
1826 ;; Reindent all of the newly barfed S-expressions.
1827 (paredit-forward-and-indent)))
1829 (defun paredit-backward-slurp-sexp ()
1830 "Add the S-expression preceding the current list into that list
1831 by moving the closing delimiter.
1832 Automatically reindent the whole form into which new S-expression was
1834 If in a string, move the opening double-quote backward by one
1835 S-expression and escape any intervening characters as necessary,
1836 without altering any indentation or formatting."
1839 (cond ((or (paredit-in-comment-p)
1840 (paredit-in-char-p))
1841 (error "Invalid context for slurping S-expressions."))
1842 ((paredit-in-string-p)
1843 (paredit-backward-slurp-into-string))
1845 (paredit-backward-slurp-into-list)))))
1847 (defun paredit-backward-slurp-into-list ()
1849 (let ((open (char-after)))
1853 (paredit-handle-sexp-errors
1854 (progn (backward-sexp) (throw 'return nil))
1858 (save-excursion (insert open) (delete-char 1)))))))
1860 ;; Reindent the line at the beginning of wherever we inserted the
1861 ;; opening delimiter, and then indent the whole S-expression.
1866 (defun paredit-backward-slurp-into-string ()
1867 (goto-char (car (paredit-string-start+end-points)))
1868 ;; Signal any errors that we might get first, before mucking with the
1869 ;; buffer's contents.
1870 (save-excursion (backward-sexp))
1871 (let ((open (char-after))
1873 (message "open = %S" open)
1877 (paredit-forward-for-quote target)))
1879 (defun paredit-backward-barf-sexp ()
1880 "Remove the first S-expression in the current list from that list
1881 by moving the closing delimiter.
1882 Automatically reindent the barfed S-expression and the form from which
1885 (paredit-lose-if-not-in-sexp 'paredit-forward-slurp-sexp)
1888 (let ((open (char-after)))
1890 (paredit-ignore-sexp-errors
1891 (paredit-forward-and-indent))
1892 (while (progn (paredit-skip-whitespace t)
1893 (eq (char-after) ?\; ))
1896 (error "Barfing all subexpressions with no close-paren?"))
1897 ;** Don't use `insert' here. Consider, e.g., barfing from
1899 ;** and how `save-excursion' works.
1900 (insert-before-markers open))
1905 ;;;; Splitting & Joining
1907 (defun paredit-split-sexp ()
1908 "Split the list or string the point is on into two."
1910 (cond ((paredit-in-string-p)
1912 (save-excursion (insert " \"")))
1913 ((or (paredit-in-comment-p)
1914 (paredit-in-char-p))
1915 (error "Invalid context for splitting S-expression."))
1916 (t (let ((open (save-excursion (backward-up-list)
1918 (close (save-excursion (up-list)
1920 (delete-horizontal-space)
1922 (save-excursion (insert ?\ )
1927 (defun paredit-join-sexps ()
1928 "Join the S-expressions adjacent on either side of the point.
1929 Both must be lists, strings, or atoms; error if there is a mismatch."
1931 ;++ How ought this to handle comments intervening symbols or strings?
1933 (if (or (paredit-in-comment-p)
1934 (paredit-in-string-p)
1935 (paredit-in-char-p))
1936 (error "Invalid context for joining S-expressions.")
1937 (let ((left-point (paredit-point-at-sexp-end))
1938 (right-point (paredit-point-at-sexp-start)))
1939 (let ((left-char (char-before left-point))
1940 (right-char (char-after right-point)))
1941 (let ((left-syntax (char-syntax left-char))
1942 (right-syntax (char-syntax right-char)))
1943 (cond ((>= left-point right-point)
1944 (error "Can't join a datum with itself."))
1945 ((and (eq left-syntax ?\) )
1946 (eq right-syntax ?\( )
1947 (eq left-char (matching-paren right-char))
1948 (eq right-char (matching-paren left-char)))
1949 ;; Leave intermediate formatting alone.
1950 (goto-char right-point)
1952 (goto-char left-point)
1953 (backward-delete-char 1)
1956 ((and (eq left-syntax ?\" )
1957 (eq right-syntax ?\" ))
1958 ;; Delete any intermediate formatting.
1959 (delete-region (1- left-point)
1961 ((and (memq left-syntax '(?w ?_)) ; Word or symbol
1962 (memq right-syntax '(?w ?_)))
1963 (delete-region left-point right-point))
1965 (error "Mismatched S-expressions to join.")))))))))
1967 ;;;; Variations on the Lurid Theme
1969 ;;; I haven't the imagination to concoct clever names for these.
1971 (defun paredit-add-to-previous-list ()
1972 "Add the S-expression following point to the list preceding point."
1974 (paredit-lose-if-not-in-sexp 'paredit-add-to-previous-list)
1976 (backward-down-list)
1977 (paredit-forward-slurp-sexp)))
1979 (defun paredit-add-to-next-list ()
1980 "Add the S-expression preceding point to the list following point.
1981 If no S-expression precedes point, move up the tree until one does."
1983 (paredit-lose-if-not-in-sexp 'paredit-add-to-next-list)
1986 (paredit-backward-slurp-sexp)))
1988 (defun paredit-join-with-previous-list ()
1989 "Join the list the point is on with the previous list in the buffer."
1991 (paredit-lose-if-not-in-sexp 'paredit-join-with-previous-list)
1993 (while (paredit-handle-sexp-errors (save-excursion (backward-sexp) nil)
1996 (paredit-join-sexps)))
1998 (defun paredit-join-with-next-list ()
1999 "Join the list the point is on with the next list in the buffer."
2001 (paredit-lose-if-not-in-sexp 'paredit-join-with-next-list)
2003 (while (paredit-handle-sexp-errors (save-excursion (forward-sexp) nil)
2006 (paredit-join-sexps)))
2010 (defun paredit-in-string-escape-p ()
2011 "True if the point is on a character escape of a string.
2012 This is true only if the character is preceded by an odd number of
2014 This assumes that `paredit-in-string-p' has already returned true."
2017 (while (eq (char-before) ?\\ )
2018 (setq oddp (not oddp))
2022 (defun paredit-in-char-p (&optional argument)
2023 "True if the point is immediately after a character literal.
2024 A preceding escape character, not preceded by another escape character,
2025 is considered a character literal prefix. (This works for elisp,
2026 Common Lisp, and Scheme.)
2027 Assumes that `paredit-in-string-p' is false, so that it need not handle
2028 long sequences of preceding backslashes in string escapes. (This
2029 assumes some other leading character token -- ? in elisp, # in Scheme
2031 (let ((argument (or argument (point))))
2032 (and (eq (char-before argument) ?\\ )
2033 (not (eq (char-before (1- argument)) ?\\ )))))
2035 (defun paredit-forward-and-indent ()
2036 "Move forward an S-expression, indenting it fully.
2037 Indent with `lisp-indent-line' and then `indent-sexp'."
2038 (forward-sexp) ; Go forward, and then find the
2039 (save-excursion ; beginning of this next
2040 (backward-sexp) ; S-expression.
2041 (lisp-indent-line) ; Indent its opening line, and
2042 (indent-sexp))) ; the rest of it.
2044 (defun paredit-skip-whitespace (trailing-p &optional limit)
2045 "Skip past any whitespace, or until the point LIMIT is reached.
2046 If TRAILING-P is nil, skip leading whitespace; otherwise, skip trailing
2048 (funcall (if trailing-p 'skip-chars-forward 'skip-chars-backward)
2049 " \t\n
\f" ; This should skip using the syntax table, but LF
2050 limit)) ; is a comment end, not newline, in Lisp mode.
2052 (defalias 'paredit-region-active-p
2053 (xcond ((paredit-xemacs-p) 'region-active-p)
2054 ((paredit-gnu-emacs-p)
2056 (and mark-active transient-mark-mode)))))
2058 (defun paredit-hack-kill-region (start end)
2059 "Kill the region between START and END.
2060 Do not append to any current kill, and
2061 do not let the next kill append to this one."
2062 (interactive "r") ;Eh, why not?
2063 ;; KILL-REGION sets THIS-COMMAND to tell the next kill that the last
2064 ;; command was a kill. It also checks LAST-COMMAND to see whether it
2065 ;; should append. If we bind these locally, any modifications to
2066 ;; THIS-COMMAND will be masked, and it will not see LAST-COMMAND to
2067 ;; indicate that it should append.
2068 (let ((this-command nil)
2070 (kill-region start end)))
2072 ;;;;; S-expression Parsing Utilities
2074 ;++ These routines redundantly traverse S-expressions a great deal.
2075 ;++ If performance issues arise, this whole section will probably have
2076 ;++ to be refactored to preserve the state longer, like paredit.scm
2077 ;++ does, rather than to traverse the definition N times for every key
2078 ;++ stroke as it presently does.
2080 (defun paredit-current-parse-state ()
2081 "Return parse state of point from beginning of defun."
2082 (let ((point (point)))
2083 (beginning-of-defun)
2084 ;; Calling PARSE-PARTIAL-SEXP will advance the point to its second
2085 ;; argument (unless parsing stops due to an error, but we assume it
2086 ;; won't in paredit-mode).
2087 (parse-partial-sexp (point) point)))
2089 (defun paredit-in-string-p (&optional state)
2090 "True if the parse state is within a double-quote-delimited string.
2091 If no parse state is supplied, compute one from the beginning of the
2092 defun to the point."
2093 ;; 3. non-nil if inside a string (the terminator character, really)
2094 (and (nth 3 (or state (paredit-current-parse-state)))
2097 (defun paredit-string-start+end-points (&optional state)
2098 "Return a cons of the points of open and close quotes of the string.
2099 The string is determined from the parse state STATE, or the parse state
2100 from the beginning of the defun to the point.
2101 This assumes that `paredit-in-string-p' has already returned true, i.e.
2102 that the point is already within a string."
2104 ;; 8. character address of start of comment or string; nil if not
2106 (let ((start (nth 8 (or state (paredit-current-parse-state)))))
2109 (cons start (1- (point))))))
2111 (defun paredit-in-comment-p (&optional state)
2112 "True if parse state STATE is within a comment.
2113 If no parse state is supplied, compute one from the beginning of the
2114 defun to the point."
2115 ;; 4. nil if outside a comment, t if inside a non-nestable comment,
2116 ;; else an integer (the current comment nesting)
2117 (and (nth 4 (or state (paredit-current-parse-state)))
2120 (defun paredit-point-at-sexp-boundary (n)
2121 (cond ((< n 0) (paredit-point-at-sexp-start))
2123 ((> n 0) (paredit-point-at-sexp-end))))
2125 (defun paredit-point-at-sexp-start ()
2131 (defun paredit-point-at-sexp-end ()
2137 (defun paredit-lose-if-not-in-sexp (command)
2138 (if (or (paredit-in-string-p)
2139 (paredit-in-comment-p)
2140 (paredit-in-char-p))
2141 (error "Invalid context for command `%s'." command)))
2145 (paredit-define-keys)
2146 (paredit-annotate-mode-with-examples)
2147 (paredit-annotate-functions-with-examples)