diff options
Diffstat (limited to 'configs/shared/emacs/.emacs.d/elpa/paredit-20171127.205/paredit.el')
| -rw-r--r-- | configs/shared/emacs/.emacs.d/elpa/paredit-20171127.205/paredit.el | 2929 |
1 files changed, 2929 insertions, 0 deletions
diff --git a/configs/shared/emacs/.emacs.d/elpa/paredit-20171127.205/paredit.el b/configs/shared/emacs/.emacs.d/elpa/paredit-20171127.205/paredit.el new file mode 100644 index 000000000000..b806866608c6 --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/paredit-20171127.205/paredit.el @@ -0,0 +1,2929 @@ +;;; paredit.el --- minor mode for editing parentheses -*- Mode: Emacs-Lisp -*- + +;; Copyright (C) 2005--2017 Taylor R. Campbell + +;; Author: Taylor R. Campbell <campbell+paredit@mumble.net> +;; Version: 25beta +;; Package-Version: 20171127.205 +;; Created: 2005-07-31 +;; Keywords: lisp + +;; NOTE: THIS IS A BETA VERSION OF PAREDIT. USE AT YOUR OWN RISK. +;; THIS FILE IS SUBJECT TO CHANGE, AND NOT SUITABLE FOR DISTRIBUTION +;; BY PACKAGE MANAGERS SUCH AS APT, PKGSRC, MACPORTS, &C. + +;; Paredit is free software: you can redistribute it and/or modify it +;; under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. +;; +;; Paredit is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with paredit. If not, see <http://www.gnu.org/licenses/>. + +;;; The currently released version of paredit is available at +;;; <https://mumble.net/~campbell/emacs/paredit.el>. +;;; +;;; The latest beta version of paredit is available at +;;; <https://mumble.net/~campbell/emacs/paredit-beta.el>. +;;; +;;; The Git repository for paredit is available at +;;; <https://mumble.net/~campbell/git/paredit.git> +;;; +;;; Release notes are available at +;;; <https://mumble.net/~campbell/emacs/paredit.release>. + +;;; Install paredit by placing `paredit.el' in `/path/to/elisp', a +;;; directory of your choice, and adding to your .emacs file: +;;; +;;; (add-to-list 'load-path "/path/to/elisp") +;;; (autoload 'enable-paredit-mode "paredit" +;;; "Turn on pseudo-structural editing of Lisp code." +;;; t) +;;; +;;; Start Paredit Mode on the fly with `M-x enable-paredit-mode RET', +;;; or always enable it in a major mode `M' (e.g., `lisp') with: +;;; +;;; (add-hook 'M-mode-hook 'enable-paredit-mode) +;;; +;;; Customize paredit using `eval-after-load': +;;; +;;; (eval-after-load 'paredit +;;; '(progn +;;; (define-key paredit-mode-map (kbd "ESC M-A-C-s-)") +;;; 'paredit-dwim))) +;;; +;;; Send questions, bug reports, comments, feature suggestions, &c., +;;; via email to the author's surname at mumble.net. +;;; +;;; Paredit should run in GNU Emacs 21 or later and XEmacs 21.5.28 or +;;; later. + +;;; The paredit minor mode, Paredit Mode, binds common character keys, +;;; such as `(', `)', `"', and `\', to commands that carefully insert +;;; S-expression structures in the buffer: +;;; +;;; ( inserts `()', leaving the point in the middle; +;;; ) moves the point over the next closing delimiter; +;;; " inserts `""' if outside a string, or inserts an escaped +;;; double-quote if in the middle of a string, or moves over the +;;; closing double-quote if at the end of a string; and +;;; \ prompts for the character to escape, to avoid inserting lone +;;; backslashes that may break structure. +;;; +;;; In comments, these keys insert themselves. If necessary, you can +;;; insert these characters literally outside comments by pressing +;;; `C-q' before these keys, in case a mistake has broken the +;;; structure. +;;; +;;; These key bindings are designed so that when typing new code in +;;; Paredit Mode, you can generally type exactly the same sequence of +;;; keys you would have typed without Paredit Mode. +;;; +;;; Paredit Mode also binds common editing keys, such as `DEL', `C-d', +;;; and `C-k', to commands that respect S-expression structures in the +;;; buffer: +;;; +;;; DEL deletes the previous character, unless it is a delimiter: DEL +;;; will move the point backward over a closing delimiter, and +;;; will delete a delimiter pair together if between an open and +;;; closing delimiter; +;;; +;;; C-d deletes the next character in much the same manner; and +;;; +;;; C-k kills all S-expressions that begin anywhere between the point +;;; and the end of the line or the closing delimiter of the +;;; enclosing list, whichever is first. +;;; +;;; If necessary, you can delete a character, kill a line, &c., +;;; irrespective of S-expression structure, by pressing `C-u' before +;;; these keys, in case a mistake has broken the structure. +;;; +;;; Finally, Paredit Mode binds some keys to complex S-expression +;;; editing operations. For example, `C-<right>' makes the enclosing +;;; list slurp up an S-expression to its right (here `|' denotes the +;;; point): +;;; +;;; (foo (bar | baz) quux) C-<right> (foo (bar | baz quux)) +;;; +;;; Some paredit commands automatically reindent code. When they do, +;;; they try to indent as locally as possible, to avoid interfering +;;; with any indentation you might have manually written. Only the +;;; advanced S-expression manipulation commands automatically reindent, +;;; and only the forms that they immediately operated upon (and their +;;; subforms). +;;; +;;; This code is written for clarity, not efficiency. It frequently +;;; walks over S-expressions redundantly. If you have problems with +;;; the time it takes to execute some of the commands, let me know. + +;;; This assumes Unix-style LF line endings. + +(defconst paredit-version 25) +(defconst paredit-beta-p t) + +(eval-and-compile + + (defun paredit-xemacs-p () + ;; No idea where I got this definition from. Edward O'Connor + ;; (hober in #emacs) suggested the current definition. + ;; (and (boundp 'running-xemacs) + ;; running-xemacs) + (featurep 'xemacs)) + + (defun paredit-gnu-emacs-p () + ;++ This could probably be improved. + (not (paredit-xemacs-p))) + + (defmacro xcond (&rest clauses) + "Exhaustive COND. +Signal an error if no clause matches." + `(cond ,@clauses + (t (error "XCOND lost.")))) + + (defalias 'paredit-warn (if (fboundp 'warn) 'warn 'message)) + + (defvar paredit-sexp-error-type + (with-temp-buffer + (insert "(") + (condition-case condition + (backward-sexp) + (error (if (eq (car condition) 'error) + (paredit-warn "%s%s%s%s%s" + "Paredit is unable to discriminate" + " S-expression parse errors from" + " other errors. " + " This may cause obscure problems. " + " Please upgrade Emacs.")) + (car condition))))) + + (defmacro paredit-handle-sexp-errors (body &rest handler) + `(condition-case () + ,body + (,paredit-sexp-error-type ,@handler))) + + (put 'paredit-handle-sexp-errors 'lisp-indent-function 1) + + (defmacro paredit-ignore-sexp-errors (&rest body) + `(paredit-handle-sexp-errors (progn ,@body) + nil)) + + (put 'paredit-ignore-sexp-errors 'lisp-indent-function 0) + + (defmacro paredit-preserving-column (&rest body) + "Evaluate BODY and restore point to former column, relative to code. +Assumes BODY will change only indentation. +If point was on code, it moves with the code. +If point was on indentation, it stays in indentation." + (let ((column (make-symbol "column")) + (indentation (make-symbol "indentation"))) + `(let ((,column (current-column)) + (,indentation (paredit-current-indentation))) + (let ((value (progn ,@body))) + (paredit-restore-column ,column ,indentation) + value)))) + + (put 'paredit-preserving-column 'lisp-indent-function 0) + + nil) + +;;;; Minor Mode Definition + +(defvar paredit-lighter " Paredit" + "Mode line lighter Paredit Mode.") + +(defvar paredit-mode-map (make-sparse-keymap) + "Keymap for the paredit minor mode.") + +(defvar paredit-override-check-parens-function + (lambda (condition) condition nil) + "Function to tell whether unbalanced text should inhibit Paredit Mode.") + +;;;###autoload +(define-minor-mode paredit-mode + "Minor mode for pseudo-structurally editing Lisp code. +With a prefix argument, enable Paredit Mode even if there are + unbalanced parentheses in the buffer. +Paredit behaves badly if parentheses are unbalanced, so exercise + caution when forcing Paredit Mode to be enabled, and consider + fixing unbalanced parentheses instead. +\\<paredit-mode-map>" + :lighter paredit-lighter + ;; Setting `paredit-mode' to false here aborts enabling Paredit Mode. + (if (and paredit-mode + (not current-prefix-arg)) + (condition-case condition + (check-parens) + (error + (if (not (funcall paredit-override-check-parens-function condition)) + (progn (setq paredit-mode nil) + (signal (car condition) (cdr condition)))))))) + +(defun paredit-override-check-parens-interactively (condition) + (y-or-n-p (format "Enable Paredit Mode despite condition %S? " condition))) + +;;;###autoload +(defun enable-paredit-mode () + "Turn on pseudo-structural editing of Lisp code." + (interactive) + (paredit-mode +1)) + +(defun disable-paredit-mode () + "Turn off pseudo-structural editing of Lisp code." + (interactive) + (paredit-mode -1)) + +(defvar paredit-backward-delete-key + (xcond ((paredit-xemacs-p) "BS") + ((paredit-gnu-emacs-p) "DEL"))) + +(defvar paredit-forward-delete-keys + (xcond ((paredit-xemacs-p) '("DEL")) + ((paredit-gnu-emacs-p) '("<delete>" "<deletechar>")))) + +;;;; Paredit Keys + +;;; Separating the definition and initialization of this variable +;;; simplifies the development of paredit, since re-evaluating DEFVAR +;;; forms doesn't actually do anything. + +(defvar paredit-commands nil + "List of paredit commands with their keys and examples.") + +;;; Each specifier is of the form: +;;; (key[s] function (example-input example-output) ...) +;;; where key[s] is either a single string suitable for passing to KBD +;;; or a list of such strings. Entries in this list may also just be +;;; strings, in which case they are headings for the next entries. + +(progn (setq paredit-commands + `( + "Basic Insertion Commands" + ("(" paredit-open-round + ("(a b |c d)" + "(a b (|) c d)") + ("(foo \"bar |baz\" quux)" + "(foo \"bar (|baz\" quux)")) + (")" paredit-close-round + ("(a b |c )" "(a b c)|") + ("; Hello,| world!" + "; Hello,)| world!")) + ("M-)" paredit-close-round-and-newline + ("(defun f (x| ))" + "(defun f (x)\n |)") + ("; (Foo.|" + "; (Foo.)|")) + ("[" paredit-open-square + ("(a b |c d)" + "(a b [|] c d)") + ("(foo \"bar |baz\" quux)" + "(foo \"bar [|baz\" quux)")) + ("]" paredit-close-square + ("(define-key keymap [frob| ] 'frobnicate)" + "(define-key keymap [frob]| 'frobnicate)") + ("; [Bar.|" + "; [Bar.]|")) + + ("\"" paredit-doublequote + ("(frob grovel |full lexical)" + "(frob grovel \"|\" full lexical)" + "(frob grovel \"\"| full lexical)") + ("(foo \"bar |baz\" quux)" + "(foo \"bar \\\"|baz\" quux)") + ("(frob grovel) ; full |lexical" + "(frob grovel) ; full \"|lexical")) + ("M-\"" paredit-meta-doublequote + ("(foo \"bar |baz\" quux)" + "(foo \"bar baz\"| quux)") + ("(foo |(bar #\\x \"baz \\\\ quux\") zot)" + ,(concat "(foo \"|(bar #\\\\x \\\"baz \\\\" + "\\\\ quux\\\")\" zot)"))) + ("\\" paredit-backslash + ("(string #|)\n ; Character to escape: x" + "(string #\\x|)") + ("\"foo|bar\"\n ; Character to escape: \"" + "\"foo\\\"|bar\"")) + (";" paredit-semicolon + ("|(frob grovel)" + ";|(frob grovel)") + ("(frob |grovel)" + "(frob ;|grovel\n )") + ("(frob |grovel (bloit\n zargh))" + "(frob ;|grovel\n (bloit\n zargh))") + ("(frob grovel) |" + "(frob grovel) ;|")) + ("M-;" paredit-comment-dwim + ("(foo |bar) ; baz" + "(foo bar) ; |baz") + ("(frob grovel)|" + "(frob grovel) ;|") + ("(zot (foo bar)\n|\n (baz quux))" + "(zot (foo bar)\n ;; |\n (baz quux))") + ("(zot (foo bar) |(baz quux))" + "(zot (foo bar)\n ;; |\n (baz quux))") + ("|(defun hello-world ...)" + ";;; |\n(defun hello-world ...)")) + + ("C-j" paredit-newline + ("(let ((n (frobbotz))) |(display (+ n 1)\nport))" + ,(concat "(let ((n (frobbotz)))" + "\n |(display (+ n 1)" + "\n port))"))) + + "Deleting & Killing" + (("C-d" ,@paredit-forward-delete-keys) + paredit-forward-delete + ("(quu|x \"zot\")" "(quu| \"zot\")") + ("(quux |\"zot\")" + "(quux \"|zot\")" + "(quux \"|ot\")") + ("(foo (|) bar)" "(foo | bar)") + ("|(foo bar)" "(|foo bar)")) + (,paredit-backward-delete-key + paredit-backward-delete + ("(\"zot\" q|uux)" "(\"zot\" |uux)") + ("(\"zot\"| quux)" + "(\"zot|\" quux)" + "(\"zo|\" quux)") + ("(foo (|) bar)" "(foo | bar)") + ("(foo bar)|" "(foo bar|)")) + ("C-k" paredit-kill + ("(foo bar)| ; Useless comment!" + "(foo bar)|") + ("(|foo bar) ; Useful comment!" + "(|) ; Useful comment!") + ("|(foo bar) ; Useless line!" + "|") + ("(foo \"|bar baz\"\n quux)" + "(foo \"|\"\n quux)")) + ("M-d" paredit-forward-kill-word + ("|(foo bar) ; baz" + "(| bar) ; baz" + "(|) ; baz" + "() ;|") + (";;;| Frobnicate\n(defun frobnicate ...)" + ";;;|\n(defun frobnicate ...)" + ";;;\n(| frobnicate ...)")) + (,(concat "M-" paredit-backward-delete-key) + paredit-backward-kill-word + ("(foo bar) ; baz\n(quux)|" + "(foo bar) ; baz\n(|)" + "(foo bar) ; |\n()" + "(foo |) ; \n()" + "(|) ; \n()")) + + "Movement & Navigation" + ("C-M-f" paredit-forward + ("(foo |(bar baz) quux)" + "(foo (bar baz)| quux)") + ("(foo (bar)|)" + "(foo (bar))|")) + ("C-M-b" paredit-backward + ("(foo (bar baz)| quux)" + "(foo |(bar baz) quux)") + ("(|(foo) bar)" + "|((foo) bar)")) + ("C-M-u" paredit-backward-up) + ("C-M-d" paredit-forward-down) + ("C-M-p" paredit-backward-down) ; Built-in, these are FORWARD- + ("C-M-n" paredit-forward-up) ; & BACKWARD-LIST, which have + ; no need given C-M-f & C-M-b. + + "Depth-Changing Commands" + ("M-(" paredit-wrap-round + ("(foo |bar baz)" + "(foo (|bar) baz)")) + ("M-s" paredit-splice-sexp + ("(foo (bar| baz) quux)" + "(foo bar| baz quux)")) + (("M-<up>" "ESC <up>") + paredit-splice-sexp-killing-backward + ("(foo (let ((x 5)) |(sqrt n)) bar)" + "(foo |(sqrt n) bar)")) + (("M-<down>" "ESC <down>") + paredit-splice-sexp-killing-forward + ("(a (b c| d e) f)" + "(a b c| f)")) + ("M-r" paredit-raise-sexp + ("(dynamic-wind in (lambda () |body) out)" + "(dynamic-wind in |body out)" + "|body")) + ("M-?" paredit-convolute-sexp + ("(let ((x 5) (y 3)) (frob |(zwonk)) (wibblethwop))" + "(frob |(let ((x 5) (y 3)) (zwonk) (wibblethwop)))")) + + "Barfage & Slurpage" + (("C-)" "C-<right>") + paredit-forward-slurp-sexp + ("(foo (bar |baz) quux zot)" + "(foo (bar |baz quux) zot)") + ("(a b ((c| d)) e f)" + "(a b ((c| d) e) f)")) + (("C-}" "C-<left>") + paredit-forward-barf-sexp + ("(foo (bar |baz quux) zot)" + "(foo (bar |baz) quux zot)")) + (("C-(" "C-M-<left>" "ESC C-<left>") + paredit-backward-slurp-sexp + ("(foo bar (baz| quux) zot)" + "(foo (bar baz| quux) zot)") + ("(a b ((c| d)) e f)" + "(a (b (c| d)) e f)")) + (("C-{" "C-M-<right>" "ESC C-<right>") + paredit-backward-barf-sexp + ("(foo (bar baz |quux) zot)" + "(foo bar (baz |quux) zot)")) + + "Miscellaneous Commands" + ("M-S" paredit-split-sexp + ("(hello| world)" + "(hello)| (world)") + ("\"Hello, |world!\"" + "\"Hello, \"| \"world!\"")) + ("M-J" paredit-join-sexps + ("(hello)| (world)" + "(hello| world)") + ("\"Hello, \"| \"world!\"" + "\"Hello, |world!\"") + ("hello-\n| world" + "hello-|world")) + ("C-c C-M-l" paredit-recenter-on-sexp) + ("M-q" paredit-reindent-defun) + )) + nil) ; end of PROGN + +;;;;; Command Examples + +(eval-and-compile + (defmacro paredit-do-commands (vars string-case &rest body) + (let ((spec (nth 0 vars)) + (keys (nth 1 vars)) + (fn (nth 2 vars)) + (examples (nth 3 vars))) + `(dolist (,spec paredit-commands) + (if (stringp ,spec) + ,string-case + (let ((,keys (let ((k (car ,spec))) + (cond ((stringp k) (list k)) + ((listp k) k) + (t (error "Invalid paredit command %s." + ,spec))))) + (,fn (cadr ,spec)) + (,examples (cddr ,spec))) + ,@body))))) + + (put 'paredit-do-commands 'lisp-indent-function 2)) + +(defun paredit-define-keys () + (paredit-do-commands (spec keys fn examples) + nil ; string case + (dolist (key keys) + (define-key paredit-mode-map (read-kbd-macro key) fn)))) + +(defun paredit-function-documentation (fn) + (let ((original-doc (get fn 'paredit-original-documentation)) + (doc (documentation fn 'function-documentation))) + (or original-doc + (progn (put fn 'paredit-original-documentation doc) + doc)))) + +(defun paredit-annotate-mode-with-examples () + (let ((contents + (list (paredit-function-documentation 'paredit-mode)))) + (paredit-do-commands (spec keys fn examples) + (push (concat "\n \n" spec "\n") + contents) + (let ((name (symbol-name fn))) + (if (string-match (symbol-name 'paredit-) name) + (push (concat "\n\n\\[" name "]\t" name + (if examples + (mapconcat (lambda (example) + (concat + "\n" + (mapconcat 'identity + example + "\n --->\n") + "\n")) + examples + "") + "\n (no examples)\n")) + contents)))) + (put 'paredit-mode 'function-documentation + (apply 'concat (reverse contents)))) + ;; PUT returns the huge string we just constructed, which we don't + ;; want it to return. + nil) + +(defun paredit-annotate-functions-with-examples () + (paredit-do-commands (spec keys fn examples) + nil ; string case + (put fn 'function-documentation + (concat (paredit-function-documentation fn) + "\n\n\\<paredit-mode-map>\\[" (symbol-name fn) "]\n" + (mapconcat (lambda (example) + (concat "\n" + (mapconcat 'identity + example + "\n ->\n") + "\n")) + examples + ""))))) + +;;;;; HTML Examples + +(defun paredit-insert-html-examples () + "Insert HTML for a paredit quick reference table." + (interactive) + (let ((insert-lines + (lambda (&rest lines) (dolist (line lines) (insert line) (newline)))) + (initp nil)) + (paredit-do-commands (spec keys fn examples) + (progn (if initp + (funcall insert-lines "</table>") + (setq initp t)) + (funcall insert-lines (concat "<h3>" spec "</h3>")) + (funcall insert-lines "<table>")) + (let ((name (symbol-name fn)) + (keys + (mapconcat (lambda (key) + (concat "<tt>" (paredit-html-quote key) "</tt>")) + keys + ", "))) + (funcall insert-lines "<tr>") + (funcall insert-lines (concat " <th align=\"left\">" keys "</th>")) + (funcall insert-lines (concat " <th align=\"left\">" name "</th>")) + (funcall insert-lines "</tr>") + (funcall insert-lines + "<tr><td colspan=\"2\"><table cellpadding=\"5\"><tr>") + (dolist (example examples) + (let ((prefix "<td><table border=\"1\"><tr><td><table><tr><td><pre>") + (examples + (mapconcat 'paredit-html-quote + example + (concat "</pre></td></tr>" + "<tr><th>↓</th></tr>" + "<tr><td><pre>"))) + (suffix "</pre></td></tr></table></td></tr></table></td>")) + (funcall insert-lines (concat prefix examples suffix)))) + (funcall insert-lines "</tr></table></td></tr>"))) + (funcall insert-lines "</table>"))) + +(defun paredit-html-quote (string) + (with-temp-buffer + (dotimes (i (length string)) + (insert (let ((c (elt string i))) + (cond ((eq c ?\<) "<") + ((eq c ?\>) ">") + ((eq c ?\&) "&") + ((eq c ?\') "'") + ((eq c ?\") """) + (t c))))) + (buffer-string))) + +;;;; Delimiter Insertion + +(eval-and-compile + (defun paredit-conc-name (&rest strings) + (intern (apply 'concat strings))) + + (defmacro define-paredit-pair (open close name) + `(progn + (defun ,(paredit-conc-name "paredit-open-" name) (&optional n) + ,(concat "Insert a balanced " name " pair. +With a prefix argument N, put the closing " name " after N + S-expressions forward. +If the region is active, `transient-mark-mode' is enabled, and the + region's start and end fall in the same parenthesis depth, insert a + " name " pair around the region. +If in a string or a comment, insert a single " name ". +If in a character literal, do nothing. This prevents changing what was + in the character literal to a meaningful delimiter unintentionally.") + (interactive "P") + (cond ((or (paredit-in-string-p) + (paredit-in-comment-p)) + (insert ,open)) + ((not (paredit-in-char-p)) + (paredit-insert-pair n ,open ,close 'goto-char) + (save-excursion (backward-up-list) (indent-sexp))))) + (defun ,(paredit-conc-name "paredit-close-" name) () + ,(concat "Move past one closing delimiter and reindent. +\(Agnostic to the specific closing delimiter.) +If in a string or comment, insert a single closing " name ". +If in a character literal, do nothing. This prevents changing what was + in the character literal to a meaningful delimiter unintentionally.") + (interactive) + (paredit-move-past-close ,close)) + (defun ,(paredit-conc-name "paredit-close-" name "-and-newline") () + ,(concat "Move past one closing delimiter, add a newline," + " and reindent. +If there was a margin comment after the closing delimiter, preserve it + on the same line.") + (interactive) + (paredit-move-past-close-and-newline ,close)) + (defun ,(paredit-conc-name "paredit-wrap-" name) + (&optional argument) + ,(concat "Wrap the following S-expression. +See `paredit-wrap-sexp' for more details.") + (interactive "P") + (paredit-wrap-sexp argument ,open ,close)) + (add-to-list 'paredit-wrap-commands + ',(paredit-conc-name "paredit-wrap-" name))))) + +(defvar paredit-wrap-commands '(paredit-wrap-sexp) + "List of paredit commands that wrap S-expressions. +Used by `paredit-yank-pop'; for internal paredit use only.") + +(define-paredit-pair ?\( ?\) "round") +(define-paredit-pair ?\[ ?\] "square") +(define-paredit-pair ?\{ ?\} "curly") +(define-paredit-pair ?\< ?\> "angled") + +;;; Aliases for the old names. + +(defalias 'paredit-open-parenthesis 'paredit-open-round) +(defalias 'paredit-close-parenthesis 'paredit-close-round) +(defalias 'paredit-close-parenthesis-and-newline + 'paredit-close-round-and-newline) + +(defalias 'paredit-open-bracket 'paredit-open-square) +(defalias 'paredit-close-bracket 'paredit-close-square) +(defalias 'paredit-close-bracket-and-newline + 'paredit-close-square-and-newline) + +(defun paredit-move-past-close (close) + (paredit-move-past-close-and close + (lambda () + (paredit-blink-paren-match nil)))) + +(defun paredit-move-past-close-and-newline (close) + (paredit-move-past-close-and close + (lambda () + (let ((comment.point (paredit-find-comment-on-line))) + (newline) + (if comment.point + (save-excursion + (forward-line -1) + (end-of-line) + (indent-to (cdr comment.point)) + (insert (car comment.point))))) + (lisp-indent-line) + (paredit-ignore-sexp-errors (indent-sexp)) + (paredit-blink-paren-match t)))) + +(defun paredit-move-past-close-and (close if-moved) + (if (or (paredit-in-string-p) + (paredit-in-comment-p)) + (insert close) + (if (paredit-in-char-p) (forward-char)) + (paredit-move-past-close-and-reindent close) + (funcall if-moved))) + +(defun paredit-find-comment-on-line () + "Find a margin comment on the current line. +Return nil if there is no such comment or if there is anything but + whitespace until such a comment. +If such a comment exists, delete the comment (including all leading + whitespace) and return a cons whose car is the comment as a string + and whose cdr is the point of the comment's initial semicolon, + relative to the start of the line." + (save-excursion + (paredit-skip-whitespace t (point-at-eol)) + (and (eq ?\; (char-after)) + (not (eq ?\; (char-after (1+ (point))))) + (not (or (paredit-in-string-p) + (paredit-in-char-p))) + (let* ((start ;Move to before the semicolon. + (progn (backward-char) (point))) + (comment + (buffer-substring start (point-at-eol)))) + (paredit-skip-whitespace nil (point-at-bol)) + (delete-region (point) (point-at-eol)) + (cons comment (- start (point-at-bol))))))) + +(defun paredit-insert-pair (n open close forward) + (let* ((regionp + (and (paredit-region-active-p) + (paredit-region-safe-for-insert-p))) + (end + (and regionp + (not n) + (prog1 (region-end) (goto-char (region-beginning)))))) + (let ((spacep (paredit-space-for-delimiter-p nil open))) + (if spacep (insert " ")) + (insert open) + (save-excursion + ;; Move past the desired region. + (cond (n + (funcall forward + (paredit-scan-sexps-hack (point) + (prefix-numeric-value n)))) + (regionp + (funcall forward (+ end (if spacep 2 1))))) + ;; The string case can happen if we are inserting string + ;; delimiters. The comment case may happen by moving to the + ;; end of a buffer that has a comment with no trailing newline. + (if (and (not (paredit-in-string-p)) + (paredit-in-comment-p)) + (newline)) + (insert close) + (if (paredit-space-for-delimiter-p t close) + (insert " ")))))) + +;++ This needs a better name... + +(defun paredit-scan-sexps-hack (point n) + (save-excursion + (goto-char point) + (let ((direction (if (< 0 n) +1 -1)) + (magnitude (abs n)) + (count 0)) + (catch 'exit + (while (< count magnitude) + (let ((p + (paredit-handle-sexp-errors (scan-sexps (point) direction) + nil))) + (if (not p) (throw 'exit nil)) + (goto-char p)) + (setq count (+ count 1))))) + (point))) + +(defun paredit-region-safe-for-insert-p () + (save-excursion + (let ((beginning (region-beginning)) + (end (region-end))) + (goto-char beginning) + (let* ((beginning-state (paredit-current-parse-state)) + (end-state + (parse-partial-sexp beginning end nil nil beginning-state))) + (and (= (nth 0 beginning-state) ; 0. depth in parens + (nth 0 end-state)) + (eq (nth 3 beginning-state) ; 3. non-nil if inside a + (nth 3 end-state)) ; string + (eq (nth 4 beginning-state) ; 4. comment status, yada + (nth 4 end-state)) + (eq (nth 5 beginning-state) ; 5. t if following char + (nth 5 end-state))))))) ; quote + +(defvar paredit-space-for-delimiter-predicates nil + "List of predicates for whether to put space by delimiter at point. +Each predicate is a function that is is applied to two arguments, ENDP + and DELIMITER, and that returns a boolean saying whether to put a + space next to the delimiter -- before/after the delimiter if ENDP is + false/true, respectively. +If any predicate returns false, no space is inserted: every predicate + has veto power. +Each predicate may assume that the point is not at the beginning/end of + the buffer, and that the point is preceded/followed by a word + constituent, symbol constituent, string quote, or delimiter matching + DELIMITER, if ENDP is false/true, respectively. +Each predicate should examine only text before/after the point if ENDP is + false/true, respectively.") + +(defun paredit-space-for-delimiter-p (endp delimiter) + ;; If at the buffer limit, don't insert a space. If there is a word, + ;; symbol, other quote, or non-matching parenthesis delimiter (i.e. a + ;; close when want an open the string or an open when we want to + ;; close the string), do insert a space. + (and (not (if endp (eobp) (bobp))) + (memq (char-syntax (if endp (char-after) (char-before))) + (list ?w ?_ ?\" + (let ((matching (matching-paren delimiter))) + (and matching (char-syntax matching))) + (and (not endp) + (eq ?\" (char-syntax delimiter)) + ?\) ))) + (catch 'exit + (dolist (predicate paredit-space-for-delimiter-predicates) + (if (not (funcall predicate endp delimiter)) + (throw 'exit nil))) + t))) + +(defun paredit-move-past-close-and-reindent (close) + (let ((open (paredit-missing-close))) + (if open + (if (eq close (matching-paren open)) + (save-excursion + (message "Missing closing delimiter: %c" close) + (insert close)) + (error "Mismatched missing closing delimiter: %c ... %c" + open close)))) + (up-list) + (if (catch 'return ; This CATCH returns T if it + (while t ; should delete leading spaces + (save-excursion ; and NIL if not. + (let ((before-paren (1- (point)))) + (back-to-indentation) + (cond ((not (eq (point) before-paren)) + ;; Can't call PAREDIT-DELETE-LEADING-WHITESPACE + ;; here -- we must return from SAVE-EXCURSION + ;; first. + (throw 'return t)) + ((save-excursion (forward-line -1) + (end-of-line) + (paredit-in-comment-p)) + ;; Moving the closing delimiter any further + ;; would put it into a comment, so we just + ;; indent the closing delimiter where it is and + ;; abort the loop, telling its continuation that + ;; no leading whitespace should be deleted. + (lisp-indent-line) + (throw 'return nil)) + (t (delete-indentation))))))) + (paredit-delete-leading-whitespace))) + +(defun paredit-missing-close () + (save-excursion + (paredit-handle-sexp-errors (backward-up-list) + (error "Not inside a list.")) + (let ((open (char-after))) + (paredit-handle-sexp-errors (progn (forward-sexp) nil) + open)))) + +(defun paredit-delete-leading-whitespace () + ;; This assumes that we're on the closing delimiter already. + (save-excursion + (backward-char) + (while (let ((syn (char-syntax (char-before)))) + (and (or (eq syn ?\ ) (eq syn ?-)) ; whitespace syntax + ;; The above line is a perfect example of why the + ;; following test is necessary. + (not (paredit-in-char-p (1- (point)))))) + (delete-char -1)))) + +(defun paredit-blink-paren-match (another-line-p) + (if (and blink-matching-paren + (or (not show-paren-mode) another-line-p)) + (paredit-ignore-sexp-errors + (save-excursion + (backward-sexp) + (forward-sexp) + ;; SHOW-PAREN-MODE inhibits any blinking, so we disable it + ;; locally here. + (let ((show-paren-mode nil)) + (blink-matching-open)))))) + +(defun paredit-doublequote (&optional n) + "Insert a pair of double-quotes. +With a prefix argument N, wrap the following N S-expressions in + double-quotes, escaping intermediate characters if necessary. +If the region is active, `transient-mark-mode' is enabled, and the + region's start and end fall in the same parenthesis depth, insert a + pair of double-quotes around the region, again escaping intermediate + characters if necessary. +Inside a comment, insert a literal double-quote. +At the end of a string, move past the closing double-quote. +In the middle of a string, insert a backslash-escaped double-quote. +If in a character literal, do nothing. This prevents accidentally + changing a what was in the character literal to become a meaningful + delimiter unintentionally." + (interactive "P") + (cond ((paredit-in-string-p) + (if (eq (point) (- (paredit-enclosing-string-end) 1)) + (forward-char) ; Just move past the closing quote. + ;; Don't split a \x into an escaped backslash and a string end. + (if (paredit-in-string-escape-p) (forward-char)) + (insert ?\\ ?\" ))) + ((paredit-in-comment-p) + (insert ?\" )) + ((not (paredit-in-char-p)) + (paredit-insert-pair n ?\" ?\" 'paredit-forward-for-quote)))) + +(defun paredit-meta-doublequote (&optional n) + "Move to the end of the string. +If not in a string, act as `paredit-doublequote'; if not prefix argument + is specified and the region is not active or `transient-mark-mode' is + disabled, the default is to wrap one S-expression, however, not zero." + (interactive "P") + (if (not (paredit-in-string-p)) + (paredit-doublequote (or n (and (not (paredit-region-active-p)) 1))) + (goto-char (paredit-enclosing-string-end)))) + +(defun paredit-meta-doublequote-and-newline (&optional n) + "Move to the end of the string, insert a newline, and indent. +If not in a string, act as `paredit-doublequote'; if not prefix argument + is specified and the region is not active or `transient-mark-mode' is + disabled, the default is to wrap one S-expression, however, not zero." + (interactive "P") + (if (not (paredit-in-string-p)) + (paredit-doublequote (or n (and (not (paredit-region-active-p)) 1))) + (progn (goto-char (paredit-enclosing-string-end)) + (newline) + (lisp-indent-line) + (paredit-ignore-sexp-errors (indent-sexp))))) + +(defun paredit-forward-for-quote (end) + (let ((state (paredit-current-parse-state))) + (while (< (point) end) + (let ((new-state (parse-partial-sexp (point) (1+ (point)) + nil nil state))) + (if (paredit-in-string-p new-state) + (if (not (paredit-in-string-escape-p)) + (setq state new-state) + ;; Escape character: turn it into an escaped escape + ;; character by appending another backslash. + (insert ?\\ ) + ;; Now the point is after both escapes, and we want to + ;; rescan from before the first one to after the second + ;; one. + (setq state + (parse-partial-sexp (- (point) 2) (point) + nil nil state)) + ;; Advance the end point, since we just inserted a new + ;; character. + (setq end (1+ end))) + ;; String: escape by inserting a backslash before the quote. + (backward-char) + (insert ?\\ ) + ;; The point is now between the escape and the quote, and we + ;; want to rescan from before the escape to after the quote. + (setq state + (parse-partial-sexp (1- (point)) (1+ (point)) + nil nil state)) + ;; Advance the end point for the same reason as above. + (setq end (1+ end))))))) + +;;;; Escape Insertion + +(defun paredit-backslash () + "Insert a backslash followed by a character to escape." + (interactive) + (cond ((paredit-in-string-p) (paredit-backslash-interactive)) + ((paredit-in-comment-p) (insert ?\\)) + ((paredit-in-char-p) (forward-char) (paredit-backslash-interactive)) + (t (paredit-backslash-interactive)))) + +(defun paredit-backslash-interactive () + (insert ?\\ ) + ;; Read a character to insert after the backslash. If anything + ;; goes wrong -- the user hits delete (entering the rubout + ;; `character'), aborts with C-g, or enters non-character input + ;; -- then delete the backslash to avoid a dangling escape. + (let ((delete-p t)) + (unwind-protect + (let ((char (read-char "Character to escape: " t))) + (if (not (eq char ?\^?)) + (progn (message "Character to escape: %c" char) + (insert char) + (setq delete-p nil)))) + (if delete-p + (progn (message "Deleting escape.") + (delete-char -1)))))) + +(defun paredit-newline () + "Insert a newline and indent it. +This is like `newline-and-indent', but it not only indents the line + that the point is on but also the S-expression following the point, + if there is one. +Move forward one character first if on an escaped character. +If in a string, just insert a literal newline. +If in a comment and if followed by invalid structure, call + `indent-new-comment-line' to keep the invalid structure in a + comment." + (interactive) + (cond ((paredit-in-string-p) + (newline)) + ((paredit-in-comment-p) + (if (paredit-region-ok-p (point) (point-at-eol)) + (progn (newline-and-indent) + (paredit-ignore-sexp-errors (indent-sexp))) + (indent-new-comment-line))) + (t + (if (paredit-in-char-p) + (forward-char)) + (newline-and-indent) + ;; Indent the following S-expression, but don't signal an + ;; error if there's only a closing delimiter after the point. + (paredit-ignore-sexp-errors (indent-sexp))))) + +(defun paredit-reindent-defun (&optional argument) + "Reindent the definition that the point is on. +If the point is in a string or a comment, fill the paragraph instead, + and with a prefix argument, justify as well." + (interactive "P") + (if (or (paredit-in-string-p) + (paredit-in-comment-p)) + (lisp-fill-paragraph argument) + (paredit-preserving-column + (save-excursion + (end-of-defun) + (beginning-of-defun) + (indent-sexp))))) + +;;;; Comment Insertion + +(defun paredit-semicolon (&optional n) + "Insert a semicolon. +With a prefix argument N, insert N semicolons. +If in a string, do just that and nothing else. +If in a character literal, move to the beginning of the character + literal before inserting the semicolon. +If the enclosing list ends on the line after the point, break the line + after the last S-expression following the point. +If a list begins on the line after the point but ends on a different + line, break the line after the last S-expression following the point + before the list." + (interactive "p") + (if (or (paredit-in-string-p) (paredit-in-comment-p)) + (insert (make-string (or n 1) ?\; )) + (if (paredit-in-char-p) + (backward-char 2)) + (let ((line-break-point (paredit-semicolon-find-line-break-point))) + (if line-break-point + (paredit-semicolon-with-line-break line-break-point (or n 1)) + (insert (make-string (or n 1) ?\; )))))) + +(defun paredit-semicolon-find-line-break-point () + (and (not (eolp)) ;Implies (not (eobp)). + (let ((eol (point-at-eol))) + (save-excursion + (catch 'exit + (while t + (let ((line-break-point (point))) + (cond ((paredit-handle-sexp-errors (progn (forward-sexp) t) + nil) + ;; Successfully advanced by an S-expression. + ;; If that S-expression started on this line + ;; and ended on another one, break here. + (cond ((not (eq eol (point-at-eol))) + (throw 'exit + (and (save-excursion + (backward-sexp) + (eq eol (point-at-eol))) + line-break-point))) + ((eobp) + (throw 'exit nil)))) + ((save-excursion + (paredit-skip-whitespace t (point-at-eol)) + (or (eolp) (eobp) (eq (char-after) ?\;))) + ;; Can't move further, but there's no closing + ;; delimiter we're about to clobber -- either + ;; it's on the next line or we're at the end of + ;; the buffer. Don't break the line. + (throw 'exit nil)) + (t + ;; Can't move because we hit a delimiter at the + ;; end of this line. Break here. + (throw 'exit line-break-point)))))))))) + +(defun paredit-semicolon-with-line-break (line-break-point n) + (let ((line-break-marker (make-marker))) + (set-marker line-break-marker line-break-point) + (set-marker-insertion-type line-break-marker t) + (insert (make-string (or n 1) ?\; )) + (save-excursion + (goto-char line-break-marker) + (set-marker line-break-marker nil) + (newline) + (lisp-indent-line) + ;; This step is redundant if we are inside a list, but even if we + ;; are at the top level, we want at least to indent whatever we + ;; bumped off the line. + (paredit-ignore-sexp-errors (indent-sexp)) + (paredit-indent-sexps)))) + +;;; This is all a horrible, horrible hack, primarily for GNU Emacs 21, +;;; in which there is no `comment-or-uncomment-region'. + +(autoload 'comment-forward "newcomment") +(autoload 'comment-normalize-vars "newcomment") +(autoload 'comment-region "newcomment") +(autoload 'comment-search-forward "newcomment") +(autoload 'uncomment-region "newcomment") + +(defun paredit-initialize-comment-dwim () + (require 'newcomment) + (if (not (fboundp 'comment-or-uncomment-region)) + (defalias 'comment-or-uncomment-region + (lambda (beginning end &optional argument) + (interactive "*r\nP") + (if (save-excursion (goto-char beginning) + (comment-forward (point-max)) + (<= end (point))) + (uncomment-region beginning end argument) + (comment-region beginning end argument))))) + (defalias 'paredit-initialize-comment-dwim 'comment-normalize-vars) + (comment-normalize-vars)) + +(defun paredit-comment-dwim (&optional argument) + "Call the Lisp comment command you want (Do What I Mean). +This is like `comment-dwim', but it is specialized for Lisp editing. +If transient mark mode is enabled and the mark is active, comment or + uncomment the selected region, depending on whether it was entirely + commented not not already. +If there is already a comment on the current line, with no prefix + argument, indent to that comment; with a prefix argument, kill that + comment. +Otherwise, insert a comment appropriate for the context and ensure that + any code following the comment is moved to the next line. +At the top level, where indentation is calculated to be at column 0, + insert a triple-semicolon comment; within code, where the indentation + is calculated to be non-zero, and on the line there is either no code + at all or code after the point, insert a double-semicolon comment; + and if the point is after all code on the line, insert a single- + semicolon margin comment at `comment-column'." + (interactive "*P") + (paredit-initialize-comment-dwim) + (cond ((paredit-region-active-p) + (comment-or-uncomment-region (region-beginning) + (region-end) + argument)) + ((paredit-comment-on-line-p) + (if argument + (comment-kill (if (integerp argument) argument nil)) + (comment-indent))) + (t (paredit-insert-comment)))) + +(defun paredit-comment-on-line-p () + "True if there is a comment on the line following point. +This is expected to be called only in `paredit-comment-dwim'; do not + call it elsewhere." + (save-excursion + (beginning-of-line) + (let ((comment-p nil)) + ;; Search forward for a comment beginning. If there is one, set + ;; COMMENT-P to true; if not, it will be nil. + (while (progn + (setq comment-p ;t -> no error + (comment-search-forward (point-at-eol) t)) + (and comment-p + (or (paredit-in-string-p) + (paredit-in-char-p (1- (point)))))) + (forward-char)) + comment-p))) + +(defun paredit-insert-comment () + (let ((code-after-p + (save-excursion (paredit-skip-whitespace t (point-at-eol)) + (not (eolp)))) + (code-before-p + (save-excursion (paredit-skip-whitespace nil (point-at-bol)) + (not (bolp))))) + (cond ((and (bolp) + (let ((indent + (let ((indent (calculate-lisp-indent))) + (if (consp indent) (car indent) indent)))) + (and indent (zerop indent)))) + ;; Top-level comment + (if code-after-p (save-excursion (newline))) + (insert ";;; ")) + ((or code-after-p (not code-before-p)) + ;; Code comment + (if code-before-p + (newline-and-indent) + (lisp-indent-line)) + (insert ";; ") + (if code-after-p + (save-excursion + (newline) + (lisp-indent-line) + (paredit-indent-sexps)))) + (t + ;; Margin comment + (indent-to comment-column 1) ; 1 -> force one leading space + (insert ?\; ))))) + +;;;; Character Deletion + +(defun paredit-forward-delete (&optional argument) + "Delete a character forward or move forward over a delimiter. +If on an opening S-expression delimiter, move forward into the + S-expression. +If on a closing S-expression delimiter, refuse to delete unless the + S-expression is empty, in which case delete the whole S-expression. +With a numeric prefix argument N, delete N characters forward. +With a `C-u' prefix argument, simply delete a character forward, + without regard for delimiter balancing." + (interactive "P") + (cond ((or (consp argument) (eobp)) + (delete-char +1)) + ((integerp argument) + (if (< argument 0) + (paredit-backward-delete argument) + (while (> argument 0) + (paredit-forward-delete) + (setq argument (- argument 1))))) + ((paredit-in-string-p) + (paredit-forward-delete-in-string)) + ((paredit-in-comment-p) + (paredit-forward-delete-in-comment)) + ((paredit-in-char-p) ; Escape -- delete both chars. + (delete-char -1) + (delete-char +1)) + ((eq (char-after) ?\\ ) ; ditto + (delete-char +2)) + ((let ((syn (char-syntax (char-after)))) + (or (eq syn ?\( ) + (eq syn ?\" ))) + (if (save-excursion + (paredit-handle-sexp-errors (progn (forward-sexp) t) + nil)) + (forward-char) + (message "Deleting spurious opening delimiter.") + (delete-char +1))) + ((and (not (paredit-in-char-p (1- (point)))) + (eq (char-syntax (char-after)) ?\) ) + (eq (char-before) (matching-paren (char-after)))) + (delete-char -1) ; Empty list -- delete both + (delete-char +1)) ; delimiters. + ((eq ?\; (char-after)) + (paredit-forward-delete-comment-start)) + ((eq (char-syntax (char-after)) ?\) ) + (if (paredit-handle-sexp-errors + (save-excursion (forward-char) (backward-sexp) t) + nil) + (message "End of list!") + (progn + (message "Deleting spurious closing delimiter.") + (delete-char +1)))) + ;; Just delete a single character, if it's not a closing + ;; delimiter. (The character literal case is already handled + ;; by now.) + (t (delete-char +1)))) + +(defun paredit-forward-delete-in-string () + (let ((start+end (paredit-string-start+end-points))) + (cond ((not (eq (point) (cdr start+end))) + ;; If it's not the close-quote, it's safe to delete. But + ;; first handle the case that we're in a string escape. + (cond ((paredit-in-string-escape-p) + ;; We're right after the backslash, so backward + ;; delete it before deleting the escaped character. + (delete-char -1)) + ((eq (char-after) ?\\ ) + ;; If we're not in a string escape, but we are on a + ;; backslash, it must start the escape for the next + ;; character, so delete the backslash before deleting + ;; the next character. + (delete-char +1))) + (delete-char +1)) + ((eq (1- (point)) (car start+end)) + ;; If it is the close-quote, delete only if we're also right + ;; past the open-quote (i.e. it's empty), and then delete + ;; both quotes. Otherwise we refuse to delete it. + (delete-char -1) + (delete-char +1))))) + +(defun paredit-check-forward-delete-in-comment () + ;; Point is in a comment, possibly at eol. We are about to delete + ;; some characters forward; if we are at eol, we are about to delete + ;; the line break. Refuse to do so if if moving the next line into + ;; the comment would break structure. + (if (eolp) + (let ((next-line-start (point-at-bol 2)) + (next-line-end (point-at-eol 2))) + (paredit-check-region next-line-start next-line-end)))) + +(defun paredit-forward-delete-in-comment () + (paredit-check-forward-delete-in-comment) + (delete-char +1)) + +(defun paredit-forward-delete-comment-start () + ;; Point precedes a comment start (not at eol). Refuse to delete a + ;; comment start if the comment contains unbalanced junk. + (paredit-check-region (+ (point) 1) (point-at-eol)) + (delete-char +1)) + +(defun paredit-backward-delete (&optional argument) + "Delete a character backward or move backward over a delimiter. +If on a closing S-expression delimiter, move backward into the + S-expression. +If on an opening S-expression delimiter, refuse to delete unless the + S-expression is empty, in which case delete the whole S-expression. +With a numeric prefix argument N, delete N characters backward. +With a `C-u' prefix argument, simply delete a character backward, + without regard for delimiter balancing." + (interactive "P") + (cond ((or (consp argument) (bobp)) + ;++ Should this untabify? + (delete-char -1)) + ((integerp argument) + (if (< argument 0) + (paredit-forward-delete (- 0 argument)) + (while (> argument 0) + (paredit-backward-delete) + (setq argument (- argument 1))))) + ((paredit-in-string-p) + (paredit-backward-delete-in-string)) + ((paredit-in-comment-p) + (paredit-backward-delete-in-comment)) + ((paredit-in-char-p) ; Escape -- delete both chars. + (delete-char -1) + (delete-char +1)) + ((paredit-in-char-p (1- (point))) + (delete-char -2)) ; ditto + ((let ((syn (char-syntax (char-before)))) + (or (eq syn ?\) ) + (eq syn ?\" ))) + (if (save-excursion + (paredit-handle-sexp-errors (progn (backward-sexp) t) + nil)) + (backward-char) + (message "Deleting spurious closing delimiter.") + (delete-char -1))) + ((and (eq (char-syntax (char-before)) ?\( ) + (eq (char-after) (matching-paren (char-before)))) + (delete-char -1) ; Empty list -- delete both + (delete-char +1)) ; delimiters. + ((bolp) + (paredit-backward-delete-maybe-comment-end)) + ((eq (char-syntax (char-before)) ?\( ) + (if (paredit-handle-sexp-errors + (save-excursion (backward-char) (forward-sexp) t) + nil) + (message "Beginning of list!") + (progn + (message "Deleting spurious closing delimiter.") + (delete-char -1)))) + ;; Delete it, unless it's an opening delimiter. The case of + ;; character literals is already handled by now. + (t + ;; Turn off the @#&*&!^&(%^ botch in GNU Emacs 24 that changed + ;; `backward-delete-char' and `backward-delete-char-untabify' + ;; semantically so that they delete the region in transient + ;; mark mode. + (let ((delete-active-region nil)) + (backward-delete-char-untabify +1))))) + +(defun paredit-backward-delete-in-string () + (let ((start+end (paredit-string-start+end-points))) + (cond ((not (eq (1- (point)) (car start+end))) + ;; If it's not the open-quote, it's safe to delete. + (if (paredit-in-string-escape-p) + ;; If we're on a string escape, since we're about to + ;; delete the backslash, we must first delete the + ;; escaped char. + (delete-char +1)) + (delete-char -1) + (if (paredit-in-string-escape-p) + ;; If, after deleting a character, we find ourselves in + ;; a string escape, we must have deleted the escaped + ;; character, and the backslash is behind the point, so + ;; backward delete it. + (delete-char -1))) + ((eq (point) (cdr start+end)) + ;; If it is the open-quote, delete only if we're also right + ;; past the close-quote (i.e. it's empty), and then delete + ;; both quotes. Otherwise we refuse to delete it. + (delete-char -1) + (delete-char +1))))) + +(defun paredit-backward-delete-in-comment () + ;; Point is in a comment, possibly just after the comment start. + ;; Refuse to delete a comment start if the comment contains + ;; unbalanced junk. + (if (save-excursion + (backward-char) + ;; Must call `paredit-in-string-p' before + ;; `paredit-in-comment-p'. + (not (or (paredit-in-string-p) (paredit-in-comment-p)))) + (paredit-check-region (point) (point-at-eol))) + (backward-delete-char-untabify +1)) + +(defun paredit-backward-delete-maybe-comment-end () + ;; Point is at bol, possibly just after a comment end (i.e., the + ;; previous line may have had a line comment). Refuse to delete a + ;; comment end if moving the current line into the previous line's + ;; comment would break structure. + (if (save-excursion + (backward-char) + (and (not (paredit-in-string-p)) (paredit-in-comment-p))) + (paredit-check-region (point-at-eol) (point-at-bol))) + (delete-char -1)) + +;;;; Killing + +(defun paredit-kill (&optional argument) + "Kill a line as if with `kill-line', but respecting delimiters. +In a string, act exactly as `kill-line' but do not kill past the + closing string delimiter. +On a line with no S-expressions on it starting after the point or + within a comment, act exactly as `kill-line'. +Otherwise, kill all S-expressions that start after the point. +With a `C-u' prefix argument, just do the standard `kill-line'. +With a numeric prefix argument N, do `kill-line' that many times." + (interactive "P") + (cond (argument + (kill-line (if (integerp argument) argument 1))) + ((paredit-in-string-p) + (paredit-kill-line-in-string)) + ((paredit-in-comment-p) + (paredit-kill-line-in-comment)) + ((save-excursion (paredit-skip-whitespace t (point-at-eol)) + (or (eolp) (eq (char-after) ?\; ))) + ;** Be careful about trailing backslashes. + (if (paredit-in-char-p) + (backward-char)) + (kill-line)) + (t (paredit-kill-sexps-on-line)))) + +(defun paredit-kill-line-in-string () + (if (save-excursion (paredit-skip-whitespace t (point-at-eol)) + (eolp)) + (kill-line) + (save-excursion + ;; Be careful not to split an escape sequence. + (if (paredit-in-string-escape-p) + (backward-char)) + (kill-region (point) + (min (point-at-eol) + (cdr (paredit-string-start+end-points))))))) + +(defun paredit-kill-line-in-comment () + ;; The variable `kill-whole-line' is not relevant: the point is in a + ;; comment, and hence not at the beginning of the line. + (paredit-check-forward-delete-in-comment) + (kill-line)) + +(defun paredit-kill-sexps-on-line () + (if (paredit-in-char-p) ; Move past the \ and prefix. + (backward-char 2)) ; (# in Scheme/CL, ? in elisp) + (let ((beginning (point)) + (eol (point-at-eol))) + (let ((end-of-list-p (paredit-forward-sexps-to-kill beginning eol))) + ;; If we got to the end of the list and it's on the same line, + ;; move backward past the closing delimiter before killing. (This + ;; allows something like killing the whitespace in ( ).) + (if end-of-list-p (progn (up-list) (backward-char))) + (if kill-whole-line + (paredit-kill-sexps-on-whole-line beginning) + (kill-region beginning + ;; If all of the S-expressions were on one line, + ;; i.e. we're still on that line after moving past + ;; the last one, kill the whole line, including + ;; any comments; otherwise just kill to the end of + ;; the last S-expression we found. Be sure, + ;; though, not to kill any closing parentheses. + (if (and (not end-of-list-p) + (eq (point-at-eol) eol)) + eol + (point))))))) + +;;; Please do not try to understand this code unless you have a VERY +;;; good reason to do so. I gave up trying to figure it out well +;;; enough to explain it, long ago. + +(defun paredit-forward-sexps-to-kill (beginning eol) + (let ((end-of-list-p nil) + (firstp t)) + ;; Move to the end of the last S-expression that started on this + ;; line, or to the closing delimiter if the last S-expression in + ;; this list is on the line. + (catch 'return + (while t + ;; This and the `kill-whole-line' business below fix a bug that + ;; inhibited any S-expression at the very end of the buffer + ;; (with no trailing newline) from being deleted. It's a + ;; bizarre fix that I ought to document at some point, but I am + ;; too busy at the moment to do so. + (if (and kill-whole-line (eobp)) (throw 'return nil)) + (save-excursion + (paredit-handle-sexp-errors (forward-sexp) + (up-list) + (setq end-of-list-p (eq (point-at-eol) eol)) + (throw 'return nil)) + (if (or (and (not firstp) + (not kill-whole-line) + (eobp)) + (paredit-handle-sexp-errors + (progn (backward-sexp) nil) + t) + (not (eq (point-at-eol) eol))) + (throw 'return nil))) + (forward-sexp) + (if (and firstp + (not kill-whole-line) + (eobp)) + (throw 'return nil)) + (setq firstp nil))) + end-of-list-p)) + +(defun paredit-kill-sexps-on-whole-line (beginning) + (kill-region beginning + (or (save-excursion ; Delete trailing indentation... + (paredit-skip-whitespace t) + (and (not (eq (char-after) ?\; )) + (point))) + ;; ...or just use the point past the newline, if + ;; we encounter a comment. + (point-at-eol))) + (cond ((save-excursion (paredit-skip-whitespace nil (point-at-bol)) + (bolp)) + ;; Nothing but indentation before the point, so indent it. + (lisp-indent-line)) + ((eobp) nil) ; Protect the CHAR-SYNTAX below against NIL. + ;; Insert a space to avoid invalid joining if necessary. + ((let ((syn-before (char-syntax (char-before))) + (syn-after (char-syntax (char-after)))) + (or (and (eq syn-before ?\) ) ; Separate opposing + (eq syn-after ?\( )) ; parentheses, + (and (eq syn-before ?\" ) ; string delimiter + (eq syn-after ?\" )) ; pairs, + (and (memq syn-before '(?_ ?w)) ; or word or symbol + (memq syn-after '(?_ ?w))))) ; constituents. + (insert " ")))) + +;;;;; Killing Words + +;;; This is tricky and asymmetrical because backward parsing is +;;; extraordinarily difficult or impossible, so we have to implement +;;; killing in both directions by parsing forward. + +(defun paredit-forward-kill-word () + "Kill a word forward, skipping over intervening delimiters." + (interactive) + (let ((beginning (point))) + (skip-syntax-forward " -") + (let* ((parse-state (paredit-current-parse-state)) + (state (paredit-kill-word-state parse-state 'char-after))) + (while (not (or (eobp) + (eq ?w (char-syntax (char-after))))) + (setq parse-state + (progn (forward-char 1) (paredit-current-parse-state)) +;; (parse-partial-sexp (point) (1+ (point)) +;; nil nil parse-state) + ) + (let* ((old-state state) + (new-state + (paredit-kill-word-state parse-state 'char-after))) + (cond ((not (eq old-state new-state)) + (setq parse-state + (paredit-kill-word-hack old-state + new-state + parse-state)) + (setq state + (paredit-kill-word-state parse-state + 'char-after)) + (setq beginning (point))))))) + (goto-char beginning) + (kill-word 1))) + +(defun paredit-backward-kill-word () + "Kill a word backward, skipping over any intervening delimiters." + (interactive) + (if (not (or (bobp) + (eq (char-syntax (char-before)) ?w))) + (let ((end (point))) + (backward-word 1) + (forward-word 1) + (goto-char (min end (point))) + (let* ((parse-state (paredit-current-parse-state)) + (state + (paredit-kill-word-state parse-state 'char-before))) + (while (and (< (point) end) + (progn + (setq parse-state + (parse-partial-sexp (point) (1+ (point)) + nil nil parse-state)) + (or (eq state + (paredit-kill-word-state parse-state + 'char-before)) + (progn (backward-char 1) nil))))) + (if (and (eq state 'comment) + (eq ?\# (char-after (point))) + (eq ?\| (char-before (point)))) + (backward-char 1))))) + (backward-kill-word 1)) + +;;;;;; Word-Killing Auxiliaries + +(defun paredit-kill-word-state (parse-state adjacent-char-fn) + (cond ((paredit-in-comment-p parse-state) 'comment) + ((paredit-in-string-p parse-state) 'string) + ((memq (char-syntax (funcall adjacent-char-fn)) + '(?\( ?\) )) + 'delimiter) + (t 'other))) + +;;; This optionally advances the point past any comment delimiters that +;;; should probably not be touched, based on the last state change and +;;; the characters around the point. It returns a new parse state, +;;; starting from the PARSE-STATE parameter. + +(defun paredit-kill-word-hack (old-state new-state parse-state) + (cond ((and (not (eq old-state 'comment)) + (not (eq new-state 'comment)) + (not (paredit-in-string-escape-p)) + (eq ?\# (char-before)) + (eq ?\| (char-after))) + (forward-char 1) + (paredit-current-parse-state) +;; (parse-partial-sexp (point) (1+ (point)) +;; nil nil parse-state) + ) + ((and (not (eq old-state 'comment)) + (eq new-state 'comment) + (eq ?\; (char-before))) + (skip-chars-forward ";") + (paredit-current-parse-state) +;; (parse-partial-sexp (point) (save-excursion +;; (skip-chars-forward ";")) +;; nil nil parse-state) + ) + (t parse-state))) + +(defun paredit-copy-as-kill () + "Save in the kill ring the region that `paredit-kill' would kill." + (interactive) + (cond ((paredit-in-string-p) + (paredit-copy-as-kill-in-string)) + ((paredit-in-comment-p) + (copy-region-as-kill (point) (point-at-eol))) + ((save-excursion (paredit-skip-whitespace t (point-at-eol)) + (or (eolp) (eq (char-after) ?\; ))) + ;** Be careful about trailing backslashes. + (save-excursion + (if (paredit-in-char-p) + (backward-char)) + (copy-region-as-kill (point) (point-at-eol)))) + (t (paredit-copy-sexps-as-kill)))) + +(defun paredit-copy-as-kill-in-string () + (save-excursion + (if (paredit-in-string-escape-p) + (backward-char)) + (copy-region-as-kill (point) + (min (point-at-eol) + (cdr (paredit-string-start+end-points)))))) + +(defun paredit-copy-sexps-as-kill () + (save-excursion + (if (paredit-in-char-p) + (backward-char 2)) + (let ((beginning (point)) + (eol (point-at-eol))) + (let ((end-of-list-p (paredit-forward-sexps-to-kill beginning eol))) + (if end-of-list-p (progn (up-list) (backward-char))) + (copy-region-as-kill beginning + (cond (kill-whole-line + (or (save-excursion + (paredit-skip-whitespace t) + (and (not (eq (char-after) ?\; )) + (point))) + (point-at-eol))) + ((and (not end-of-list-p) + (eq (point-at-eol) eol)) + eol) + (t + (point)))))))) + +;;;; Deleting Regions + +(defun paredit-delete-region (start end) + "Delete the text between point and mark, like `delete-region'. +If that text is unbalanced, signal an error instead. +With a prefix argument, skip the balance check." + (interactive "r") + (if (and start end (not current-prefix-arg)) + (paredit-check-region-for-delete start end)) + (setq this-command 'delete-region) + (delete-region start end)) + +(defun paredit-kill-region (start end) + "Kill the text between point and mark, like `kill-region'. +If that text is unbalanced, signal an error instead. +With a prefix argument, skip the balance check." + (interactive "r") + (if (and start end (not current-prefix-arg)) + (paredit-check-region-for-delete start end)) + (setq this-command 'kill-region) + (kill-region start end)) + +(defun paredit-check-region-for-delete (start end) + "Signal an error deleting text between START and END is unsafe." + (save-excursion + (goto-char start) + (let* ((start-state (paredit-current-parse-state)) + (end-state (parse-partial-sexp start end nil nil start-state))) + (paredit-check-region-for-delete:depth start start-state end end-state) + (paredit-check-region-for-delete:string start start-state end end-state) + (paredit-check-region-for-delete:comment start start-state end end-state) + (paredit-check-region-for-delete:char-quote start start-state + end end-state)))) + +(defun paredit-check-region-for-delete:depth (start start-state end end-state) + (let ((start-depth (nth 0 start-state)) + (end-depth (nth 0 end-state))) + (if (not (= start-depth end-depth)) + (error "Mismatched parenthesis depth: %S at start, %S at end." + start-depth + end-depth)))) + +(defun paredit-check-region-for-delete:string (start start-state end end-state) + (let ((start-string-p (nth 3 start-state)) + (end-string-p (nth 3 end-state))) + (if (not (eq start-string-p end-string-p)) + (error "Mismatched string state: start %sin string, end %sin string." + (if start-string-p "" "not ") + (if end-string-p "" "not "))))) + +(defun paredit-check-region-for-delete:comment + (start start-state end end-state) + (let ((start-comment-state (nth 4 start-state)) + (end-comment-state (nth 4 end-state))) + (if (not (or (eq start-comment-state end-comment-state) + ;; If we are moving text into or out of a line + ;; comment, make sure that the text is balanced. (The + ;; comment state may be a number, not t or nil at all, + ;; for nestable comments, which are not handled by + ;; this heuristic (or any of paredit, really).) + (and (or (and (eq start-comment-state nil) + (eq end-comment-state t)) + (and (eq start-comment-state t) + (eq end-comment-state nil))) + (save-excursion + (goto-char end) + (paredit-region-ok-p (point) (point-at-eol)))))) + (error "Mismatched comment state: %s" + (cond ((and (integerp start-comment-state) + (integerp end-comment-state)) + (format "depth %S at start, depth %S at end." + start-comment-state + end-comment-state)) + ((integerp start-comment-state) + "start in nested comment, end otherwise.") + ((integerp end-comment-state) + "end in nested comment, start otherwise.") + (start-comment-state + "start in comment, end not in comment.") + (end-comment-state + "end in comment, start not in comment.") + (t + (format "start %S, end %S." + start-comment-state + end-comment-state))))))) + +(defun paredit-check-region-for-delete:char-quote + (start start-state end end-state) + (let ((start-char-quote (nth 5 start-state)) + (end-char-quote (nth 5 end-state))) + (if (not (eq start-char-quote end-char-quote)) + (let ((phrase "character quotation")) + (error "Mismatched %s: start %sin %s, end %sin %s." + phrase + (if start-char-quote "" "not ") + phrase + (if end-char-quote "" "not ") + phrase))))) + +;;;; Point Motion + +(eval-and-compile + (defmacro defun-motion (name bvl doc &rest body) + `(defun ,name ,bvl + ,doc + ,(xcond ((paredit-xemacs-p) + '(interactive "_")) + ((paredit-gnu-emacs-p) + ;++ Not sure this is sufficient for the `^'. + (if (fboundp 'handle-shift-selection) + '(interactive "^p") + '(interactive "p")))) + ,@body))) + +(defun-motion paredit-forward (&optional arg) + "Move forward an S-expression, or up an S-expression forward. +If there are no more S-expressions in this one before the closing + delimiter, move past that closing delimiter; otherwise, move forward + past the S-expression following the point." + (let ((n (or arg 1))) + (cond ((< 0 n) (dotimes (i n) (paredit-move-forward))) + ((< n 0) (dotimes (i (- n)) (paredit-move-backward)))))) + +(defun-motion paredit-backward (&optional arg) + "Move backward an S-expression, or up an S-expression backward. +If there are no more S-expressions in this one before the opening + delimiter, move past that opening delimiter backward; otherwise, move + move backward past the S-expression preceding the point." + (let ((n (or arg 1))) + (cond ((< 0 n) (dotimes (i n) (paredit-move-backward))) + ((< n 0) (dotimes (i (- n)) (paredit-move-forward)))))) + +(defun paredit-move-forward () + (cond ((paredit-in-string-p) + (let ((end (paredit-enclosing-string-end))) + ;; `forward-sexp' and `up-list' may move into the next string + ;; in the buffer. Don't do that; move out of the current one. + (if (paredit-handle-sexp-errors + (progn (paredit-handle-sexp-errors (forward-sexp) + (up-list)) + (<= end (point))) + t) + (goto-char end)))) + ((paredit-in-char-p) + (forward-char)) + (t + (paredit-handle-sexp-errors (forward-sexp) + (up-list))))) + +(defun paredit-move-backward () + (cond ((paredit-in-string-p) + (let ((start (paredit-enclosing-string-start))) + (if (paredit-handle-sexp-errors + (progn (paredit-handle-sexp-errors (backward-sexp) + (backward-up-list)) + (<= (point) start)) + t) + (goto-char start)))) + ((paredit-in-char-p) + ;++ Corner case: a buffer of `\|x'. What to do? + (backward-char 2)) + (t + (paredit-handle-sexp-errors (backward-sexp) + (backward-up-list))))) + +;;;; Window Positioning + +(defalias 'paredit-recentre-on-sexp 'paredit-recenter-on-sexp) + +(defun paredit-recenter-on-sexp (&optional n) + "Recenter the screen on the S-expression following the point. +With a prefix argument N, encompass all N S-expressions forward." + (interactive "P") + (let* ((p (point)) + (end-point (progn (forward-sexp n) (point))) + (start-point (progn (goto-char end-point) (backward-sexp n) (point)))) + ;; Point is at beginning of first S-expression. + (let ((p-visible nil) (start-visible nil)) + (save-excursion + (forward-line (/ (count-lines start-point end-point) 2)) + (recenter) + (setq p-visible (pos-visible-in-window-p p)) + (setq start-visible (pos-visible-in-window-p start-point))) + (cond ((not start-visible) + ;; Implies (not p-visible). Put the start at the top of + ;; the screen. + (recenter 0)) + (p-visible + ;; Go back to p if we can. + (goto-char p)))))) + +(defun paredit-recenter-on-defun () + "Recenter the screen on the definition at point." + (interactive) + (save-excursion + (beginning-of-defun) + (paredit-recenter-on-sexp))) + +(defun paredit-focus-on-defun () + "Moves display to the top of the definition at point." + (interactive) + (beginning-of-defun) + (recenter 0)) + +;;;; Generalized Upward/Downward Motion + +(defun paredit-up/down (n vertical-direction) + (let ((horizontal-direction (if (< 0 n) +1 -1))) + (while (/= n 0) + (goto-char + (paredit-next-up/down-point horizontal-direction vertical-direction)) + (setq n (- n horizontal-direction))))) + +(defun paredit-next-up/down-point (horizontal-direction vertical-direction) + (let ((state (paredit-current-parse-state)) + (scan-lists + (lambda () + (scan-lists (point) horizontal-direction vertical-direction)))) + (cond ((paredit-in-string-p state) + (let ((start+end (paredit-string-start+end-points state))) + (if (< 0 vertical-direction) + (if (< 0 horizontal-direction) + (+ 1 (cdr start+end)) + (car start+end)) + ;; We could let the user try to descend into lists + ;; within the string, but that would be asymmetric + ;; with the up case, which rises out of the whole + ;; string and not just out of a list within the + ;; string, so this case will just be an error. + (error "Can't descend further into string.")))) + ((< 0 vertical-direction) + ;; When moving up, just try to rise up out of the list. + (or (funcall scan-lists) + (buffer-end horizontal-direction))) + ((< vertical-direction 0) + ;; When moving down, look for a string closer than a list, + ;; and use that if we find it. + (let* ((list-start + (paredit-handle-sexp-errors (funcall scan-lists) nil)) + (string-start + (paredit-find-next-string-start horizontal-direction + list-start))) + (if (and string-start list-start) + (if (< 0 horizontal-direction) + (min string-start list-start) + (max string-start list-start)) + (or string-start + ;; Scan again: this is a kludgey way to report the + ;; error if there really was one. + (funcall scan-lists) + (buffer-end horizontal-direction))))) + (t + (error "Vertical direction must be nonzero in `%s'." + 'paredit-up/down))))) + +(defun paredit-find-next-string-start (horizontal-direction limit) + (let ((buffer-limit-p (if (< 0 horizontal-direction) 'eobp 'bobp)) + (next-char (if (< 0 horizontal-direction) 'char-after 'char-before)) + (pastp (if (< 0 horizontal-direction) '> '<))) + (paredit-handle-sexp-errors + (save-excursion + (catch 'exit + (while t + (if (or (funcall buffer-limit-p) + (and limit (funcall pastp (point) limit))) + (throw 'exit nil)) + (forward-sexp horizontal-direction) + (save-excursion + (backward-sexp horizontal-direction) + (if (eq ?\" (char-syntax (funcall next-char))) + (throw 'exit (+ (point) horizontal-direction))))))) + nil))) + +(defun-motion paredit-forward-down (&optional argument) + "Move forward down into a list. +With a positive argument, move forward down that many levels. +With a negative argument, move backward down that many levels." + (paredit-up/down (or argument +1) -1)) + +(defun-motion paredit-backward-up (&optional argument) + "Move backward up out of the enclosing list. +With a positive argument, move backward up that many levels. +With a negative argument, move forward up that many levels. +If in a string initially, that counts as one level." + (paredit-up/down (- 0 (or argument +1)) +1)) + +(defun-motion paredit-forward-up (&optional argument) + "Move forward up out of the enclosing list. +With a positive argument, move forward up that many levels. +With a negative argument, move backward up that many levels. +If in a string initially, that counts as one level." + (paredit-up/down (or argument +1) +1)) + +(defun-motion paredit-backward-down (&optional argument) + "Move backward down into a list. +With a positive argument, move backward down that many levels. +With a negative argument, move forward down that many levels." + (paredit-up/down (- 0 (or argument +1)) -1)) + +;;;; Depth-Changing Commands: Wrapping, Splicing, & Raising + +(defun paredit-wrap-sexp (&optional argument open close) + "Wrap the following S-expression. +If a `C-u' prefix argument is given, wrap all S-expressions following + the point until the end of the buffer or of the enclosing list. +If a numeric prefix argument N is given, wrap N S-expressions. +Automatically indent the newly wrapped S-expression. +As a special case, if the point is at the end of a list, simply insert + a parenthesis pair, rather than inserting a lone opening delimiter + and then signalling an error, in the interest of preserving + structure. +By default OPEN and CLOSE are round delimiters." + (interactive "P") + (paredit-lose-if-not-in-sexp 'paredit-wrap-sexp) + (let ((open (or open ?\( )) + (close (or close ?\) ))) + (paredit-handle-sexp-errors + ((lambda (n) (paredit-insert-pair n open close 'goto-char)) + (cond ((integerp argument) argument) + ((consp argument) (paredit-count-sexps-forward)) + ((paredit-region-active-p) nil) + (t 1))) + (insert close) + (backward-char))) + (save-excursion (backward-up-list) (indent-sexp))) + +(defun paredit-yank-pop (&optional argument) + "Replace just-yanked text with the next item in the kill ring. +If this command follows a `yank', just run `yank-pop'. +If this command follows a `paredit-wrap-sexp', or any other paredit + wrapping command (see `paredit-wrap-commands'), run `yank' and + reindent the enclosing S-expression. +If this command is repeated, run `yank-pop' and reindent the enclosing + S-expression. + +The argument is passed on to `yank' or `yank-pop'; see their + documentation for details." + (interactive "*p") + (cond ((eq last-command 'yank) + (yank-pop argument)) + ((memq last-command paredit-wrap-commands) + (yank argument) + ;; `yank' futzes with `this-command'. + (setq this-command 'paredit-yank-pop) + (save-excursion (backward-up-list) (indent-sexp))) + ((eq last-command 'paredit-yank-pop) + ;; Pretend we just did a `yank', so that we can use + ;; `yank-pop' without duplicating its definition. + (setq last-command 'yank) + (yank-pop argument) + ;; Return to our original state. + (setq last-command 'paredit-yank-pop) + (setq this-command 'paredit-yank-pop) + (save-excursion (backward-up-list) (indent-sexp))) + (t (error "Last command was not a yank or a wrap: %s" last-command)))) + +(defun paredit-splice-sexp (&optional argument) + "Splice the list that the point is on by removing its delimiters. +With a prefix argument as in `C-u', kill all S-expressions backward in + the current list before splicing all S-expressions forward into the + enclosing list. +With two prefix arguments as in `C-u C-u', kill all S-expressions + forward in the current list before splicing all S-expressions + backward into the enclosing list. +With a numerical prefix argument N, kill N S-expressions backward in + the current list before splicing the remaining S-expressions into the + enclosing list. If N is negative, kill forward. +Inside a string, unescape all backslashes, or signal an error if doing + so would invalidate the buffer's structure." + (interactive "P") + (if (paredit-in-string-p) + (paredit-splice-string argument) + (if (paredit-in-comment-p) + (error "Can't splice comment.")) + (paredit-handle-sexp-errors (paredit-enclosing-list-start) + (error "Can't splice top level.")) + (paredit-kill-surrounding-sexps-for-splice argument) + (let ((delete-start (paredit-enclosing-list-start)) + (delete-end + (let ((limit + (save-excursion + (paredit-ignore-sexp-errors (forward-sexp) (backward-sexp)) + (point)))) + (save-excursion + (backward-up-list) + (forward-char +1) + (paredit-skip-whitespace t limit) + (point))))) + (let ((end-marker (make-marker))) + (save-excursion + (up-list) + (delete-char -1) + (set-marker end-marker (point))) + (delete-region delete-start delete-end) + (paredit-splice-reindent delete-start (marker-position end-marker)))))) + +(defun paredit-splice-reindent (start end) + (paredit-preserving-column + ;; If we changed the first subform of the enclosing list, we must + ;; reindent the whole enclosing list. + (if (paredit-handle-sexp-errors + (save-excursion + (backward-up-list) + (down-list) + (paredit-ignore-sexp-errors (forward-sexp)) + (< start (point))) + nil) + (save-excursion (backward-up-list) (indent-sexp)) + (paredit-indent-region start end)))) + +(defun paredit-kill-surrounding-sexps-for-splice (argument) + (cond ((or (paredit-in-string-p) + (paredit-in-comment-p)) + (error "Invalid context for splicing S-expressions.")) + ((or (not argument) (eq argument 0)) nil) + ((or (numberp argument) (eq argument '-)) + ;; Kill S-expressions before/after the point by saving the + ;; point, moving across them, and killing the region. + (let* ((argument (if (eq argument '-) -1 argument)) + (saved (paredit-point-at-sexp-boundary (- argument)))) + (goto-char saved) + (paredit-ignore-sexp-errors (backward-sexp argument)) + (paredit-hack-kill-region saved (point)))) + ((consp argument) + (let ((v (car argument))) + (if (= v 4) ;One `C-u'. + ;; Move backward until we hit the open paren; then + ;; kill that selected region. + (let ((end (point))) + (paredit-ignore-sexp-errors + (while (not (bobp)) + (backward-sexp))) + (paredit-hack-kill-region (point) end)) + ;; Move forward until we hit the close paren; then + ;; kill that selected region. + (let ((beginning (point))) + (paredit-ignore-sexp-errors + (while (not (eobp)) + (forward-sexp))) + (paredit-hack-kill-region beginning (point)))))) + (t (error "Bizarre prefix argument `%s'." argument)))) + +(defun paredit-splice-sexp-killing-backward (&optional n) + "Splice the list the point is on by removing its delimiters, and + also kill all S-expressions before the point in the current list. +With a prefix argument N, kill only the preceding N S-expressions." + (interactive "P") + (paredit-splice-sexp (if n + (prefix-numeric-value n) + '(4)))) + +(defun paredit-splice-sexp-killing-forward (&optional n) + "Splice the list the point is on by removing its delimiters, and + also kill all S-expressions after the point in the current list. +With a prefix argument N, kill only the following N S-expressions." + (interactive "P") + (paredit-splice-sexp (if n + (- (prefix-numeric-value n)) + '(16)))) + +(defun paredit-raise-sexp (&optional argument) + "Raise the following S-expression in a tree, deleting its siblings. +With a prefix argument N, raise the following N S-expressions. If N + is negative, raise the preceding N S-expressions. +If the point is on an S-expression, such as a string or a symbol, not + between them, that S-expression is considered to follow the point." + (interactive "P") + (save-excursion + (cond ((paredit-in-string-p) + (goto-char (car (paredit-string-start+end-points)))) + ((paredit-in-char-p) + (backward-sexp)) + ((paredit-in-comment-p) + (error "No S-expression to raise in comment."))) + ;; Select the S-expressions we want to raise in a buffer substring. + (let* ((n (prefix-numeric-value argument)) + (bound (scan-sexps (point) n)) + (sexps + (if (< n 0) + (buffer-substring bound (paredit-point-at-sexp-end)) + (buffer-substring (paredit-point-at-sexp-start) bound)))) + ;; Move up to the list we're raising those S-expressions out of and + ;; delete it. + (backward-up-list) + (delete-region (point) (scan-sexps (point) 1)) + (let* ((indent-start (point)) + (indent-end (save-excursion (insert sexps) (point)))) + ;; If the expression spans multiple lines, its indentation is + ;; probably broken, so reindent it -- but don't reindent + ;; anything that we didn't touch outside the expression. + ;; + ;; XXX What if the *column* of the starting point was preserved + ;; too? Should we avoid reindenting in that case? + (if (not (eq (save-excursion (goto-char indent-start) (point-at-eol)) + (save-excursion (goto-char indent-end) (point-at-eol)))) + (indent-region indent-start indent-end nil)))))) + +;;; The effects of convolution on the surrounding whitespace are pretty +;;; random. If you have better suggestions, please let me know. + +(defun paredit-convolute-sexp (&optional n) + "Convolute S-expressions. +Save the S-expressions preceding point and delete them. +Splice the S-expressions following point. +Wrap the enclosing list in a new list prefixed by the saved text. +With a prefix argument N, move up N lists before wrapping." + (interactive "p") + (paredit-lose-if-not-in-sexp 'paredit-convolute-sexp) + ;; Make sure we can move up before destroying anything. + (save-excursion (backward-up-list n) (backward-up-list)) + (let (open close) ;++ Is this a good idea? + (let ((prefix + (let ((end (point))) + (paredit-ignore-sexp-errors + (while (not (bobp)) (backward-sexp))) + (prog1 (buffer-substring (point) end) + (backward-up-list) + (save-excursion (forward-sexp) + (setq close (char-before)) + (delete-char -1)) + (setq open (char-after)) + (delete-region (point) end) + ;; I'm not sure this makes sense... + (if (not (eolp)) (just-one-space)))))) + (backward-up-list n) + (paredit-insert-pair 1 open close 'goto-char) + (insert prefix) + ;; I'm not sure this makes sense either... + (if (not (eolp)) (just-one-space)) + (save-excursion + (backward-up-list) + (paredit-ignore-sexp-errors (indent-sexp)))))) + +(defun paredit-splice-string (argument) + (let ((original-point (point)) + (start+end (paredit-string-start+end-points))) + (let ((start (car start+end)) + (end (cdr start+end))) + ;; START and END both lie before the respective quote + ;; characters, which we want to delete; thus we increment START + ;; by one to extract the string, and we increment END by one to + ;; delete the string. + (let* ((escaped-string + (cond ((not (consp argument)) + (buffer-substring (1+ start) end)) + ((= 4 (car argument)) + (buffer-substring original-point end)) + (t + (buffer-substring (1+ start) original-point)))) + (unescaped-string + (paredit-unescape-string escaped-string))) + (if (not unescaped-string) + (error "Unspliceable string.") + (save-excursion + (goto-char start) + (delete-region start (1+ end)) + (insert unescaped-string)) + (if (not (and (consp argument) + (= 4 (car argument)))) + (goto-char (- original-point 1)))))))) + +(defun paredit-unescape-string (string) + (with-temp-buffer + (insert string) + (goto-char (point-min)) + (while (and (not (eobp)) + ;; nil -> no bound; t -> no errors. + (search-forward "\\" nil t)) + (delete-char -1) + (forward-char)) + (paredit-handle-sexp-errors + (progn (scan-sexps (point-min) (point-max)) + (buffer-string)) + nil))) + +;;;; Slurpage & Barfage + +(defun paredit-forward-slurp-sexp (&optional argument) + "Add the S-expression following the current list into that list + by moving the closing delimiter. +Automatically reindent the newly slurped S-expression with respect to + its new enclosing form. +If in a string, move the opening double-quote forward by one + S-expression and escape any intervening characters as necessary, + without altering any indentation or formatting." + (interactive "P") + (save-excursion + (cond ((paredit-in-comment-p) + (error "Invalid context for slurping S-expressions.")) + ((numberp argument) + (if (< argument 0) + (paredit-forward-barf-sexp (- 0 argument)) + (while (< 0 argument) + (paredit-forward-slurp-sexp) + (setq argument (- argument 1))))) + ((paredit-in-string-p) + ;; If there is anything to slurp into the string, take that. + ;; Otherwise, try to slurp into the enclosing list. + (if (save-excursion + (goto-char (paredit-enclosing-string-end)) + (paredit-handle-sexp-errors (progn (forward-sexp) nil) + t)) + (progn + (goto-char (paredit-enclosing-string-end)) + (paredit-forward-slurp-into-list argument)) + (paredit-forward-slurp-into-string argument))) + (t + (paredit-forward-slurp-into-list argument))))) + +(defun paredit-forward-slurp-into-list (&optional argument) + (let ((nestedp nil)) + (save-excursion + (up-list) ; Up to the end of the list to + (let ((close (char-before))) ; save and delete the closing + (delete-char -1) ; delimiter. + (let ((start (point))) + (catch 'return ; Go to the end of the desired + (while t ; S-expression, going up a + (paredit-handle-sexp-errors ; list if it's not in this, + (progn (forward-sexp) + (if argument + (paredit-ignore-sexp-errors + (while (not (eobp)) + (forward-sexp)))) + (throw 'return nil)) + (setq nestedp t) + (up-list) + (setq close ; adjusting for mixed + (prog1 (char-before) ; delimiters as necessary, + (delete-char -1) + (insert close)))))) + (insert close) ; to insert that delimiter. + (indent-region start (point) nil)))) + (if (and (not nestedp) + (eq (save-excursion (paredit-skip-whitespace nil) (point)) + (save-excursion (backward-up-list) (forward-char) (point))) + (eq (save-excursion (forward-sexp) (backward-sexp) (point)) + (save-excursion (paredit-skip-whitespace t) (point)))) + (delete-region (save-excursion (paredit-skip-whitespace nil) (point)) + (save-excursion (paredit-skip-whitespace t) (point)))))) + +(defun paredit-forward-slurp-into-string (&optional argument) + (let ((start (paredit-enclosing-string-start)) + (end (paredit-enclosing-string-end))) + (goto-char end) + ;; Signal any errors that we might get first, before mucking with + ;; the buffer's contents. + (save-excursion (forward-sexp)) + (let ((close (char-before))) + ;; Skip intervening whitespace if we're slurping into an empty + ;; string. XXX What about nonempty strings? + (if (and (= (+ start 2) end) + (eq (save-excursion (paredit-skip-whitespace t) (point)) + (save-excursion (forward-sexp) (backward-sexp) (point)))) + (delete-region (- (point) 1) + (save-excursion (paredit-skip-whitespace t) (point))) + (delete-char -1)) + (paredit-forward-for-quote + (save-excursion + (forward-sexp) + (if argument + (while (paredit-handle-sexp-errors (progn (forward-sexp) t) nil))) + (point))) + (insert close)))) + +(defun paredit-forward-barf-sexp (&optional argument) + "Remove the last S-expression in the current list from that list + by moving the closing delimiter. +Automatically reindent the newly barfed S-expression with respect to + its new enclosing form." + (interactive "P") + (paredit-lose-if-not-in-sexp 'paredit-forward-barf-sexp) + (if (and (numberp argument) (< argument 0)) + (paredit-forward-slurp-sexp (- 0 argument)) + (let ((start (point)) (end nil)) + (save-excursion + (up-list) ; Up to the end of the list to + (let ((close (char-before))) ; save and delete the closing + (delete-char -1) ; delimiter. + (setq end (point)) + (paredit-ignore-sexp-errors ; Go back to where we want to + (if (or (not argument) ; insert the delimiter. + (numberp argument)) + (backward-sexp argument) + (while (paredit-handle-sexp-errors + (save-excursion (backward-sexp) (<= start (point))) + nil) + (backward-sexp)))) + (paredit-skip-whitespace nil) ; Skip leading whitespace. + (cond ((bobp) + ;++ We'll have deleted the close, but there's no open. + ;++ Is that OK? + (error "Barfing all subexpressions with no open-paren?")) + ((paredit-in-comment-p) ; Don't put the close-paren in + (newline))) ; a comment. + (insert close)) + ;; Reindent all of the newly barfed S-expressions. Start at the + ;; start of the first barfed S-expression, not at the close we + ;; just inserted. + (forward-sexp) + (backward-sexp) + (if (or (not argument) (numberp argument)) + (paredit-forward-and-indent argument) + (indent-region (point) end)))))) + +(defun paredit-backward-slurp-sexp (&optional argument) + "Add the S-expression preceding the current list into that list + by moving the closing delimiter. +Automatically reindent the whole form into which new S-expression was + slurped. +If in a string, move the opening double-quote backward by one + S-expression and escape any intervening characters as necessary, + without altering any indentation or formatting." + (interactive "P") + (save-excursion + (cond ((paredit-in-comment-p) + (error "Invalid context for slurping S-expressions.")) + ((numberp argument) + (if (< argument 0) + (paredit-backward-barf-sexp (- 0 argument)) + (while (< 0 argument) + (paredit-backward-slurp-sexp) + (setq argument (- argument 1))))) + ((paredit-in-string-p) + ;; If there is anything to slurp into the string, take that. + ;; Otherwise, try to slurp into the enclosing list. + (if (save-excursion + (goto-char (paredit-enclosing-string-start)) + (paredit-handle-sexp-errors (progn (backward-sexp) nil) + t)) + (progn + (goto-char (paredit-enclosing-string-start)) + (paredit-backward-slurp-into-list argument)) + (paredit-backward-slurp-into-string argument))) + (t + (paredit-backward-slurp-into-list argument))))) + +(defun paredit-backward-slurp-into-list (&optional argument) + (let ((nestedp nil)) + (save-excursion + (backward-up-list) + (let ((open (char-after))) + (delete-char +1) + (catch 'return + (while t + (paredit-handle-sexp-errors + (progn (backward-sexp) + (if argument + (paredit-ignore-sexp-errors + (while (not (bobp)) + (backward-sexp)))) + (throw 'return nil)) + (setq nestedp t) + (backward-up-list) + (setq open + (prog1 (char-after) + (save-excursion (insert open) (delete-char +1))))))) + (insert open)) + ;; Reindent the line at the beginning of wherever we inserted the + ;; opening delimiter, and then indent the whole S-expression. + (backward-up-list) + (lisp-indent-line) + (indent-sexp)) + ;; If we slurped into an empty list, don't leave dangling space: + ;; (foo |). + (if (and (not nestedp) + (eq (save-excursion (paredit-skip-whitespace nil) (point)) + (save-excursion (backward-sexp) (forward-sexp) (point))) + (eq (save-excursion (up-list) (backward-char) (point)) + (save-excursion (paredit-skip-whitespace t) (point)))) + (delete-region (save-excursion (paredit-skip-whitespace nil) (point)) + (save-excursion (paredit-skip-whitespace t) (point)))))) + +(defun paredit-backward-slurp-into-string (&optional argument) + (let ((start (paredit-enclosing-string-start)) + (end (paredit-enclosing-string-end))) + (goto-char start) + ;; Signal any errors that we might get first, before mucking with + ;; the buffer's contents. + (save-excursion (backward-sexp)) + (let ((open (char-after)) + (target (point))) + ;; Skip intervening whitespace if we're slurping into an empty + ;; string. XXX What about nonempty strings? + (if (and (= (+ start 2) end) + (eq (save-excursion (paredit-skip-whitespace nil) (point)) + (save-excursion (backward-sexp) (forward-sexp) (point)))) + (delete-region (save-excursion (paredit-skip-whitespace nil) (point)) + (+ (point) 1)) + (delete-char +1)) + (backward-sexp) + (if argument + (paredit-ignore-sexp-errors + (while (not (bobp)) + (backward-sexp)))) + (insert open) + (paredit-forward-for-quote target)))) + +(defun paredit-backward-barf-sexp (&optional argument) + "Remove the first S-expression in the current list from that list + by moving the closing delimiter. +Automatically reindent the barfed S-expression and the form from which + it was barfed." + (interactive "P") + (paredit-lose-if-not-in-sexp 'paredit-backward-barf-sexp) + (if (and (numberp argument) (< argument 0)) + (paredit-backward-slurp-sexp (- 0 argument)) + (let ((end (make-marker))) + (set-marker end (point)) + (save-excursion + (backward-up-list) + (let ((open (char-after))) + (delete-char +1) + (paredit-ignore-sexp-errors + (paredit-forward-and-indent + (if (or (not argument) (numberp argument)) + argument + (let ((n 0)) + (save-excursion + (while (paredit-handle-sexp-errors + (save-excursion + (forward-sexp) + (<= (point) end)) + nil) + (forward-sexp) + (setq n (+ n 1)))) + n)))) + (while (progn (paredit-skip-whitespace t) (eq (char-after) ?\; )) + (forward-line 1)) + (if (eobp) + ;++ We'll have deleted the close, but there's no open. + ;++ Is that OK? + (error "Barfing all subexpressions with no close-paren?")) + ;** Don't use `insert' here. Consider, e.g., barfing from + ;** (foo|) + ;** and how `save-excursion' works. + (insert-before-markers open)) + (backward-up-list) + (lisp-indent-line) + (indent-sexp))))) + +;;;; Splitting & Joining + +(defun paredit-split-sexp () + "Split the list or string the point is on into two." + (interactive) + (cond ((paredit-in-string-p) + (insert "\"") + (save-excursion (insert " \""))) + ((or (paredit-in-comment-p) + (paredit-in-char-p)) + (error "Invalid context for splitting S-expression.")) + (t + (let ((open (save-excursion (backward-up-list) (char-after))) + (close (save-excursion (up-list) (char-before)))) + (delete-horizontal-space) + (insert close) + (save-excursion + (insert ?\ ) + (insert open) + (backward-char) + (indent-sexp)))))) + +(defun paredit-join-sexps () + "Join the S-expressions adjacent on either side of the point. +Both must be lists, strings, or atoms; error if there is a mismatch." + (interactive) + (cond ((paredit-in-comment-p) (error "Can't join S-expressions in comment.")) + ((paredit-in-string-p) (error "Nothing to join in a string.")) + ((paredit-in-char-p) (error "Can't join characters."))) + (let ((left-point (paredit-point-at-sexp-end)) + (right-point (paredit-point-at-sexp-start))) + (let ((left-char (char-before left-point)) + (right-char (char-after right-point))) + (let ((left-syntax (char-syntax left-char)) + (right-syntax (char-syntax right-char))) + (cond ((< right-point left-point) + (error "Can't join a datum with itself.")) + ((and (eq left-syntax ?\) ) + (eq right-syntax ?\( ) + (eq left-char (matching-paren right-char)) + (eq right-char (matching-paren left-char))) + (paredit-join-lists-internal left-point right-point) + (paredit-preserving-column + (save-excursion + (backward-up-list) + (indent-sexp)))) + ((and (eq left-syntax ?\" ) + (eq right-syntax ?\" )) + ;; Delete any intermediate formatting. + (delete-region (1- left-point) (1+ right-point))) + ((and (memq left-syntax '(?w ?_)) ; Word or symbol + (memq right-syntax '(?w ?_))) + (delete-region left-point right-point)) + (t (error "Mismatched S-expressions to join."))))))) + +(defun paredit-join-lists-internal (left-point right-point) + (save-excursion + ;; Leave intermediate formatting alone. + (goto-char right-point) + (delete-char +1) + (goto-char left-point) + (delete-char -1) + ;; Kludge: Add an extra space in several conditions. + (if (or + ;; (foo)| ;x\n(bar) => (foo | ;x\nbar), not (foo| ;x\nbar). + (and (not (eolp)) + (save-excursion + (paredit-skip-whitespace t (point-at-eol)) + (eq (char-after) ?\;))) + ;; (foo)|(bar) => (foo| bar), not (foo|bar). + (and (= left-point right-point) + (not (or (eq ?\ (char-syntax (char-before))) + (eq ?\ (char-syntax (char-after))))))) + (insert ?\ )))) + +;++ How ought paredit-join to handle comments intervening symbols or strings? +;++ Idea: +;++ +;++ "foo" | ;bar +;++ "baz" ;quux +;++ +;++ => +;++ +;++ "foo|baz" ;bar +;++ ;quux +;++ +;++ The point should stay where it is relative to the comments, and the +;++ the comments' columns should all be preserved, perhaps. Hmmmm... +;++ What about this? +;++ +;++ "foo" ;bar +;++ | ;baz +;++ "quux" ;zot + +;++ Should rename: +;++ paredit-point-at-sexp-start -> paredit-start-of-sexp-after-point +;++ paredit-point-at-sexp-end -> paredit-end-of-sexp-before-point + +;;;; Variations on the Lurid Theme + +;;; I haven't the imagination to concoct clever names for these. + +(defun paredit-add-to-previous-list () + "Add the S-expression following point to the list preceding point." + (interactive) + (paredit-lose-if-not-in-sexp 'paredit-add-to-previous-list) + (save-excursion + (down-list -1) ;++ backward-down-list... + (paredit-forward-slurp-sexp))) + +(defun paredit-add-to-next-list () + "Add the S-expression preceding point to the list following point. +If no S-expression precedes point, move up the tree until one does." + (interactive) + (paredit-lose-if-not-in-sexp 'paredit-add-to-next-list) + (save-excursion + (down-list) + (paredit-backward-slurp-sexp))) + +(defun paredit-join-with-previous-list () + "Join the list the point is on with the previous list in the buffer." + (interactive) + (paredit-lose-if-not-in-sexp 'paredit-join-with-previous-list) + (save-excursion + (while (paredit-handle-sexp-errors (save-excursion (backward-sexp) nil) + (backward-up-list) + t)) + (paredit-join-sexps))) + +(defun paredit-join-with-next-list () + "Join the list the point is on with the next list in the buffer." + (interactive) + (paredit-lose-if-not-in-sexp 'paredit-join-with-next-list) + (save-excursion + (while (paredit-handle-sexp-errors (save-excursion (forward-sexp) nil) + (up-list) + t)) + (paredit-join-sexps))) + +;;;; Utilities + +(defun paredit-in-string-escape-p () + "True if the point is on a character escape of a string. +This is true only if the character is preceded by an odd number of + backslashes. +This assumes that `paredit-in-string-p' has already returned true." + (let ((oddp nil)) + (save-excursion + (while (eq (char-before) ?\\ ) + (setq oddp (not oddp)) + (backward-char))) + oddp)) + +(defun paredit-in-char-p (&optional position) + "True if point is on a character escape outside a string." + (save-excursion + (goto-char (or position (point))) + (paredit-in-string-escape-p))) + +(defun paredit-skip-whitespace (trailing-p &optional limit) + "Skip past any whitespace, or until the point LIMIT is reached. +If TRAILING-P is nil, skip leading whitespace; otherwise, skip trailing + whitespace." + (funcall (if trailing-p 'skip-chars-forward 'skip-chars-backward) + " \t\n " ; This should skip using the syntax table, but LF + limit)) ; is a comment end, not newline, in Lisp mode. + +(defalias 'paredit-region-active-p + (xcond ((paredit-xemacs-p) 'region-active-p) + ((paredit-gnu-emacs-p) + (lambda () + (and mark-active transient-mark-mode))))) + +(defun paredit-hack-kill-region (start end) + "Kill the region between START and END. +Do not append to any current kill, and + do not let the next kill append to this one." + (interactive "r") ;Eh, why not? + ;; KILL-REGION sets THIS-COMMAND to tell the next kill that the last + ;; command was a kill. It also checks LAST-COMMAND to see whether it + ;; should append. If we bind these locally, any modifications to + ;; THIS-COMMAND will be masked, and it will not see LAST-COMMAND to + ;; indicate that it should append. + (let ((this-command nil) + (last-command nil)) + (kill-region start end))) + +;;;;; Reindentation utilities + +;++ Should `paredit-indent-sexps' and `paredit-forward-and-indent' use +;++ `paredit-indent-region' rather than `indent-region'? + +(defun paredit-indent-sexps () + "If in a list, indent all following S-expressions in the list." + (let* ((start (point)) + (end (paredit-handle-sexp-errors (progn (up-list) (point)) nil))) + (if end + (indent-region start end nil)))) + +(defun paredit-forward-and-indent (&optional n) + "Move forward by N S-expressions, indenting them with `indent-region'." + (let ((start (point))) + (forward-sexp n) + (indent-region start (point) nil))) + +(defun paredit-indent-region (start end) + "Indent the region from START to END. +Don't reindent the line starting at START, however." + (if (not (<= start end)) + (error "Incorrectly related points: %S, %S" start end)) + (save-excursion + (goto-char start) + (let ((bol (point-at-bol))) + ;; Skip all S-expressions that end on the starting line, but + ;; don't go past `end'. + (if (and (save-excursion (goto-char end) (not (eq bol (point-at-bol)))) + (paredit-handle-sexp-errors + (catch 'exit + (while t + (save-excursion + (forward-sexp) + (if (not (eq bol (point-at-bol))) + (throw 'exit t)) + (if (not (< (point) end)) + (throw 'exit nil))) + (forward-sexp))) + nil)) + (progn + ;; Point is still on the same line, but precedes an + ;; S-expression that ends on a different line. + (if (not (eq bol (point-at-bol))) + (error "Internal error -- we moved forward a line!")) + (goto-char (+ 1 (point-at-eol))) + (if (not (<= (point) end)) + (error "Internal error -- we frobnitzed the garfnut!")) + (indent-region (point) end nil)))))) + +;;;;; S-expression Parsing Utilities + +;++ These routines redundantly traverse S-expressions a great deal. +;++ If performance issues arise, this whole section will probably have +;++ to be refactored to preserve the state longer, like paredit.scm +;++ does, rather than to traverse the definition N times for every key +;++ stroke as it presently does. + +(defun paredit-current-parse-state () + "Return parse state of point from beginning of defun." + (let ((point (point))) + (beginning-of-defun) + ;; Calling PARSE-PARTIAL-SEXP will advance the point to its second + ;; argument (unless parsing stops due to an error, but we assume it + ;; won't in paredit-mode). + (parse-partial-sexp (point) point))) + +(defun paredit-in-string-p (&optional state) + "True if the parse state is within a double-quote-delimited string. +If no parse state is supplied, compute one from the beginning of the + defun to the point." + ;; 3. non-nil if inside a string (the terminator character, really) + (and (nth 3 (or state (paredit-current-parse-state))) + t)) + +(defun paredit-string-start+end-points (&optional state) + "Return a cons of the points of open and close quotes of the string. +The string is determined from the parse state STATE, or the parse state + from the beginning of the defun to the point. +This assumes that `paredit-in-string-p' has already returned true, i.e. + that the point is already within a string." + (save-excursion + ;; 8. character address of start of comment or string; nil if not + ;; in one + (let ((start (nth 8 (or state (paredit-current-parse-state))))) + (goto-char start) + (forward-sexp 1) + (cons start (1- (point)))))) + +(defun paredit-enclosing-string-start () + (car (paredit-string-start+end-points))) + +(defun paredit-enclosing-string-end () + (+ 1 (cdr (paredit-string-start+end-points)))) + +(defun paredit-enclosing-list-start () + (save-excursion + (backward-up-list) + (point))) + +(defun paredit-enclosing-list-end () + (save-excursion + (up-list) + (point))) + +(defun paredit-in-comment-p (&optional state) + "True if parse state STATE is within a comment. +If no parse state is supplied, compute one from the beginning of the + defun to the point." + ;; 4. nil if outside a comment, t if inside a non-nestable comment, + ;; else an integer (the current comment nesting) + (and (nth 4 (or state (paredit-current-parse-state))) + t)) + +(defun paredit-prefix-numeric-value (argument) + ;++ Kludgerific. + (cond ((integerp argument) argument) + ((eq argument '-) -1) + ((consp argument) + (cond ((equal argument '(4)) (paredit-count-sexps-forward)) ;C-u + ((equal argument '(16)) (paredit-count-sexps-backward)) ;C-u C-u + (t (error "Invalid prefix argument: %S" argument)))) + ((paredit-region-active-p) + (save-excursion + (save-restriction + (narrow-to-region (region-beginning) (region-end)) + (cond ((= (point) (point-min)) (paredit-count-sexps-forward)) + ((= (point) (point-max)) (paredit-count-sexps-backward)) + (t + (error "Point %S is not start or end of region: %S..%S" + (point) (region-beginning) (region-end))))))) + (t 1))) + +(defun paredit-count-sexps-forward () + (save-excursion + (let ((n 0) (p nil)) ;hurk + (paredit-ignore-sexp-errors + (while (setq p (scan-sexps (point) +1)) + (goto-char p) + (setq n (+ n 1)))) + n))) + +(defun paredit-count-sexps-backward () + (save-excursion + (let ((n 0) (p nil)) ;hurk + (paredit-ignore-sexp-errors + (while (setq p (scan-sexps (point) -1)) + (goto-char p) + (setq n (+ n 1)))) + n))) + +(defun paredit-point-at-sexp-boundary (n) + (cond ((< n 0) (paredit-point-at-sexp-start)) + ((= n 0) (point)) + ((> n 0) (paredit-point-at-sexp-end)))) + +(defun paredit-point-at-sexp-start () + (save-excursion + (forward-sexp) + (backward-sexp) + (point))) + +(defun paredit-point-at-sexp-end () + (save-excursion + (backward-sexp) + (forward-sexp) + (point))) + +(defun paredit-lose-if-not-in-sexp (command) + (if (or (paredit-in-string-p) + (paredit-in-comment-p) + (paredit-in-char-p)) + (error "Invalid context for command `%s'." command))) + +(defun paredit-check-region (start end) + "Signal an error if text between `start' and `end' is unbalanced." + ;; `narrow-to-region' will move the point, so avoid calling it if we + ;; don't need to. We don't want to use `save-excursion' because we + ;; want the point to move if `check-parens' reports an error. + (if (not (paredit-region-ok-p start end)) + (save-restriction + (narrow-to-region start end) + (check-parens)))) + +(defun paredit-region-ok-p (start end) + "Return true iff the region between `start' and `end' is balanced. +This is independent of context -- it doesn't check what state the + text at `start' is in." + (save-excursion + (paredit-handle-sexp-errors + (progn + (save-restriction + (narrow-to-region start end) + (scan-sexps (point-min) (point-max))) + t) + nil))) + +(defun paredit-current-indentation () + (save-excursion + (back-to-indentation) + (current-column))) + +(defun paredit-restore-column (column indentation) + ;; Preserve the point's position either in the indentation or in the + ;; code: if on code, move with the code; if in indentation, leave it + ;; in the indentation, either where it was (if still on indentation) + ;; or at the end of the indentation (if the code moved far enough + ;; left). + (let ((indentation* (paredit-current-indentation))) + (goto-char + (+ (point-at-bol) + (cond ((not (< column indentation)) + (+ column (- indentation* indentation))) + ((<= indentation* column) indentation*) + (t column)))))) + +;;;; Initialization + +(paredit-define-keys) +(paredit-annotate-mode-with-examples) +(paredit-annotate-functions-with-examples) + +(provide 'paredit) + +;;; Local Variables: +;;; outline-regexp: " \n;;;;+" +;;; End: + +;;; paredit.el ends here |