1.1--- a/.emacs.d/ellis.el Tue May 21 22:20:59 2024 -0400
1.2+++ b/.emacs.d/ellis.el Wed May 29 11:41:20 2024 -0400
1.3@@ -283,5 +283,8 @@
1.4 (add-hook 'dired-mode-hook #'all-the-icons-dired-mode)
1.5 (add-hook 'ibuffer-mode-hook #'all-the-icons-ibuffer-mode))
1.6
1.7+;; strangerdanger
1.8+(setq slime-enable-evaluate-in-emacs t)
1.9+
1.10 (provide 'ellis)
1.11 ;;; ellis.el ends here
2.1--- /dev/null Thu Jan 01 00:00:00 1970 +0000
2.2+++ b/.emacs.d/lib/paredit.el Wed May 29 11:41:20 2024 -0400
2.3@@ -0,0 +1,3098 @@
2.4+;;; paredit.el --- minor mode for editing parentheses -*- Mode: Emacs-Lisp -*-
2.5+
2.6+;; Copyright (C) 2005--2023 Taylor R. Campbell
2.7+
2.8+;; Author: Taylor R. Campbell <campbell@paredit.org>
2.9+;; Version: 27beta
2.10+;; Created: 2005-07-31
2.11+;; Keywords: lisp
2.12+;; URL: https://paredit.org
2.13+
2.14+;; Paredit is free software: you can redistribute it and/or modify it
2.15+;; under the terms of the GNU General Public License as published by
2.16+;; the Free Software Foundation, either version 3 of the License, or
2.17+;; (at your option) any later version.
2.18+;;
2.19+;; Paredit is distributed in the hope that it will be useful, but
2.20+;; WITHOUT ANY WARRANTY; without even the implied warranty of
2.21+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
2.22+;; GNU General Public License for more details.
2.23+;;
2.24+;; You should have received a copy of the GNU General Public License
2.25+;; along with paredit. If not, see <http://www.gnu.org/licenses/>.
2.26+
2.27+;;; Paredit - https://paredit.org
2.28+;;;
2.29+;;; Latest release: https://paredit.org/paredit.el
2.30+;;; Current development version: https://paredit.org/paredit-beta.el
2.31+;;; Release notes: https://paredit.org/NEWS
2.32+
2.33+;;; Commentary:
2.34+
2.35+;; Paredit keeps your parentheses balanced while editing. Paredit Mode
2.36+;; binds keys like `(', `)', and `"' to insert or delete parentheses
2.37+;; and string quotes in balanced pairs as you're editing without
2.38+;; getting in your way, augments editing keys like `C-k' to handle
2.39+;; balanced expressions, and provides advanced commands for editing
2.40+;; balanced expressions like splicing and joining while judiciously
2.41+;; keeping the code you're working on indented.
2.42+
2.43+;;; Install paredit by placing `paredit.el' in `/path/to/elisp', a
2.44+;;; directory of your choice, and adding to your .emacs file:
2.45+;;;
2.46+;;; (add-to-list 'load-path "/path/to/elisp")
2.47+;;; (autoload 'enable-paredit-mode "paredit"
2.48+;;; "Turn on pseudo-structural editing of Lisp code."
2.49+;;; t)
2.50+;;;
2.51+;;; Start Paredit Mode on the fly with `M-x enable-paredit-mode RET',
2.52+;;; or always enable it in a major mode `M' (e.g., `lisp') with:
2.53+;;;
2.54+;;; (add-hook 'M-mode-hook 'enable-paredit-mode)
2.55+;;;
2.56+;;; Customize paredit using `eval-after-load':
2.57+;;;
2.58+;;; (eval-after-load 'paredit
2.59+;;; '(progn
2.60+;;; (define-key paredit-mode-map (kbd "ESC M-A-C-s-)")
2.61+;;; 'paredit-dwim)))
2.62+;;;
2.63+;;; Send questions, bug reports, comments, feature suggestions, &c.,
2.64+;;; via email to the author's surname at paredit.org.
2.65+;;;
2.66+;;; Paredit should run in GNU Emacs 21 or later and XEmacs 21.5.28 or
2.67+;;; later.
2.68+
2.69+;;; The paredit minor mode, Paredit Mode, binds common character keys,
2.70+;;; such as `(', `)', `"', and `\', to commands that carefully insert
2.71+;;; S-expression structures in the buffer:
2.72+;;;
2.73+;;; ( inserts `()', leaving the point in the middle;
2.74+;;; ) moves the point over the next closing delimiter;
2.75+;;; " inserts `""' if outside a string, or inserts an escaped
2.76+;;; double-quote if in the middle of a string, or moves over the
2.77+;;; closing double-quote if at the end of a string; and
2.78+;;; \ prompts for the character to escape, to avoid inserting lone
2.79+;;; backslashes that may break structure.
2.80+;;;
2.81+;;; In comments, these keys insert themselves. If necessary, you can
2.82+;;; insert these characters literally outside comments by pressing
2.83+;;; `C-q' before these keys, in case a mistake has broken the
2.84+;;; structure.
2.85+;;;
2.86+;;; These key bindings are designed so that when typing new code in
2.87+;;; Paredit Mode, you can generally type exactly the same sequence of
2.88+;;; keys you would have typed without Paredit Mode.
2.89+;;;
2.90+;;; Paredit Mode also binds common editing keys, such as `DEL', `C-d',
2.91+;;; and `C-k', to commands that respect S-expression structures in the
2.92+;;; buffer:
2.93+;;;
2.94+;;; DEL deletes the previous character, unless it is a delimiter: DEL
2.95+;;; will move the point backward over a closing delimiter, and
2.96+;;; will delete a delimiter pair together if between an open and
2.97+;;; closing delimiter;
2.98+;;;
2.99+;;; C-d deletes the next character in much the same manner; and
2.100+;;;
2.101+;;; C-k kills all S-expressions that begin anywhere between the point
2.102+;;; and the end of the line or the closing delimiter of the
2.103+;;; enclosing list, whichever is first.
2.104+;;;
2.105+;;; If necessary, you can delete a character, kill a line, &c.,
2.106+;;; irrespective of S-expression structure, by pressing `C-u' before
2.107+;;; these keys, in case a mistake has broken the structure.
2.108+;;;
2.109+;;; Finally, Paredit Mode binds some keys to complex S-expression
2.110+;;; editing operations. For example, `C-<right>' makes the enclosing
2.111+;;; list slurp up an S-expression to its right (here `|' denotes the
2.112+;;; point):
2.113+;;;
2.114+;;; (foo (bar | baz) quux) C-<right> (foo (bar | baz quux))
2.115+;;;
2.116+;;; Note: Paredit Mode is not compatible with Electric Indent Mode.
2.117+;;; Use one or the other, not both. If you want RET to auto-indent and
2.118+;;; C-j to just insert newline in Paredit Mode, simply rebind the keys
2.119+;;; with the following fragment in your .emacs file:
2.120+;;;
2.121+;;; (eval-after-load 'paredit
2.122+;;; '(progn
2.123+;;; (define-key paredit-mode-map (kbd "RET") 'paredit-newline)
2.124+;;; (define-key paredit-mode-map (kbd "C-j") nil)))
2.125+;;;
2.126+;;; Some paredit commands automatically reindent code. When they do,
2.127+;;; they try to indent as locally as possible, to avoid interfering
2.128+;;; with any indentation you might have manually written. Only the
2.129+;;; advanced S-expression manipulation commands automatically reindent,
2.130+;;; and only the forms that they immediately operated upon (and their
2.131+;;; subforms).
2.132+;;;
2.133+;;; This code is written for clarity, not efficiency. It frequently
2.134+;;; walks over S-expressions redundantly. If you have problems with
2.135+;;; the time it takes to execute some of the commands, let me know.
2.136+
2.137+;;; This assumes Unix-style LF line endings.
2.138+
2.139+(defconst paredit-version 27)
2.140+(defconst paredit-beta-p t)
2.141+
2.142+(eval-and-compile
2.143+
2.144+ (defun paredit-xemacs-p ()
2.145+ ;; No idea where I got this definition from. Edward O'Connor
2.146+ ;; (hober in #emacs) suggested the current definition.
2.147+ ;; (and (boundp 'running-xemacs)
2.148+ ;; running-xemacs)
2.149+ (featurep 'xemacs))
2.150+
2.151+ (defun paredit-gnu-emacs-p ()
2.152+ ;++ This could probably be improved.
2.153+ (not (paredit-xemacs-p)))
2.154+
2.155+ (defmacro xcond (&rest clauses)
2.156+ "Exhaustive COND.
2.157+Signal an error if no clause matches."
2.158+ `(cond ,@clauses
2.159+ (t (error "XCOND lost."))))
2.160+
2.161+ (defalias 'paredit-warn (if (fboundp 'warn) 'warn 'message))
2.162+
2.163+ (defvar paredit-sexp-error-type
2.164+ (with-temp-buffer
2.165+ (insert "(")
2.166+ (condition-case condition
2.167+ (backward-sexp)
2.168+ (error (if (eq (car condition) 'error)
2.169+ (paredit-warn "%s%s%s%s%s"
2.170+ "Paredit is unable to discriminate"
2.171+ " S-expression parse errors from"
2.172+ " other errors. "
2.173+ " This may cause obscure problems. "
2.174+ " Please upgrade Emacs."))
2.175+ (car condition)))))
2.176+
2.177+ (defmacro paredit-handle-sexp-errors (body &rest handler)
2.178+ `(condition-case ()
2.179+ ,body
2.180+ (,paredit-sexp-error-type ,@handler)))
2.181+
2.182+ (put 'paredit-handle-sexp-errors 'lisp-indent-function 1)
2.183+
2.184+ (defmacro paredit-ignore-sexp-errors (&rest body)
2.185+ `(paredit-handle-sexp-errors (progn ,@body)
2.186+ nil))
2.187+
2.188+ (put 'paredit-ignore-sexp-errors 'lisp-indent-function 0)
2.189+
2.190+ (defmacro paredit-preserving-column (&rest body)
2.191+ "Evaluate BODY and restore point to former column, relative to code.
2.192+Assumes BODY will change only indentation.
2.193+If point was on code, it moves with the code.
2.194+If point was on indentation, it stays in indentation."
2.195+ (let ((column (make-symbol "column"))
2.196+ (indentation (make-symbol "indentation")))
2.197+ `(let ((,column (paredit-current-column))
2.198+ (,indentation (paredit-current-indentation)))
2.199+ (let ((value (progn ,@body)))
2.200+ (paredit-restore-column ,column ,indentation)
2.201+ value))))
2.202+
2.203+ (put 'paredit-preserving-column 'lisp-indent-function 0)
2.204+
2.205+ nil)
2.206+
2.207+;;;; Minor Mode Definition
2.208+
2.209+(defvar paredit-lighter " Paredit"
2.210+ "Mode line lighter Paredit Mode.")
2.211+
2.212+(defvar paredit-mode-map (make-sparse-keymap)
2.213+ "Keymap for the paredit minor mode.")
2.214+
2.215+(defvar paredit-override-check-parens-function
2.216+ (lambda (condition) (declare ignore condition) nil)
2.217+ "Function to tell whether unbalanced text should inhibit Paredit Mode.")
2.218+
2.219+;;;###autoload
2.220+(define-minor-mode paredit-mode
2.221+ "Minor mode for pseudo-structurally editing Lisp code.
2.222+With a prefix argument, enable Paredit Mode even if there are
2.223+ unbalanced parentheses in the buffer.
2.224+Paredit behaves badly if parentheses are unbalanced, so exercise
2.225+ caution when forcing Paredit Mode to be enabled, and consider
2.226+ fixing unbalanced parentheses instead.
2.227+\\<paredit-mode-map>"
2.228+ :lighter paredit-lighter
2.229+ ;; Setting `paredit-mode' to false here aborts enabling Paredit Mode.
2.230+ (if (and paredit-mode
2.231+ (not current-prefix-arg))
2.232+ (condition-case condition
2.233+ (check-parens)
2.234+ (error
2.235+ (if (not (funcall paredit-override-check-parens-function condition))
2.236+ (progn (setq paredit-mode nil)
2.237+ (signal (car condition) (cdr condition))))))))
2.238+
2.239+(defun paredit-override-check-parens-interactively (condition)
2.240+ (y-or-n-p (format "Enable Paredit Mode despite condition %S? " condition)))
2.241+
2.242+;;;###autoload
2.243+(defun enable-paredit-mode ()
2.244+ "Turn on pseudo-structural editing of Lisp code."
2.245+ (interactive)
2.246+ (paredit-mode +1))
2.247+
2.248+(defun disable-paredit-mode ()
2.249+ "Turn off pseudo-structural editing of Lisp code."
2.250+ (interactive)
2.251+ (paredit-mode -1))
2.252+
2.253+(defvar paredit-backward-delete-key
2.254+ (xcond ((paredit-xemacs-p) "BS")
2.255+ ((paredit-gnu-emacs-p) "DEL")))
2.256+
2.257+(defvar paredit-forward-delete-keys
2.258+ (xcond ((paredit-xemacs-p) '("DEL"))
2.259+ ((paredit-gnu-emacs-p) '("<delete>" "<deletechar>"))))
2.260+
2.261+;;;; Paredit Keys
2.262+
2.263+;;; Separating the definition and initialization of this variable
2.264+;;; simplifies the development of paredit, since re-evaluating DEFVAR
2.265+;;; forms doesn't actually do anything.
2.266+
2.267+(defvar paredit-commands nil
2.268+ "List of paredit commands with their keys and examples.")
2.269+
2.270+;;; Each specifier is of the form:
2.271+;;; (key[s] function (example-input example-output) ...)
2.272+;;; where key[s] is either a single string suitable for passing to KBD
2.273+;;; or a list of such strings. Entries in this list may also just be
2.274+;;; strings, in which case they are headings for the next entries.
2.275+
2.276+(progn (setq paredit-commands
2.277+ `(
2.278+ "Basic Insertion Commands"
2.279+ ("(" paredit-open-round
2.280+ ("(a b |c d)"
2.281+ "(a b (|) c d)")
2.282+ ("(foo \"bar |baz\" quux)"
2.283+ "(foo \"bar (|baz\" quux)"))
2.284+ (")" paredit-close-round
2.285+ ("(a b |c )" "(a b c)|")
2.286+ ("; Hello,| world!"
2.287+ "; Hello,)| world!"))
2.288+ ("M-)" paredit-close-round-and-newline
2.289+ ("(defun f (x| ))"
2.290+ "(defun f (x)\n |)")
2.291+ ("; (Foo.|"
2.292+ "; (Foo.)|"))
2.293+ ("[" paredit-open-square
2.294+ ("(a b |c d)"
2.295+ "(a b [|] c d)")
2.296+ ("(foo \"bar |baz\" quux)"
2.297+ "(foo \"bar [|baz\" quux)"))
2.298+ ("]" paredit-close-square
2.299+ ("(define-key keymap [frob| ] 'frobnicate)"
2.300+ "(define-key keymap [frob]| 'frobnicate)")
2.301+ ("; [Bar.|"
2.302+ "; [Bar.]|"))
2.303+
2.304+ ("\"" paredit-doublequote
2.305+ ("(frob grovel |full lexical)"
2.306+ "(frob grovel \"|\" full lexical)"
2.307+ "(frob grovel \"\"| full lexical)")
2.308+ ("(foo \"bar |baz\" quux)"
2.309+ "(foo \"bar \\\"|baz\" quux)")
2.310+ ("(frob grovel) ; full |lexical"
2.311+ "(frob grovel) ; full \"|lexical"))
2.312+ ("M-\"" paredit-meta-doublequote
2.313+ ("(foo \"bar |baz\" quux)"
2.314+ "(foo \"bar baz\"| quux)")
2.315+ ("(foo |(bar #\\x \"baz \\\\ quux\") zot)"
2.316+ ,(concat "(foo \"|(bar #\\\\x \\\"baz \\\\"
2.317+ "\\\\ quux\\\")\" zot)")))
2.318+ ("\\" paredit-backslash
2.319+ ("(string #|)\n ; Character to escape: x"
2.320+ "(string #\\x|)")
2.321+ ("\"foo|bar\"\n ; Character to escape: \""
2.322+ "\"foo\\\"|bar\""))
2.323+ (";" paredit-semicolon
2.324+ ("|(frob grovel)"
2.325+ ";|(frob grovel)")
2.326+ ("(frob |grovel)"
2.327+ "(frob ;|grovel\n )")
2.328+ ("(frob |grovel (bloit\n zargh))"
2.329+ "(frob ;|grovel\n (bloit\n zargh))")
2.330+ ("(frob grovel) |"
2.331+ "(frob grovel) ;|"))
2.332+ ("M-;" paredit-comment-dwim
2.333+ ("(foo |bar) ; baz"
2.334+ "(foo bar) ; |baz")
2.335+ ("(frob grovel)|"
2.336+ "(frob grovel) ;|")
2.337+ ("(zot (foo bar)\n|\n (baz quux))"
2.338+ "(zot (foo bar)\n ;; |\n (baz quux))")
2.339+ ("(zot (foo bar) |(baz quux))"
2.340+ "(zot (foo bar)\n ;; |\n (baz quux))")
2.341+ ("|(defun hello-world ...)"
2.342+ ";;; |\n(defun hello-world ...)"))
2.343+
2.344+ (() paredit-newline
2.345+ ("(let ((n (frobbotz))) |(display (+ n 1)\nport))"
2.346+ ,(concat "(let ((n (frobbotz)))"
2.347+ "\n |(display (+ n 1)"
2.348+ "\n port))")))
2.349+ ("RET" paredit-RET)
2.350+ ("C-j" paredit-C-j)
2.351+
2.352+ "Deleting & Killing"
2.353+ (,paredit-forward-delete-keys
2.354+ paredit-forward-delete
2.355+ ("(quu|x \"zot\")" "(quu| \"zot\")")
2.356+ ("(quux |\"zot\")"
2.357+ "(quux \"|zot\")"
2.358+ "(quux \"|ot\")")
2.359+ ("(foo (|) bar)" "(foo | bar)")
2.360+ ("|(foo bar)" "(|foo bar)"))
2.361+ (,paredit-backward-delete-key
2.362+ paredit-backward-delete
2.363+ ("(\"zot\" q|uux)" "(\"zot\" |uux)")
2.364+ ("(\"zot\"| quux)"
2.365+ "(\"zot|\" quux)"
2.366+ "(\"zo|\" quux)")
2.367+ ("(foo (|) bar)" "(foo | bar)")
2.368+ ("(foo bar)|" "(foo bar|)"))
2.369+ ("C-d" paredit-delete-char
2.370+ ("(quu|x \"zot\")" "(quu| \"zot\")")
2.371+ ("(quux |\"zot\")"
2.372+ "(quux \"|zot\")"
2.373+ "(quux \"|ot\")")
2.374+ ("(foo (|) bar)" "(foo | bar)")
2.375+ ("|(foo bar)" "(|foo bar)"))
2.376+ ("C-k" paredit-kill
2.377+ ("(foo bar)| ; Useless comment!"
2.378+ "(foo bar)|")
2.379+ ("(|foo bar) ; Useful comment!"
2.380+ "(|) ; Useful comment!")
2.381+ ("|(foo bar) ; Useless line!"
2.382+ "|")
2.383+ ("(foo \"|bar baz\"\n quux)"
2.384+ "(foo \"|\"\n quux)"))
2.385+ ("M-d" paredit-forward-kill-word
2.386+ ("|(foo bar) ; baz"
2.387+ "(| bar) ; baz"
2.388+ "(|) ; baz"
2.389+ "() ;|")
2.390+ (";;;| Frobnicate\n(defun frobnicate ...)"
2.391+ ";;;|\n(defun frobnicate ...)"
2.392+ ";;;\n(| frobnicate ...)"))
2.393+ (,(concat "M-" paredit-backward-delete-key)
2.394+ paredit-backward-kill-word
2.395+ ("(foo bar) ; baz\n(quux)|"
2.396+ "(foo bar) ; baz\n(|)"
2.397+ "(foo bar) ; |\n()"
2.398+ "(foo |) ; \n()"
2.399+ "(|) ; \n()"))
2.400+
2.401+ "Movement & Navigation"
2.402+ ("C-M-f" paredit-forward
2.403+ ("(foo |(bar baz) quux)"
2.404+ "(foo (bar baz)| quux)")
2.405+ ("(foo (bar)|)"
2.406+ "(foo (bar))|"))
2.407+ ("C-M-b" paredit-backward
2.408+ ("(foo (bar baz)| quux)"
2.409+ "(foo |(bar baz) quux)")
2.410+ ("(|(foo) bar)"
2.411+ "|((foo) bar)"))
2.412+ ("C-M-u" paredit-backward-up)
2.413+ ("C-M-d" paredit-forward-down)
2.414+ ("C-M-p" paredit-backward-down) ; Built-in, these are FORWARD-
2.415+ ("C-M-n" paredit-forward-up) ; & BACKWARD-LIST, which have
2.416+ ; no need given C-M-f & C-M-b.
2.417+
2.418+ "Depth-Changing Commands"
2.419+ ("M-(" paredit-wrap-round
2.420+ ("(foo |bar baz)"
2.421+ "(foo (|bar) baz)"))
2.422+ ("M-s" paredit-splice-sexp
2.423+ ("(foo (bar| baz) quux)"
2.424+ "(foo bar| baz quux)"))
2.425+ (("M-<up>" "ESC <up>")
2.426+ paredit-splice-sexp-killing-backward
2.427+ ("(foo (let ((x 5)) |(sqrt n)) bar)"
2.428+ "(foo |(sqrt n) bar)"))
2.429+ (("M-<down>" "ESC <down>")
2.430+ paredit-splice-sexp-killing-forward
2.431+ ("(a (b c| d e) f)"
2.432+ "(a b c| f)"))
2.433+ ("M-r" paredit-raise-sexp
2.434+ ("(dynamic-wind in (lambda () |body) out)"
2.435+ "(dynamic-wind in |body out)"
2.436+ "|body"))
2.437+ ("M-?" paredit-convolute-sexp
2.438+ ("(let ((x 5) (y 3)) (frob |(zwonk)) (wibblethwop))"
2.439+ "(frob |(let ((x 5) (y 3)) (zwonk) (wibblethwop)))"))
2.440+
2.441+ "Barfage & Slurpage"
2.442+ (("C-)" "C-<right>")
2.443+ paredit-forward-slurp-sexp
2.444+ ("(foo (bar |baz) quux zot)"
2.445+ "(foo (bar |baz quux) zot)")
2.446+ ("(a b ((c| d)) e f)"
2.447+ "(a b ((c| d) e) f)"))
2.448+ (("C-}" "C-<left>")
2.449+ paredit-forward-barf-sexp
2.450+ ("(foo (bar |baz quux) zot)"
2.451+ "(foo (bar |baz) quux zot)"))
2.452+ (("C-(" "C-M-<left>" "ESC C-<left>")
2.453+ paredit-backward-slurp-sexp
2.454+ ("(foo bar (baz| quux) zot)"
2.455+ "(foo (bar baz| quux) zot)")
2.456+ ("(a b ((c| d)) e f)"
2.457+ "(a (b (c| d)) e f)"))
2.458+ (("C-{" "C-M-<right>" "ESC C-<right>")
2.459+ paredit-backward-barf-sexp
2.460+ ("(foo (bar baz |quux) zot)"
2.461+ "(foo bar (baz |quux) zot)"))
2.462+
2.463+ "Miscellaneous Commands"
2.464+ ("M-S" paredit-split-sexp
2.465+ ("(hello| world)"
2.466+ "(hello)| (world)")
2.467+ ("\"Hello, |world!\""
2.468+ "\"Hello, \"| \"world!\""))
2.469+ ("M-J" paredit-join-sexps
2.470+ ("(hello)| (world)"
2.471+ "(hello| world)")
2.472+ ("\"Hello, \"| \"world!\""
2.473+ "\"Hello, |world!\"")
2.474+ ("hello-\n| world"
2.475+ "hello-|world"))
2.476+ ("C-c C-M-l" paredit-recenter-on-sexp)
2.477+ ("M-q" paredit-reindent-defun)
2.478+ ))
2.479+ nil) ; end of PROGN
2.480+
2.481+;;;;; Command Examples
2.482+
2.483+(eval-and-compile
2.484+ (defmacro paredit-do-commands (vars string-case &rest body)
2.485+ (let ((spec (nth 0 vars))
2.486+ (keys (nth 1 vars))
2.487+ (fn (nth 2 vars))
2.488+ (examples (nth 3 vars)))
2.489+ `(dolist (,spec paredit-commands)
2.490+ (if (stringp ,spec)
2.491+ ,string-case
2.492+ (let ((,keys (let ((k (car ,spec)))
2.493+ (cond ((stringp k) (list k))
2.494+ ((listp k) k)
2.495+ (t (error "Invalid paredit command %s."
2.496+ ,spec)))))
2.497+ (,fn (cadr ,spec))
2.498+ (,examples (cddr ,spec)))
2.499+ ,@body)))))
2.500+
2.501+ (put 'paredit-do-commands 'lisp-indent-function 2))
2.502+
2.503+(defun paredit-define-keys ()
2.504+ (paredit-do-commands (spec keys fn examples)
2.505+ nil ; string case
2.506+ (dolist (key keys)
2.507+ (define-key paredit-mode-map (read-kbd-macro key) fn))))
2.508+
2.509+(defun paredit-function-documentation (fn)
2.510+ (let ((original-doc (get fn 'paredit-original-documentation))
2.511+ (doc (documentation fn 'function-documentation)))
2.512+ (or original-doc
2.513+ (progn (put fn 'paredit-original-documentation doc)
2.514+ doc))))
2.515+
2.516+(defun paredit-annotate-mode-with-examples ()
2.517+ (let ((contents
2.518+ (list (paredit-function-documentation 'paredit-mode))))
2.519+ (paredit-do-commands (spec keys fn examples)
2.520+ (push (concat "\n \n" spec "\n")
2.521+ contents)
2.522+ (let ((name (symbol-name fn)))
2.523+ (if (string-match (symbol-name 'paredit-) name)
2.524+ (push (concat "\n\n\\[" name "]\t" name
2.525+ (if examples
2.526+ (mapconcat (lambda (example)
2.527+ (concat
2.528+ "\n"
2.529+ (mapconcat 'identity
2.530+ example
2.531+ "\n --->\n")
2.532+ "\n"))
2.533+ examples
2.534+ "")
2.535+ "\n (no examples)\n"))
2.536+ contents))))
2.537+ (put 'paredit-mode 'function-documentation
2.538+ (apply 'concat (reverse contents))))
2.539+ ;; PUT returns the huge string we just constructed, which we don't
2.540+ ;; want it to return.
2.541+ nil)
2.542+
2.543+(defun paredit-annotate-functions-with-examples ()
2.544+ (paredit-do-commands (spec keys fn examples)
2.545+ nil ; string case
2.546+ (put fn 'function-documentation
2.547+ (concat (paredit-function-documentation fn)
2.548+ "\n\n\\<paredit-mode-map>\\[" (symbol-name fn) "]\n"
2.549+ (mapconcat (lambda (example)
2.550+ (concat "\n"
2.551+ (mapconcat 'identity
2.552+ example
2.553+ "\n ->\n")
2.554+ "\n"))
2.555+ examples
2.556+ "")))))
2.557+
2.558+;;;;; HTML Examples
2.559+
2.560+(defun paredit-insert-html-examples ()
2.561+ "Insert HTML for a paredit quick reference table."
2.562+ (interactive)
2.563+ (let ((insert-lines
2.564+ (lambda (&rest lines) (dolist (line lines) (insert line) (newline))))
2.565+ (initp nil))
2.566+ (paredit-do-commands (spec keys fn examples)
2.567+ (progn (if initp
2.568+ (funcall insert-lines "</table>")
2.569+ (setq initp t))
2.570+ (funcall insert-lines (concat "<h3>" spec "</h3>"))
2.571+ (funcall insert-lines "<table>"))
2.572+ (let ((name (symbol-name fn))
2.573+ (keys
2.574+ (mapconcat (lambda (key)
2.575+ (concat "<tt>" (paredit-html-quote key) "</tt>"))
2.576+ keys
2.577+ ", ")))
2.578+ (funcall insert-lines "<tr>")
2.579+ (funcall insert-lines (concat " <th align=\"left\">" keys "</th>"))
2.580+ (funcall insert-lines (concat " <th align=\"left\">" name "</th>"))
2.581+ (funcall insert-lines "</tr>")
2.582+ (funcall insert-lines
2.583+ "<tr><td colspan=\"2\"><table cellpadding=\"5\"><tr>")
2.584+ (dolist (example examples)
2.585+ (let ((prefix "<td><table border=\"1\"><tr><td><table><tr><td><pre>")
2.586+ (examples
2.587+ (mapconcat 'paredit-html-quote
2.588+ example
2.589+ (concat "</pre></td></tr>"
2.590+ "<tr><th>↓</th></tr>"
2.591+ "<tr><td><pre>")))
2.592+ (suffix "</pre></td></tr></table></td></tr></table></td>"))
2.593+ (funcall insert-lines (concat prefix examples suffix))))
2.594+ (funcall insert-lines "</tr></table></td></tr>")))
2.595+ (funcall insert-lines "</table>")))
2.596+
2.597+(defun paredit-html-quote (string)
2.598+ (with-temp-buffer
2.599+ (dotimes (i (length string))
2.600+ (insert (let ((c (elt string i)))
2.601+ (cond ((eq c ?\<) "<")
2.602+ ((eq c ?\>) ">")
2.603+ ((eq c ?\&) "&")
2.604+ ((eq c ?\') "'")
2.605+ ((eq c ?\") """)
2.606+ (t c)))))
2.607+ (buffer-string)))
2.608+
2.609+;;;; Delimiter Insertion
2.610+
2.611+(eval-and-compile
2.612+ (defun paredit-conc-name (&rest strings)
2.613+ (intern (apply 'concat strings)))
2.614+
2.615+ (defmacro define-paredit-pair (open close name)
2.616+ `(progn
2.617+ (defun ,(paredit-conc-name "paredit-open-" name) (&optional n)
2.618+ ,(concat "Insert a balanced " name " pair.
2.619+With a prefix argument N, put the closing " name " after N
2.620+ S-expressions forward.
2.621+If the region is active, `transient-mark-mode' is enabled, and the
2.622+ region's start and end fall in the same parenthesis depth, insert a
2.623+ " name " pair around the region.
2.624+If in a string or a comment, insert a single " name ".
2.625+If in a character literal, do nothing. This prevents changing what was
2.626+ in the character literal to a meaningful delimiter unintentionally.")
2.627+ (interactive "P")
2.628+ (cond ((or (paredit-in-string-p)
2.629+ (paredit-in-comment-p))
2.630+ (insert ,open))
2.631+ ((not (paredit-in-char-p))
2.632+ (paredit-insert-pair n ,open ,close 'goto-char)
2.633+ (save-excursion (backward-up-list) (indent-sexp)))))
2.634+ (defun ,(paredit-conc-name "paredit-close-" name) ()
2.635+ ,(concat "Move past one closing delimiter and reindent.
2.636+\(Agnostic to the specific closing delimiter.)
2.637+If in a string or comment, insert a single closing " name ".
2.638+If in a character literal, do nothing. This prevents changing what was
2.639+ in the character literal to a meaningful delimiter unintentionally.")
2.640+ (interactive)
2.641+ (paredit-move-past-close ,close))
2.642+ (defun ,(paredit-conc-name "paredit-close-" name "-and-newline") ()
2.643+ ,(concat "Move past one closing delimiter, add a newline,"
2.644+ " and reindent.
2.645+If there was a margin comment after the closing delimiter, preserve it
2.646+ on the same line.")
2.647+ (interactive)
2.648+ (paredit-move-past-close-and-newline ,close))
2.649+ (defun ,(paredit-conc-name "paredit-wrap-" name)
2.650+ (&optional argument)
2.651+ ,(concat "Wrap the following S-expression.
2.652+See `paredit-wrap-sexp' for more details.")
2.653+ (interactive "P")
2.654+ (paredit-wrap-sexp argument ,open ,close))
2.655+ (add-to-list 'paredit-wrap-commands
2.656+ ',(paredit-conc-name "paredit-wrap-" name)))))
2.657+
2.658+(defvar paredit-wrap-commands '(paredit-wrap-sexp)
2.659+ "List of paredit commands that wrap S-expressions.
2.660+Used by `paredit-yank-pop'; for internal paredit use only.")
2.661+
2.662+(define-paredit-pair ?\( ?\) "round")
2.663+(define-paredit-pair ?\[ ?\] "square")
2.664+(define-paredit-pair ?\{ ?\} "curly")
2.665+(define-paredit-pair ?\< ?\> "angled")
2.666+
2.667+;;; Aliases for the old names.
2.668+
2.669+(defalias 'paredit-open-parenthesis 'paredit-open-round)
2.670+(defalias 'paredit-close-parenthesis 'paredit-close-round)
2.671+(defalias 'paredit-close-parenthesis-and-newline
2.672+ 'paredit-close-round-and-newline)
2.673+
2.674+(defalias 'paredit-open-bracket 'paredit-open-square)
2.675+(defalias 'paredit-close-bracket 'paredit-close-square)
2.676+(defalias 'paredit-close-bracket-and-newline
2.677+ 'paredit-close-square-and-newline)
2.678+
2.679+(defun paredit-move-past-close (close)
2.680+ (paredit-move-past-close-and close
2.681+ (lambda ()
2.682+ (paredit-blink-paren-match nil))))
2.683+
2.684+(defun paredit-move-past-close-and-newline (close)
2.685+ (paredit-move-past-close-and close
2.686+ (lambda ()
2.687+ (let ((comment.point (paredit-find-comment-on-line)))
2.688+ (newline)
2.689+ (if comment.point
2.690+ (save-excursion
2.691+ (forward-line -1)
2.692+ (end-of-line)
2.693+ (indent-to (cdr comment.point))
2.694+ (insert (car comment.point)))))
2.695+ (lisp-indent-line)
2.696+ (paredit-ignore-sexp-errors (indent-sexp))
2.697+ (paredit-blink-paren-match t))))
2.698+
2.699+(defun paredit-move-past-close-and (close if-moved)
2.700+ (if (or (paredit-in-string-p)
2.701+ (paredit-in-comment-p))
2.702+ (insert close)
2.703+ (if (paredit-in-char-p) (forward-char))
2.704+ (paredit-move-past-close-and-reindent close)
2.705+ (funcall if-moved)))
2.706+
2.707+(defun paredit-find-comment-on-line ()
2.708+ "Find a margin comment on the current line.
2.709+Return nil if there is no such comment or if there is anything but
2.710+ whitespace until such a comment.
2.711+If such a comment exists, delete the comment (including all leading
2.712+ whitespace) and return a cons whose car is the comment as a string
2.713+ and whose cdr is the point of the comment's initial semicolon,
2.714+ relative to the start of the line."
2.715+ (save-excursion
2.716+ (paredit-skip-whitespace t (point-at-eol))
2.717+ (and (eq ?\; (char-after))
2.718+ (not (eq ?\; (char-after (1+ (point)))))
2.719+ (not (or (paredit-in-string-p)
2.720+ (paredit-in-char-p)))
2.721+ (let* ((start ;Move to before the semicolon.
2.722+ (progn (backward-char) (point)))
2.723+ (comment
2.724+ (buffer-substring start (point-at-eol))))
2.725+ (paredit-skip-whitespace nil (point-at-bol))
2.726+ (delete-region (point) (point-at-eol))
2.727+ (cons comment (- start (point-at-bol)))))))
2.728+
2.729+(defun paredit-insert-pair (n open close forward)
2.730+ (let* ((regionp
2.731+ (and (paredit-region-active-p)
2.732+ (paredit-region-safe-for-insert-p)))
2.733+ (end
2.734+ (and regionp
2.735+ (not n)
2.736+ (prog1 (region-end) (goto-char (region-beginning))))))
2.737+ (let ((spacep (paredit-space-for-delimiter-p nil open)))
2.738+ (if spacep (insert " "))
2.739+ (insert open)
2.740+ (save-excursion
2.741+ ;; Move past the desired region.
2.742+ (cond (n
2.743+ (funcall forward
2.744+ (paredit-scan-sexps-hack (point)
2.745+ (prefix-numeric-value n))))
2.746+ (regionp
2.747+ (funcall forward (+ end (if spacep 2 1)))))
2.748+ ;; The string case can happen if we are inserting string
2.749+ ;; delimiters. The comment case may happen by moving to the
2.750+ ;; end of a buffer that has a comment with no trailing newline.
2.751+ (if (and (not (paredit-in-string-p))
2.752+ (paredit-in-comment-p))
2.753+ (newline))
2.754+ (insert close)
2.755+ (if (paredit-space-for-delimiter-p t close)
2.756+ (insert " "))))))
2.757+
2.758+;++ This needs a better name...
2.759+
2.760+(defun paredit-scan-sexps-hack (point n)
2.761+ (save-excursion
2.762+ (goto-char point)
2.763+ (let ((direction (if (< 0 n) +1 -1))
2.764+ (magnitude (abs n))
2.765+ (count 0))
2.766+ (catch 'exit
2.767+ (while (< count magnitude)
2.768+ (let ((p
2.769+ (paredit-handle-sexp-errors (scan-sexps (point) direction)
2.770+ nil)))
2.771+ (if (not p) (throw 'exit nil))
2.772+ (goto-char p))
2.773+ (setq count (+ count 1)))))
2.774+ (point)))
2.775+
2.776+(defun paredit-region-safe-for-insert-p ()
2.777+ (save-excursion
2.778+ (let ((beginning (region-beginning))
2.779+ (end (region-end)))
2.780+ (goto-char beginning)
2.781+ (let* ((beginning-state (paredit-current-parse-state))
2.782+ (end-state
2.783+ (parse-partial-sexp beginning end nil nil beginning-state)))
2.784+ (and (= (nth 0 beginning-state) ; 0. depth in parens
2.785+ (nth 0 end-state))
2.786+ (eq (nth 3 beginning-state) ; 3. non-nil if inside a
2.787+ (nth 3 end-state)) ; string
2.788+ (eq (nth 4 beginning-state) ; 4. comment status, yada
2.789+ (nth 4 end-state))
2.790+ (eq (nth 5 beginning-state) ; 5. t if following char
2.791+ (nth 5 end-state))))))) ; quote
2.792+
2.793+(defvar paredit-space-for-delimiter-predicates nil
2.794+ "List of predicates for whether to put space by delimiter at point.
2.795+Each predicate is a function that is is applied to two arguments, ENDP
2.796+ and DELIMITER, and that returns a boolean saying whether to put a
2.797+ space next to the delimiter -- before/after the delimiter if ENDP is
2.798+ false/true, respectively.
2.799+If any predicate returns false, no space is inserted: every predicate
2.800+ has veto power.
2.801+Each predicate may assume that the point is not at the beginning/end of
2.802+ the buffer, and that the point is preceded/followed by a word
2.803+ constituent, symbol constituent, string quote, or delimiter matching
2.804+ DELIMITER, if ENDP is false/true, respectively.
2.805+Each predicate should examine only text before/after the point if ENDP is
2.806+ false/true, respectively.")
2.807+
2.808+(defun paredit-space-for-delimiter-p (endp delimiter)
2.809+ ;; If at the buffer limit, don't insert a space. If there is a word,
2.810+ ;; symbol, other quote, or non-matching parenthesis delimiter (i.e. a
2.811+ ;; close when want an open the string or an open when we want to
2.812+ ;; close the string), do insert a space.
2.813+ (and (not (if endp (eobp) (bobp)))
2.814+ (memq (char-syntax (if endp (char-after) (char-before)))
2.815+ (list ?w ?_ ?\"
2.816+ (let ((matching (matching-paren delimiter)))
2.817+ (and matching (char-syntax matching)))
2.818+ (and (not endp)
2.819+ (eq ?\" (char-syntax delimiter))
2.820+ ?\) )))
2.821+ (catch 'exit
2.822+ (dolist (predicate paredit-space-for-delimiter-predicates)
2.823+ (if (not (funcall predicate endp delimiter))
2.824+ (throw 'exit nil)))
2.825+ t)))
2.826+
2.827+(defun paredit-move-past-close-and-reindent (close)
2.828+ (let ((open (paredit-missing-close)))
2.829+ (if open
2.830+ (if (eq close (matching-paren open))
2.831+ (save-excursion
2.832+ (message "Missing closing delimiter: %c" close)
2.833+ (insert close))
2.834+ (error "Mismatched missing closing delimiter: %c ... %c"
2.835+ open close))))
2.836+ (up-list)
2.837+ (if (catch 'return ; This CATCH returns T if it
2.838+ (while t ; should delete leading spaces
2.839+ (save-excursion ; and NIL if not.
2.840+ (let ((before-paren (1- (point))))
2.841+ (back-to-indentation)
2.842+ (cond ((not (eq (point) before-paren))
2.843+ ;; Can't call PAREDIT-DELETE-LEADING-WHITESPACE
2.844+ ;; here -- we must return from SAVE-EXCURSION
2.845+ ;; first.
2.846+ (throw 'return t))
2.847+ ((save-excursion (forward-line -1)
2.848+ (end-of-line)
2.849+ (paredit-in-comment-p))
2.850+ ;; Moving the closing delimiter any further
2.851+ ;; would put it into a comment, so we just
2.852+ ;; indent the closing delimiter where it is and
2.853+ ;; abort the loop, telling its continuation that
2.854+ ;; no leading whitespace should be deleted.
2.855+ (lisp-indent-line)
2.856+ (throw 'return nil))
2.857+ (t (delete-indentation)))))))
2.858+ (paredit-delete-leading-whitespace)))
2.859+
2.860+(defun paredit-missing-close ()
2.861+ (save-excursion
2.862+ (paredit-handle-sexp-errors (backward-up-list)
2.863+ (error "Not inside a list."))
2.864+ (let ((open (char-after)))
2.865+ (paredit-handle-sexp-errors (progn (forward-sexp) nil)
2.866+ open))))
2.867+
2.868+(defun paredit-delete-leading-whitespace ()
2.869+ ;; This assumes that we're on the closing delimiter already.
2.870+ (save-excursion
2.871+ (backward-char)
2.872+ (while (let ((syn (char-syntax (char-before))))
2.873+ (and (or (eq syn ?\ ) (eq syn ?-)) ; whitespace syntax
2.874+ ;; The above line is a perfect example of why the
2.875+ ;; following test is necessary.
2.876+ (not (paredit-in-char-p (1- (point))))))
2.877+ (delete-char -1))))
2.878+
2.879+(defun paredit-blink-paren-match (another-line-p)
2.880+ (if (and blink-matching-paren
2.881+ (or (not show-paren-mode) another-line-p))
2.882+ (paredit-ignore-sexp-errors
2.883+ (save-excursion
2.884+ (backward-sexp)
2.885+ (forward-sexp)
2.886+ ;; SHOW-PAREN-MODE inhibits any blinking, so we disable it
2.887+ ;; locally here.
2.888+ (let ((show-paren-mode nil))
2.889+ (blink-matching-open))))))
2.890+
2.891+(defun paredit-doublequote (&optional n)
2.892+ "Insert a pair of double-quotes.
2.893+With a prefix argument N, wrap the following N S-expressions in
2.894+ double-quotes, escaping intermediate characters if necessary.
2.895+If the region is active, `transient-mark-mode' is enabled, and the
2.896+ region's start and end fall in the same parenthesis depth, insert a
2.897+ pair of double-quotes around the region, again escaping intermediate
2.898+ characters if necessary.
2.899+Inside a comment, insert a literal double-quote.
2.900+At the end of a string, move past the closing double-quote.
2.901+In the middle of a string, insert a backslash-escaped double-quote.
2.902+If in a character literal, do nothing. This prevents accidentally
2.903+ changing a what was in the character literal to become a meaningful
2.904+ delimiter unintentionally."
2.905+ (interactive "P")
2.906+ (cond ((paredit-in-string-p)
2.907+ (if (eq (point) (- (paredit-enclosing-string-end) 1))
2.908+ (forward-char) ; Just move past the closing quote.
2.909+ ;; Don't split a \x into an escaped backslash and a string end.
2.910+ (if (paredit-in-string-escape-p) (forward-char))
2.911+ (insert ?\\ ?\" )))
2.912+ ((paredit-in-comment-p)
2.913+ (insert ?\" ))
2.914+ ((not (paredit-in-char-p))
2.915+ (paredit-insert-pair n ?\" ?\" 'paredit-forward-for-quote))))
2.916+
2.917+(defun paredit-meta-doublequote (&optional n)
2.918+ "Move to the end of the string.
2.919+If not in a string, act as `paredit-doublequote'; if no prefix argument
2.920+ is specified and the region is not active or `transient-mark-mode' is
2.921+ disabled, the default is to wrap one S-expression, however, not zero."
2.922+ (interactive "P")
2.923+ (if (not (paredit-in-string-p))
2.924+ (paredit-doublequote (or n (and (not (paredit-region-active-p)) 1)))
2.925+ (goto-char (paredit-enclosing-string-end))))
2.926+
2.927+(defun paredit-meta-doublequote-and-newline (&optional n)
2.928+ "Move to the end of the string, insert a newline, and indent.
2.929+If not in a string, act as `paredit-doublequote'; if no prefix argument
2.930+ is specified and the region is not active or `transient-mark-mode' is
2.931+ disabled, the default is to wrap one S-expression, however, not zero."
2.932+ (interactive "P")
2.933+ (if (not (paredit-in-string-p))
2.934+ (paredit-doublequote (or n (and (not (paredit-region-active-p)) 1)))
2.935+ (progn (goto-char (paredit-enclosing-string-end))
2.936+ (newline)
2.937+ (lisp-indent-line)
2.938+ (paredit-ignore-sexp-errors (indent-sexp)))))
2.939+
2.940+(defun paredit-forward-for-quote (end)
2.941+ (let ((state (paredit-current-parse-state)))
2.942+ (while (< (point) end)
2.943+ (let ((new-state (parse-partial-sexp (point) (1+ (point))
2.944+ nil nil state)))
2.945+ (if (paredit-in-string-p new-state)
2.946+ (if (not (paredit-in-string-escape-p))
2.947+ (setq state new-state)
2.948+ ;; Escape character: turn it into an escaped escape
2.949+ ;; character by appending another backslash.
2.950+ (insert ?\\ )
2.951+ ;; Now the point is after both escapes, and we want to
2.952+ ;; rescan from before the first one to after the second
2.953+ ;; one.
2.954+ (setq state
2.955+ (parse-partial-sexp (- (point) 2) (point)
2.956+ nil nil state))
2.957+ ;; Advance the end point, since we just inserted a new
2.958+ ;; character.
2.959+ (setq end (1+ end)))
2.960+ ;; String: escape by inserting a backslash before the quote.
2.961+ (backward-char)
2.962+ (insert ?\\ )
2.963+ ;; The point is now between the escape and the quote, and we
2.964+ ;; want to rescan from before the escape to after the quote.
2.965+ (setq state
2.966+ (parse-partial-sexp (1- (point)) (1+ (point))
2.967+ nil nil state))
2.968+ ;; Advance the end point for the same reason as above.
2.969+ (setq end (1+ end)))))))
2.970+
2.971+;;;; Escape Insertion
2.972+
2.973+(defun paredit-backslash ()
2.974+ "Insert a backslash followed by a character to escape."
2.975+ (interactive)
2.976+ (cond ((paredit-in-string-p) (paredit-backslash-interactive))
2.977+ ((paredit-in-comment-p) (insert ?\\))
2.978+ ((paredit-in-char-p) (forward-char) (paredit-backslash-interactive))
2.979+ (t (paredit-backslash-interactive))))
2.980+
2.981+(defun paredit-backslash-interactive ()
2.982+ (insert ?\\ )
2.983+ ;; Read a character to insert after the backslash. If anything
2.984+ ;; goes wrong -- the user hits delete (entering the rubout
2.985+ ;; `character'), aborts with C-g, or enters non-character input
2.986+ ;; -- then delete the backslash to avoid a dangling escape.
2.987+ (let ((delete-p t))
2.988+ (unwind-protect
2.989+ (let ((char (read-char "Character to escape: " t)))
2.990+ (if (not (eq char ?\^?))
2.991+ (progn (message "Character to escape: %c" char)
2.992+ (insert char)
2.993+ (setq delete-p nil))))
2.994+ (if delete-p
2.995+ (progn (message "Deleting escape.")
2.996+ (delete-char -1))))))
2.997+
2.998+(defun paredit-newline ()
2.999+ "Insert a newline and indent it.
2.1000+This is like `newline-and-indent', but it not only indents the line
2.1001+ that the point is on but also the S-expression following the point,
2.1002+ if there is one.
2.1003+Move forward one character first if on an escaped character.
2.1004+If in a string, just insert a literal newline.
2.1005+If in a comment and if followed by invalid structure, call
2.1006+ `indent-new-comment-line' to keep the invalid structure in a
2.1007+ comment."
2.1008+ (interactive)
2.1009+ (cond ((paredit-in-string-p)
2.1010+ (newline))
2.1011+ ((paredit-in-comment-p)
2.1012+ (if (paredit-region-ok-p (point) (point-at-eol))
2.1013+ (progn (newline-and-indent)
2.1014+ (paredit-ignore-sexp-errors (indent-sexp)))
2.1015+ (indent-new-comment-line)))
2.1016+ (t
2.1017+ (if (paredit-in-char-p)
2.1018+ (forward-char))
2.1019+ (newline-and-indent)
2.1020+ ;; Indent the following S-expression, but don't signal an
2.1021+ ;; error if there's only a closing delimiter after the point.
2.1022+ (paredit-ignore-sexp-errors (indent-sexp)))))
2.1023+
2.1024+(defun paredit-electric-indent-mode-p ()
2.1025+ "True if Electric Indent Mode is on, false if not.
2.1026+Electric Indent Mode is generally not compatible with paredit and
2.1027+ users are advised to disable it, since paredit does essentially
2.1028+ everything it tries to do better.
2.1029+However, to mitigate the negative user experience of combining
2.1030+ Electric Indent Mode with paredit, the default key bindings for
2.1031+ RET and C-j in paredit are exchanged depending on whether
2.1032+ Electric Indent Mode is enabled."
2.1033+ (and (boundp 'electric-indent-mode)
2.1034+ electric-indent-mode))
2.1035+
2.1036+(defun paredit-RET ()
2.1037+ "Default key binding for RET in Paredit Mode.
2.1038+Normally, inserts a newline, like traditional Emacs RET.
2.1039+With Electric Indent Mode enabled, inserts a newline and indents
2.1040+ the new line, as well as any subexpressions of it on subsequent
2.1041+ lines; see `paredit-newline' for details and examples."
2.1042+ (interactive)
2.1043+ (if (paredit-electric-indent-mode-p)
2.1044+ (let ((electric-indent-mode nil))
2.1045+ (paredit-newline))
2.1046+ (newline)))
2.1047+
2.1048+(defun paredit-C-j ()
2.1049+ "Default key binding for C-j in Paredit Mode.
2.1050+Normally, inserts a newline and indents
2.1051+ the new line, as well as any subexpressions of it on subsequent
2.1052+ lines; see `paredit-newline' for details and examples.
2.1053+With Electric Indent Mode enabled, inserts a newline, like
2.1054+ traditional Emacs RET."
2.1055+ (interactive)
2.1056+ (if (paredit-electric-indent-mode-p)
2.1057+ (let ((electric-indent-mode nil))
2.1058+ (newline))
2.1059+ (paredit-newline)))
2.1060+
2.1061+(defun paredit-reindent-defun (&optional argument)
2.1062+ "Reindent the definition that the point is on.
2.1063+If the point is in a string or a comment, fill the paragraph instead,
2.1064+ and with a prefix argument, justify as well."
2.1065+ (interactive "P")
2.1066+ (if (or (paredit-in-string-p)
2.1067+ (paredit-in-comment-p))
2.1068+ (if (memq fill-paragraph-function '(t nil))
2.1069+ (lisp-fill-paragraph argument)
2.1070+ (funcall fill-paragraph-function argument))
2.1071+ (paredit-preserving-column
2.1072+ (save-excursion
2.1073+ (end-of-defun)
2.1074+ (beginning-of-defun)
2.1075+ (indent-sexp)))))
2.1076+
2.1077+;;;; Comment Insertion
2.1078+
2.1079+(defun paredit-semicolon (&optional n)
2.1080+ "Insert a semicolon.
2.1081+With a prefix argument N, insert N semicolons.
2.1082+If in a string, do just that and nothing else.
2.1083+If in a character literal, move to the beginning of the character
2.1084+ literal before inserting the semicolon.
2.1085+If the enclosing list ends on the line after the point, break the line
2.1086+ after the last S-expression following the point.
2.1087+If a list begins on the line after the point but ends on a different
2.1088+ line, break the line after the last S-expression following the point
2.1089+ before the list."
2.1090+ (interactive "p")
2.1091+ (if (or (paredit-in-string-p) (paredit-in-comment-p))
2.1092+ (insert (make-string (or n 1) ?\; ))
2.1093+ (if (paredit-in-char-p)
2.1094+ (backward-char 2))
2.1095+ (let ((line-break-point (paredit-semicolon-find-line-break-point)))
2.1096+ (if line-break-point
2.1097+ (paredit-semicolon-with-line-break line-break-point (or n 1))
2.1098+ (insert (make-string (or n 1) ?\; ))))))
2.1099+
2.1100+(defun paredit-semicolon-find-line-break-point ()
2.1101+ (and (not (eolp)) ;Implies (not (eobp)).
2.1102+ (let ((eol (point-at-eol)))
2.1103+ (save-excursion
2.1104+ (catch 'exit
2.1105+ (while t
2.1106+ (let ((line-break-point (point)))
2.1107+ (cond ((paredit-handle-sexp-errors (progn (forward-sexp) t)
2.1108+ nil)
2.1109+ ;; Successfully advanced by an S-expression.
2.1110+ ;; If that S-expression started on this line
2.1111+ ;; and ended on another one, break here.
2.1112+ (cond ((not (eq eol (point-at-eol)))
2.1113+ (throw 'exit
2.1114+ (and (save-excursion
2.1115+ (backward-sexp)
2.1116+ (eq eol (point-at-eol)))
2.1117+ line-break-point)))
2.1118+ ((eobp)
2.1119+ (throw 'exit nil))))
2.1120+ ((save-excursion
2.1121+ (paredit-skip-whitespace t (point-at-eol))
2.1122+ (or (eolp) (eobp) (eq (char-after) ?\;)))
2.1123+ ;; Can't move further, but there's no closing
2.1124+ ;; delimiter we're about to clobber -- either
2.1125+ ;; it's on the next line or we're at the end of
2.1126+ ;; the buffer. Don't break the line.
2.1127+ (throw 'exit nil))
2.1128+ (t
2.1129+ ;; Can't move because we hit a delimiter at the
2.1130+ ;; end of this line. Break here.
2.1131+ (throw 'exit line-break-point))))))))))
2.1132+
2.1133+(defun paredit-semicolon-with-line-break (line-break-point n)
2.1134+ (let ((line-break-marker (make-marker)))
2.1135+ (set-marker line-break-marker line-break-point)
2.1136+ (set-marker-insertion-type line-break-marker t)
2.1137+ (insert (make-string (or n 1) ?\; ))
2.1138+ (save-excursion
2.1139+ (goto-char line-break-marker)
2.1140+ (set-marker line-break-marker nil)
2.1141+ (newline)
2.1142+ (lisp-indent-line)
2.1143+ ;; This step is redundant if we are inside a list, but even if we
2.1144+ ;; are at the top level, we want at least to indent whatever we
2.1145+ ;; bumped off the line.
2.1146+ (paredit-ignore-sexp-errors (indent-sexp))
2.1147+ (paredit-indent-sexps))))
2.1148+
2.1149+;;; This is all a horrible, horrible hack, primarily for GNU Emacs 21,
2.1150+;;; in which there is no `comment-or-uncomment-region'.
2.1151+
2.1152+(autoload 'comment-forward "newcomment")
2.1153+(autoload 'comment-normalize-vars "newcomment")
2.1154+(autoload 'comment-region "newcomment")
2.1155+(autoload 'comment-search-forward "newcomment")
2.1156+(autoload 'uncomment-region "newcomment")
2.1157+
2.1158+(defun paredit-initialize-comment-dwim ()
2.1159+ (require 'newcomment)
2.1160+ (if (not (fboundp 'comment-or-uncomment-region))
2.1161+ (defalias 'comment-or-uncomment-region
2.1162+ (lambda (beginning end &optional argument)
2.1163+ (interactive "*r\nP")
2.1164+ (if (save-excursion (goto-char beginning)
2.1165+ (comment-forward (point-max))
2.1166+ (<= end (point)))
2.1167+ (uncomment-region beginning end argument)
2.1168+ (comment-region beginning end argument)))))
2.1169+ (defalias 'paredit-initialize-comment-dwim 'comment-normalize-vars)
2.1170+ (comment-normalize-vars))
2.1171+
2.1172+(defvar paredit-comment-prefix-toplevel ";;; "
2.1173+ "String of prefix for top-level comments aligned at the left margin.")
2.1174+
2.1175+(defvar paredit-comment-prefix-code ";; "
2.1176+ "String of prefix for comments indented at the same depth as code.")
2.1177+
2.1178+(defvar paredit-comment-prefix-margin ";"
2.1179+ "String of prefix for comments on the same line as code in the margin.")
2.1180+
2.1181+(defun paredit-comment-dwim (&optional argument)
2.1182+ "Call the Lisp comment command you want (Do What I Mean).
2.1183+This is like `comment-dwim', but it is specialized for Lisp editing.
2.1184+If transient mark mode is enabled and the mark is active, comment or
2.1185+ uncomment the selected region, depending on whether it was entirely
2.1186+ commented not not already.
2.1187+If there is already a comment on the current line, with no prefix
2.1188+ argument, indent to that comment; with a prefix argument, kill that
2.1189+ comment.
2.1190+Otherwise, insert a comment appropriate for the context and ensure that
2.1191+ any code following the comment is moved to the next line.
2.1192+At the top level, where indentation is calculated to be at column 0,
2.1193+ insert a triple-semicolon comment; within code, where the indentation
2.1194+ is calculated to be non-zero, and on the line there is either no code
2.1195+ at all or code after the point, insert a double-semicolon comment;
2.1196+ and if the point is after all code on the line, insert a single-
2.1197+ semicolon margin comment at `comment-column'."
2.1198+ (interactive "*P")
2.1199+ (paredit-initialize-comment-dwim)
2.1200+ (cond ((paredit-region-active-p)
2.1201+ (comment-or-uncomment-region (region-beginning)
2.1202+ (region-end)
2.1203+ argument))
2.1204+ ((paredit-comment-on-line-p)
2.1205+ (if argument
2.1206+ (comment-kill (if (integerp argument) argument nil))
2.1207+ (comment-indent)))
2.1208+ (t (paredit-insert-comment))))
2.1209+
2.1210+(defun paredit-comment-on-line-p ()
2.1211+ "True if there is a comment on the line following point.
2.1212+This is expected to be called only in `paredit-comment-dwim'; do not
2.1213+ call it elsewhere."
2.1214+ (save-excursion
2.1215+ (beginning-of-line)
2.1216+ (let ((comment-p nil))
2.1217+ ;; Search forward for a comment beginning. If there is one, set
2.1218+ ;; COMMENT-P to true; if not, it will be nil.
2.1219+ (while (progn
2.1220+ (setq comment-p ;t -> no error
2.1221+ (comment-search-forward (point-at-eol) t))
2.1222+ (and comment-p
2.1223+ (or (paredit-in-string-p)
2.1224+ (paredit-in-char-p (1- (point))))))
2.1225+ (forward-char))
2.1226+ comment-p)))
2.1227+
2.1228+(defun paredit-insert-comment ()
2.1229+ (let ((code-after-p
2.1230+ (save-excursion (paredit-skip-whitespace t (point-at-eol))
2.1231+ (not (eolp))))
2.1232+ (code-before-p
2.1233+ (save-excursion (paredit-skip-whitespace nil (point-at-bol))
2.1234+ (not (bolp)))))
2.1235+ (cond ((and (bolp)
2.1236+ (let ((indent
2.1237+ (let ((indent (calculate-lisp-indent)))
2.1238+ (if (consp indent) (car indent) indent))))
2.1239+ (and indent (zerop indent))))
2.1240+ ;; Top-level comment
2.1241+ (if code-after-p (save-excursion (newline)))
2.1242+ (insert paredit-comment-prefix-toplevel))
2.1243+ ((or code-after-p (not code-before-p))
2.1244+ ;; Code comment
2.1245+ (if code-before-p
2.1246+ (newline-and-indent)
2.1247+ (lisp-indent-line))
2.1248+ (insert paredit-comment-prefix-code)
2.1249+ (if code-after-p
2.1250+ (save-excursion
2.1251+ (newline)
2.1252+ (lisp-indent-line)
2.1253+ (paredit-indent-sexps))))
2.1254+ (t
2.1255+ ;; Margin comment
2.1256+ (indent-to comment-column 1) ; 1 -> force one leading space
2.1257+ (insert paredit-comment-prefix-margin)))))
2.1258+
2.1259+;;;; Character Deletion
2.1260+
2.1261+(defun paredit-delete-char (&optional argument)
2.1262+ "Delete a character forward or move forward over a delimiter.
2.1263+If on an opening S-expression delimiter, move forward into the
2.1264+ S-expression.
2.1265+If on a closing S-expression delimiter, refuse to delete unless the
2.1266+ S-expression is empty, in which case delete the whole S-expression.
2.1267+With a numeric prefix argument N, delete N characters forward.
2.1268+With a `C-u' prefix argument, simply delete a character forward,
2.1269+ without regard for delimiter balancing.
2.1270+
2.1271+Like `delete-char', ignores `delete-active-region'."
2.1272+ (interactive "P")
2.1273+ (let ((delete-active-region nil))
2.1274+ (paredit-forward-delete argument)))
2.1275+
2.1276+(defun paredit-delete-active-region-p ()
2.1277+ "True if the region is active and to be deleted."
2.1278+ (and (paredit-region-active-p)
2.1279+ (boundp 'delete-active-region)
2.1280+ (eq delete-active-region t)))
2.1281+
2.1282+(defun paredit-kill-active-region-p ()
2.1283+ "True if the region is active and to be killed."
2.1284+ (and (paredit-region-active-p)
2.1285+ (boundp 'delete-active-region)
2.1286+ (eq delete-active-region 'kill)))
2.1287+
2.1288+(defun paredit-forward-delete (&optional argument)
2.1289+ "Delete a character forward or move forward over a delimiter.
2.1290+If on an opening S-expression delimiter, move forward into the
2.1291+ S-expression.
2.1292+If on a closing S-expression delimiter, refuse to delete unless the
2.1293+ S-expression is empty, in which case delete the whole S-expression.
2.1294+With a numeric prefix argument N, delete N characters forward.
2.1295+With a `C-u' prefix argument, simply delete a character forward,
2.1296+ without regard for delimiter balancing.
2.1297+
2.1298+If `delete-active-region' is enabled and the mark is active and
2.1299+ no prefix argument is specified, act as `paredit-delete-region'
2.1300+ or `paredit-kill-region' as appropriate instead."
2.1301+ (interactive "P")
2.1302+ (cond ((consp argument)
2.1303+ (delete-char +1))
2.1304+ ((integerp argument)
2.1305+ (let ((delete-active-region nil))
2.1306+ (if (< argument 0)
2.1307+ (paredit-backward-delete argument)
2.1308+ (while (> argument 0)
2.1309+ (paredit-forward-delete)
2.1310+ (setq argument (- argument 1))))))
2.1311+ ((paredit-delete-active-region-p)
2.1312+ (paredit-delete-region (region-beginning) (region-end)))
2.1313+ ((paredit-kill-active-region-p)
2.1314+ (paredit-kill-region (region-beginning) (region-end)))
2.1315+ ((eobp)
2.1316+ (delete-char +1))
2.1317+ ((paredit-in-string-p)
2.1318+ (paredit-forward-delete-in-string))
2.1319+ ((paredit-in-comment-p)
2.1320+ (paredit-forward-delete-in-comment))
2.1321+ ((paredit-in-char-p) ; Escape -- delete both chars.
2.1322+ (delete-char -1)
2.1323+ (delete-char +1))
2.1324+ ((eq (char-after) ?\\ ) ; ditto
2.1325+ (delete-char +2))
2.1326+ ((let ((syn (char-syntax (char-after))))
2.1327+ (or (eq syn ?\( )
2.1328+ (eq syn ?\" )))
2.1329+ (if (save-excursion
2.1330+ (paredit-handle-sexp-errors (progn (forward-sexp) t)
2.1331+ nil))
2.1332+ (forward-char)
2.1333+ (message "Deleting spurious opening delimiter.")
2.1334+ (delete-char +1)))
2.1335+ ((and (not (paredit-in-char-p (1- (point))))
2.1336+ (eq (char-syntax (char-after)) ?\) )
2.1337+ (eq (char-before) (matching-paren (char-after))))
2.1338+ (delete-char -1) ; Empty list -- delete both
2.1339+ (delete-char +1)) ; delimiters.
2.1340+ ((eq ?\; (char-after))
2.1341+ (paredit-forward-delete-comment-start))
2.1342+ ((eq (char-syntax (char-after)) ?\) )
2.1343+ (if (paredit-handle-sexp-errors
2.1344+ (save-excursion (forward-char) (backward-sexp) t)
2.1345+ nil)
2.1346+ (message "End of list!")
2.1347+ (progn
2.1348+ (message "Deleting spurious closing delimiter.")
2.1349+ (delete-char +1))))
2.1350+ ;; Just delete a single character, if it's not a closing
2.1351+ ;; delimiter. (The character literal case is already handled
2.1352+ ;; by now.)
2.1353+ (t (delete-char +1))))
2.1354+
2.1355+(defun paredit-forward-delete-in-string ()
2.1356+ (let ((start+end (paredit-string-start+end-points)))
2.1357+ (cond ((not (eq (point) (cdr start+end)))
2.1358+ ;; If it's not the close-quote, it's safe to delete. But
2.1359+ ;; first handle the case that we're in a string escape.
2.1360+ (cond ((paredit-in-string-escape-p)
2.1361+ ;; We're right after the backslash, so backward
2.1362+ ;; delete it before deleting the escaped character.
2.1363+ (delete-char -1))
2.1364+ ((eq (char-after) ?\\ )
2.1365+ ;; If we're not in a string escape, but we are on a
2.1366+ ;; backslash, it must start the escape for the next
2.1367+ ;; character, so delete the backslash before deleting
2.1368+ ;; the next character.
2.1369+ (delete-char +1)))
2.1370+ (delete-char +1))
2.1371+ ((eq (1- (point)) (car start+end))
2.1372+ ;; If it is the close-quote, delete only if we're also right
2.1373+ ;; past the open-quote (i.e. it's empty), and then delete
2.1374+ ;; both quotes. Otherwise we refuse to delete it.
2.1375+ (delete-char -1)
2.1376+ (delete-char +1)))))
2.1377+
2.1378+(defun paredit-check-forward-delete-in-comment ()
2.1379+ ;; Point is in a comment, possibly at eol. We are about to delete
2.1380+ ;; some characters forward; if we are at eol, we are about to delete
2.1381+ ;; the line break. Refuse to do so if if moving the next line into
2.1382+ ;; the comment would break structure.
2.1383+ (if (eolp)
2.1384+ (let ((next-line-start (point-at-bol 2))
2.1385+ (next-line-end (point-at-eol 2)))
2.1386+ (paredit-check-region next-line-start next-line-end))))
2.1387+
2.1388+(defun paredit-forward-delete-in-comment ()
2.1389+ (paredit-check-forward-delete-in-comment)
2.1390+ (delete-char +1))
2.1391+
2.1392+(defun paredit-forward-delete-comment-start ()
2.1393+ ;; Point precedes a comment start (not at eol). Refuse to delete a
2.1394+ ;; comment start if the comment contains unbalanced junk.
2.1395+ (paredit-check-region (+ (point) 1) (point-at-eol))
2.1396+ (delete-char +1))
2.1397+
2.1398+(defun paredit-backward-delete (&optional argument)
2.1399+ "Delete a character backward or move backward over a delimiter.
2.1400+If on a closing S-expression delimiter, move backward into the
2.1401+ S-expression.
2.1402+If on an opening S-expression delimiter, refuse to delete unless the
2.1403+ S-expression is empty, in which case delete the whole S-expression.
2.1404+With a numeric prefix argument N, delete N characters backward.
2.1405+With a `C-u' prefix argument, simply delete a character backward,
2.1406+ without regard for delimiter balancing.
2.1407+
2.1408+If `delete-active-region' is enabled and the mark is active and
2.1409+ no prefix argument is specified, act as `paredit-delete-region'
2.1410+ or `paredit-kill-region' as appropriate instead."
2.1411+ (interactive "P")
2.1412+ (cond ((consp argument)
2.1413+ ;++ Should this untabify?
2.1414+ (delete-char -1))
2.1415+ ((integerp argument)
2.1416+ (let ((delete-active-region nil))
2.1417+ (if (< argument 0)
2.1418+ (paredit-forward-delete (- 0 argument))
2.1419+ (while (> argument 0)
2.1420+ (paredit-backward-delete)
2.1421+ (setq argument (- argument 1))))))
2.1422+ ((paredit-delete-active-region-p)
2.1423+ (paredit-delete-region (region-beginning) (region-end)))
2.1424+ ((paredit-kill-active-region-p)
2.1425+ (paredit-kill-region (region-beginning) (region-end)))
2.1426+ ((bobp)
2.1427+ (delete-char -1))
2.1428+ ((paredit-in-string-p)
2.1429+ (paredit-backward-delete-in-string))
2.1430+ ((paredit-in-comment-p)
2.1431+ (paredit-backward-delete-in-comment))
2.1432+ ((paredit-in-char-p) ; Escape -- delete both chars.
2.1433+ (delete-char -1)
2.1434+ (delete-char +1))
2.1435+ ((paredit-in-char-p (1- (point)))
2.1436+ (delete-char -2)) ; ditto
2.1437+ ((let ((syn (char-syntax (char-before))))
2.1438+ (or (eq syn ?\) )
2.1439+ (eq syn ?\" )))
2.1440+ (if (save-excursion
2.1441+ (paredit-handle-sexp-errors (progn (backward-sexp) t)
2.1442+ nil))
2.1443+ (backward-char)
2.1444+ (message "Deleting spurious closing delimiter.")
2.1445+ (delete-char -1)))
2.1446+ ((and (eq (char-syntax (char-before)) ?\( )
2.1447+ (eq (char-after) (matching-paren (char-before))))
2.1448+ (delete-char -1) ; Empty list -- delete both
2.1449+ (delete-char +1)) ; delimiters.
2.1450+ ((bolp)
2.1451+ (paredit-backward-delete-maybe-comment-end))
2.1452+ ((eq (char-syntax (char-before)) ?\( )
2.1453+ (if (paredit-handle-sexp-errors
2.1454+ (save-excursion (backward-char) (forward-sexp) t)
2.1455+ nil)
2.1456+ (message "Beginning of list!")
2.1457+ (progn
2.1458+ (message "Deleting spurious closing delimiter.")
2.1459+ (delete-char -1))))
2.1460+ ;; Delete it, unless it's an opening delimiter. The case of
2.1461+ ;; character literals is already handled by now.
2.1462+ (t
2.1463+ ;; Turn off the @#&*&!^&(%^ botch in GNU Emacs 24 that changed
2.1464+ ;; `backward-delete-char' and `backward-delete-char-untabify'
2.1465+ ;; semantically so that they delete the region in transient
2.1466+ ;; mark mode.
2.1467+ (let ((delete-active-region nil))
2.1468+ (backward-delete-char-untabify +1)))))
2.1469+
2.1470+(defun paredit-backward-delete-in-string ()
2.1471+ (let ((start+end (paredit-string-start+end-points)))
2.1472+ (cond ((not (eq (1- (point)) (car start+end)))
2.1473+ ;; If it's not the open-quote, it's safe to delete.
2.1474+ (if (paredit-in-string-escape-p)
2.1475+ ;; If we're on a string escape, since we're about to
2.1476+ ;; delete the backslash, we must first delete the
2.1477+ ;; escaped char.
2.1478+ (delete-char +1))
2.1479+ (delete-char -1)
2.1480+ (if (paredit-in-string-escape-p)
2.1481+ ;; If, after deleting a character, we find ourselves in
2.1482+ ;; a string escape, we must have deleted the escaped
2.1483+ ;; character, and the backslash is behind the point, so
2.1484+ ;; backward delete it.
2.1485+ (delete-char -1)))
2.1486+ ((eq (point) (cdr start+end))
2.1487+ ;; If it is the open-quote, delete only if we're also right
2.1488+ ;; past the close-quote (i.e. it's empty), and then delete
2.1489+ ;; both quotes. Otherwise we refuse to delete it.
2.1490+ (delete-char -1)
2.1491+ (delete-char +1)))))
2.1492+
2.1493+(defun paredit-backward-delete-in-comment ()
2.1494+ ;; Point is in a comment, possibly just after the comment start.
2.1495+ ;; Refuse to delete a comment start if the comment contains
2.1496+ ;; unbalanced junk.
2.1497+ (if (save-excursion
2.1498+ (backward-char)
2.1499+ ;; Must call `paredit-in-string-p' before
2.1500+ ;; `paredit-in-comment-p'.
2.1501+ (not (or (paredit-in-string-p) (paredit-in-comment-p))))
2.1502+ (paredit-check-region (point) (point-at-eol)))
2.1503+ (backward-delete-char-untabify +1))
2.1504+
2.1505+(defun paredit-backward-delete-maybe-comment-end ()
2.1506+ ;; Point is at bol, possibly just after a comment end (i.e., the
2.1507+ ;; previous line may have had a line comment). Refuse to delete a
2.1508+ ;; comment end if moving the current line into the previous line's
2.1509+ ;; comment would break structure.
2.1510+ (if (save-excursion
2.1511+ (backward-char)
2.1512+ (and (not (paredit-in-string-p)) (paredit-in-comment-p)))
2.1513+ (paredit-check-region (point-at-eol) (point-at-bol)))
2.1514+ (delete-char -1))
2.1515+
2.1516+;;;; Killing
2.1517+
2.1518+(defun paredit-kill (&optional argument)
2.1519+ "Kill a line as if with `kill-line', but respecting delimiters.
2.1520+In a string, act exactly as `kill-line' but do not kill past the
2.1521+ closing string delimiter.
2.1522+On a line with no S-expressions on it starting after the point or
2.1523+ within a comment, act exactly as `kill-line'.
2.1524+Otherwise, kill all S-expressions that start after the point.
2.1525+With a `C-u' prefix argument, just do the standard `kill-line'.
2.1526+With a numeric prefix argument N, do `kill-line' that many times.
2.1527+
2.1528+If `kill-whole-line' is true, kills the newline character and
2.1529+ indentation on the next line as well.
2.1530+In that case, ensure there is at least one space between the
2.1531+ preceding S-expression and whatever follows on the next line."
2.1532+ (interactive "P")
2.1533+ (cond (argument
2.1534+ (kill-line (if (integerp argument) argument 1)))
2.1535+ ((paredit-in-string-p)
2.1536+ (paredit-kill-line-in-string))
2.1537+ ((paredit-in-comment-p)
2.1538+ (paredit-kill-line-in-comment))
2.1539+ ((save-excursion (paredit-skip-whitespace t (point-at-eol))
2.1540+ (or (eolp) (eq (char-after) ?\; )))
2.1541+ ;** Be careful about trailing backslashes.
2.1542+ (if (paredit-in-char-p)
2.1543+ (backward-char))
2.1544+ (kill-line))
2.1545+ (t (paredit-kill-sexps-on-line))))
2.1546+
2.1547+(defun paredit-kill-line-in-string ()
2.1548+ (if (save-excursion (paredit-skip-whitespace t (point-at-eol))
2.1549+ (eolp))
2.1550+ (kill-line)
2.1551+ (save-excursion
2.1552+ ;; Be careful not to split an escape sequence.
2.1553+ (if (paredit-in-string-escape-p)
2.1554+ (backward-char))
2.1555+ (kill-region (point)
2.1556+ (min (point-at-eol)
2.1557+ (cdr (paredit-string-start+end-points)))))))
2.1558+
2.1559+(defun paredit-kill-line-in-comment ()
2.1560+ ;; The variable `kill-whole-line' is not relevant: the point is in a
2.1561+ ;; comment, and hence not at the beginning of the line.
2.1562+ (paredit-check-forward-delete-in-comment)
2.1563+ (kill-line))
2.1564+
2.1565+(defun paredit-kill-sexps-on-line ()
2.1566+ (if (paredit-in-char-p) ; Move past the \ and prefix.
2.1567+ (backward-char 2)) ; (# in Scheme/CL, ? in elisp)
2.1568+ (let ((beginning (point))
2.1569+ (eol (point-at-eol)))
2.1570+ (let ((end-of-list-p (paredit-forward-sexps-to-kill beginning eol)))
2.1571+ ;; If we got to the end of the list and it's on the same line,
2.1572+ ;; move backward past the closing delimiter before killing. (This
2.1573+ ;; allows something like killing the whitespace in ( ).)
2.1574+ (if end-of-list-p (progn (up-list) (backward-char)))
2.1575+ (if kill-whole-line
2.1576+ (paredit-kill-sexps-on-whole-line beginning)
2.1577+ (kill-region beginning
2.1578+ ;; If all of the S-expressions were on one line,
2.1579+ ;; i.e. we're still on that line after moving past
2.1580+ ;; the last one, kill the whole line, including
2.1581+ ;; any comments; otherwise just kill to the end of
2.1582+ ;; the last S-expression we found. Be sure,
2.1583+ ;; though, not to kill any closing parentheses.
2.1584+ (if (and (not end-of-list-p)
2.1585+ (eq (point-at-eol) eol))
2.1586+ eol
2.1587+ (point)))))))
2.1588+
2.1589+;;; Move to the end of the last S-expression that started on this line,
2.1590+;;; or to the closing delimiter if the last S-expression in this list
2.1591+;;; and the closing delimiter both lie on this line. Return true if
2.1592+;;; the closing delimiter of this list is on this line, false if not.
2.1593+;;;
2.1594+;;; beginning is (point), and eol is (point-at-eol). Handling of
2.1595+;;; `kill-whole-line' is trick, and probably kind of broken.
2.1596+
2.1597+(defun paredit-forward-sexps-to-kill (beginning eol)
2.1598+ (let ((end-of-list-p nil) ;Have we hit a closing delimiter on this line?
2.1599+ (firstp t)) ;Is this still the first line?
2.1600+ (catch 'return
2.1601+ (while t
2.1602+ ;; This and the `kill-whole-line' business below fix a bug that
2.1603+ ;; inhibited any S-expression at the very end of the buffer
2.1604+ ;; (with no trailing newline) from being deleted. It's a
2.1605+ ;; bizarre fix that I ought to document at some point, but I am
2.1606+ ;; too busy at the moment to do so.
2.1607+ (if (and kill-whole-line (eobp)) (throw 'return nil))
2.1608+ ;; See if we can move forward, and stay on an S-expression that
2.1609+ ;; started on this line.
2.1610+ (save-excursion
2.1611+ (paredit-handle-sexp-errors (forward-sexp)
2.1612+ ;; Can't move forward -- we must have hit the end of a
2.1613+ ;; list. Stop here, but record whether the closing
2.1614+ ;; delimiter occurred on the starting line.
2.1615+ (up-list)
2.1616+ (setq end-of-list-p (eq (point-at-eol) eol))
2.1617+ (throw 'return nil))
2.1618+ ;; We can move forward. Where did we move to? Stop if:
2.1619+ ;;
2.1620+ ;; (a) we hit the end of the buffer in certain circumstances
2.1621+ ;; (XXX why are these circumstances? necessary according
2.1622+ ;; to tests, need explanation), because forward-sexp
2.1623+ ;; didn't/won't make any progress and we'll get stuck in
2.1624+ ;; a loop; or
2.1625+ ;;
2.1626+ ;; (b) the S-expression we moved to the end to actually
2.1627+ ;; started on line after where we started so it's not
2.1628+ ;; under our jurisdiction.
2.1629+ (if (or (and (not firstp) ;(a)
2.1630+ (not kill-whole-line)
2.1631+ (eobp))
2.1632+ (paredit-handle-sexp-errors ;(b)
2.1633+ (progn (backward-sexp) nil)
2.1634+ t)
2.1635+ (not (eq (point-at-eol) eol)))
2.1636+ (throw 'return nil)))
2.1637+ ;; Determined we can and should move forward. Do so.
2.1638+ (forward-sexp)
2.1639+ ;; In certain other circumstances (XXX need explanation), if we
2.1640+ ;; hit the end of the buffer, stop here; otherwise the next
2.1641+ ;; forward-sexp will fail to make progress and we might get
2.1642+ ;; stuck in a loop.
2.1643+ (if (and firstp
2.1644+ (not kill-whole-line)
2.1645+ (eobp))
2.1646+ (throw 'return nil))
2.1647+ ;; We have made it past one S-expression.
2.1648+ (setq firstp nil)))
2.1649+ end-of-list-p))
2.1650+
2.1651+;;; Handle the actual kill when `kill-whole-line' is enabled.
2.1652+;;;
2.1653+;;; XXX This has various broken edge cases (see the xfails in test.el)
2.1654+;;; and it doesn't make paredit-kill/yank a noop on round-trip, in an
2.1655+;;; attempt to avoid inadvertently joining S-expressions when it
2.1656+;;; deletes the newline. It could use some input and logic from a user
2.1657+;;; who relies on `kill-whole-line' and has a better sense of
2.1658+;;; expectations.
2.1659+
2.1660+(defun paredit-kill-sexps-on-whole-line (beginning)
2.1661+ (kill-region beginning
2.1662+ (or (save-excursion ; Delete trailing indentation...
2.1663+ (paredit-skip-whitespace t)
2.1664+ (and (not (eq (char-after) ?\; ))
2.1665+ (point)))
2.1666+ ;; ...or just use the point past the newline, if
2.1667+ ;; we encounter a comment.
2.1668+ (point-at-eol)))
2.1669+ (cond ((save-excursion (paredit-skip-whitespace nil (point-at-bol))
2.1670+ (bolp))
2.1671+ ;; Nothing but indentation before the point, so indent it.
2.1672+ (lisp-indent-line))
2.1673+ ((eobp) nil) ; Protect the CHAR-SYNTAX below against NIL.
2.1674+ ;; Insert a space to avoid invalid joining if necessary.
2.1675+ ((let ((syn-before (char-syntax (char-before)))
2.1676+ (syn-after (char-syntax (char-after))))
2.1677+ (and (memq syn-before '(?\) ?\" ?_ ?w))
2.1678+ (memq syn-after '(?\( ?\" ?_ ?w))))
2.1679+ (save-excursion (insert " ")))))
2.1680+
2.1681+;;;;; Killing Words
2.1682+
2.1683+;;; This is tricky and asymmetrical because backward parsing is
2.1684+;;; extraordinarily difficult or impossible, so we have to implement
2.1685+;;; killing in both directions by parsing forward.
2.1686+
2.1687+(defun paredit-forward-kill-word (&optional argument)
2.1688+ "Kill a word forward, skipping over intervening delimiters."
2.1689+ (interactive "p")
2.1690+ (let ((argument (or argument 1)))
2.1691+ (if (< argument 0)
2.1692+ (paredit-backward-kill-word (- argument))
2.1693+ (dotimes (i argument)
2.1694+ (let ((beginning (point)))
2.1695+ (skip-syntax-forward " -")
2.1696+ (let* ((parse-state (paredit-current-parse-state))
2.1697+ (state (paredit-kill-word-state parse-state 'char-after)))
2.1698+ (while (not (or (eobp)
2.1699+ (eq ?w (char-syntax (char-after)))))
2.1700+ (setq parse-state
2.1701+ (progn (forward-char 1) (paredit-current-parse-state))
2.1702+ ;; XXX Why did I comment this out?
2.1703+ ;; (parse-partial-sexp (point) (1+ (point))
2.1704+ ;; nil nil parse-state)
2.1705+ )
2.1706+ (let* ((old-state state)
2.1707+ (new-state
2.1708+ (paredit-kill-word-state parse-state 'char-after)))
2.1709+ (cond ((not (eq old-state new-state))
2.1710+ (setq parse-state
2.1711+ (paredit-kill-word-hack old-state
2.1712+ new-state
2.1713+ parse-state))
2.1714+ (setq state
2.1715+ (paredit-kill-word-state parse-state
2.1716+ 'char-after))
2.1717+ (setq beginning (point)))))))
2.1718+ (goto-char beginning)
2.1719+ (kill-word 1))))))
2.1720+
2.1721+(defun paredit-backward-kill-word (&optional argument)
2.1722+ "Kill a word backward, skipping over any intervening delimiters."
2.1723+ (interactive "p")
2.1724+ (let ((argument (or argument 1)))
2.1725+ (if (< argument 0)
2.1726+ (paredit-forward-kill-word (- argument))
2.1727+ (dotimes (i argument)
2.1728+ (if (not (or (bobp)
2.1729+ (eq (char-syntax (char-before)) ?w)))
2.1730+ (let ((end (point)))
2.1731+ (backward-word 1)
2.1732+ (forward-word 1)
2.1733+ (goto-char (min end (point)))
2.1734+ (let* ((parse-state (paredit-current-parse-state))
2.1735+ (state
2.1736+ (paredit-kill-word-state parse-state 'char-before)))
2.1737+ (while (and (< (point) end)
2.1738+ (progn
2.1739+ (setq parse-state
2.1740+ (parse-partial-sexp (point) (1+ (point))
2.1741+ nil nil parse-state))
2.1742+ (or (eq state
2.1743+ (paredit-kill-word-state parse-state
2.1744+ 'char-before))
2.1745+ (progn (backward-char 1) nil)))))
2.1746+ (if (and (eq state 'comment)
2.1747+ (eq ?\# (char-after (point)))
2.1748+ (eq ?\| (char-before (point))))
2.1749+ (backward-char 1)))))
2.1750+ (backward-kill-word 1)))))
2.1751+
2.1752+;;;;;; Word-Killing Auxiliaries
2.1753+
2.1754+(defun paredit-kill-word-state (parse-state adjacent-char-fn)
2.1755+ (cond ((paredit-in-comment-p parse-state) 'comment)
2.1756+ ((paredit-in-string-p parse-state) 'string)
2.1757+ ((memq (char-syntax (funcall adjacent-char-fn))
2.1758+ '(?\( ?\) ))
2.1759+ 'delimiter)
2.1760+ (t 'other)))
2.1761+
2.1762+;;; This optionally advances the point past any comment delimiters that
2.1763+;;; should probably not be touched, based on the last state change and
2.1764+;;; the characters around the point. It returns a new parse state,
2.1765+;;; starting from the PARSE-STATE parameter.
2.1766+
2.1767+(defun paredit-kill-word-hack (old-state new-state parse-state)
2.1768+ (cond ((and (not (eq old-state 'comment))
2.1769+ (not (eq new-state 'comment))
2.1770+ (not (paredit-in-string-escape-p))
2.1771+ (eq ?\# (char-before))
2.1772+ (eq ?\| (char-after)))
2.1773+ (forward-char 1)
2.1774+ (paredit-current-parse-state)
2.1775+;; (parse-partial-sexp (point) (1+ (point))
2.1776+;; nil nil parse-state)
2.1777+ )
2.1778+ ((and (not (eq old-state 'comment))
2.1779+ (eq new-state 'comment)
2.1780+ (eq ?\; (char-before)))
2.1781+ (skip-chars-forward ";")
2.1782+ (paredit-current-parse-state)
2.1783+;; (parse-partial-sexp (point) (save-excursion
2.1784+;; (skip-chars-forward ";"))
2.1785+;; nil nil parse-state)
2.1786+ )
2.1787+ (t parse-state)))
2.1788+
2.1789+(defun paredit-copy-as-kill ()
2.1790+ "Save in the kill ring the region that `paredit-kill' would kill."
2.1791+ (interactive)
2.1792+ (cond ((paredit-in-string-p)
2.1793+ (paredit-copy-as-kill-in-string))
2.1794+ ((paredit-in-comment-p)
2.1795+ (copy-region-as-kill (point) (point-at-eol)))
2.1796+ ((save-excursion (paredit-skip-whitespace t (point-at-eol))
2.1797+ (or (eolp) (eq (char-after) ?\; )))
2.1798+ ;** Be careful about trailing backslashes.
2.1799+ (save-excursion
2.1800+ (if (paredit-in-char-p)
2.1801+ (backward-char))
2.1802+ (copy-region-as-kill (point) (point-at-eol))))
2.1803+ (t (paredit-copy-sexps-as-kill))))
2.1804+
2.1805+(defun paredit-copy-as-kill-in-string ()
2.1806+ (save-excursion
2.1807+ (if (paredit-in-string-escape-p)
2.1808+ (backward-char))
2.1809+ (copy-region-as-kill (point)
2.1810+ (min (point-at-eol)
2.1811+ (cdr (paredit-string-start+end-points))))))
2.1812+
2.1813+(defun paredit-copy-sexps-as-kill ()
2.1814+ (save-excursion
2.1815+ (if (paredit-in-char-p)
2.1816+ (backward-char 2))
2.1817+ (let ((beginning (point))
2.1818+ (eol (point-at-eol)))
2.1819+ (let ((end-of-list-p (paredit-forward-sexps-to-kill beginning eol)))
2.1820+ (if end-of-list-p (progn (up-list) (backward-char)))
2.1821+ (copy-region-as-kill beginning
2.1822+ (cond (kill-whole-line
2.1823+ (or (save-excursion
2.1824+ (paredit-skip-whitespace t)
2.1825+ (and (not (eq (char-after) ?\; ))
2.1826+ (point)))
2.1827+ (point-at-eol)))
2.1828+ ((and (not end-of-list-p)
2.1829+ (eq (point-at-eol) eol))
2.1830+ eol)
2.1831+ (t
2.1832+ (point))))))))
2.1833+
2.1834+;;;; Deleting Regions
2.1835+
2.1836+(defun paredit-delete-region (start end)
2.1837+ "Delete the text between point and mark, like `delete-region'.
2.1838+If that text is unbalanced, signal an error instead.
2.1839+With a prefix argument, skip the balance check."
2.1840+ (interactive "r")
2.1841+ (if (and start end (not current-prefix-arg))
2.1842+ (paredit-check-region-for-delete start end))
2.1843+ (setq this-command 'delete-region)
2.1844+ (delete-region start end))
2.1845+
2.1846+(defun paredit-kill-region (start end)
2.1847+ "Kill the text between point and mark, like `kill-region'.
2.1848+If that text is unbalanced, signal an error instead.
2.1849+With a prefix argument, skip the balance check."
2.1850+ (interactive "r")
2.1851+ (if (and start end (not current-prefix-arg))
2.1852+ (paredit-check-region-for-delete start end))
2.1853+ (setq this-command 'kill-region)
2.1854+ (kill-region start end))
2.1855+
2.1856+(defun paredit-check-region-for-delete (start end)
2.1857+ "Signal an error deleting text between START and END is unsafe."
2.1858+ (save-excursion
2.1859+ (goto-char start)
2.1860+ (let* ((start-state (paredit-current-parse-state))
2.1861+ (end-state (parse-partial-sexp start end nil nil start-state)))
2.1862+ (paredit-check-region-for-delete:depth start start-state end end-state)
2.1863+ (paredit-check-region-for-delete:string start start-state end end-state)
2.1864+ (paredit-check-region-for-delete:comment start start-state end end-state)
2.1865+ (paredit-check-region-for-delete:char-quote start start-state
2.1866+ end end-state))))
2.1867+
2.1868+(defun paredit-check-region-for-delete:depth (start start-state end end-state)
2.1869+ (let ((start-depth (nth 0 start-state))
2.1870+ (end-depth (nth 0 end-state)))
2.1871+ (if (not (= start-depth end-depth))
2.1872+ (error "Mismatched parenthesis depth: %S at start, %S at end."
2.1873+ start-depth
2.1874+ end-depth))))
2.1875+
2.1876+(defun paredit-check-region-for-delete:string (start start-state end end-state)
2.1877+ (let ((start-string-p (nth 3 start-state))
2.1878+ (end-string-p (nth 3 end-state)))
2.1879+ (if (not (eq start-string-p end-string-p))
2.1880+ (error "Mismatched string state: start %sin string, end %sin string."
2.1881+ (if start-string-p "" "not ")
2.1882+ (if end-string-p "" "not ")))))
2.1883+
2.1884+(defun paredit-check-region-for-delete:comment
2.1885+ (start start-state end end-state)
2.1886+ (let ((start-comment-state (nth 4 start-state))
2.1887+ (end-comment-state (nth 4 end-state)))
2.1888+ (if (not (or (eq start-comment-state end-comment-state)
2.1889+ ;; If we are moving text into or out of a line
2.1890+ ;; comment, make sure that the text is balanced. (The
2.1891+ ;; comment state may be a number, not t or nil at all,
2.1892+ ;; for nestable comments, which are not handled by
2.1893+ ;; this heuristic (or any of paredit, really).)
2.1894+ (and (or (and (eq start-comment-state nil)
2.1895+ (eq end-comment-state t))
2.1896+ (and (eq start-comment-state t)
2.1897+ (eq end-comment-state nil)))
2.1898+ (save-excursion
2.1899+ (goto-char end)
2.1900+ (paredit-region-ok-p (point) (point-at-eol))))))
2.1901+ (error "Mismatched comment state: %s"
2.1902+ (cond ((and (integerp start-comment-state)
2.1903+ (integerp end-comment-state))
2.1904+ (format "depth %S at start, depth %S at end."
2.1905+ start-comment-state
2.1906+ end-comment-state))
2.1907+ ((integerp start-comment-state)
2.1908+ "start in nested comment, end otherwise.")
2.1909+ ((integerp end-comment-state)
2.1910+ "end in nested comment, start otherwise.")
2.1911+ (start-comment-state
2.1912+ "start in comment, end not in comment.")
2.1913+ (end-comment-state
2.1914+ "end in comment, start not in comment.")
2.1915+ (t
2.1916+ (format "start %S, end %S."
2.1917+ start-comment-state
2.1918+ end-comment-state)))))))
2.1919+
2.1920+(defun paredit-check-region-for-delete:char-quote
2.1921+ (start start-state end end-state)
2.1922+ (let ((start-char-quote (nth 5 start-state))
2.1923+ (end-char-quote (nth 5 end-state)))
2.1924+ (if (not (eq start-char-quote end-char-quote))
2.1925+ (let ((phrase "character quotation"))
2.1926+ (error "Mismatched %s: start %sin %s, end %sin %s."
2.1927+ phrase
2.1928+ (if start-char-quote "" "not ")
2.1929+ phrase
2.1930+ (if end-char-quote "" "not ")
2.1931+ phrase)))))
2.1932+
2.1933+;;;; Point Motion
2.1934+
2.1935+(eval-and-compile
2.1936+ (defmacro defun-motion (name bvl doc &rest body)
2.1937+ `(defun ,name ,bvl
2.1938+ ,doc
2.1939+ ,(xcond ((paredit-xemacs-p)
2.1940+ '(interactive "_"))
2.1941+ ((paredit-gnu-emacs-p)
2.1942+ ;++ Not sure this is sufficient for the `^'.
2.1943+ (if (fboundp 'handle-shift-selection)
2.1944+ '(interactive "^p")
2.1945+ '(interactive "p"))))
2.1946+ ,@body)))
2.1947+
2.1948+(defun-motion paredit-forward (&optional arg)
2.1949+ "Move forward an S-expression, or up an S-expression forward.
2.1950+If there are no more S-expressions in this one before the closing
2.1951+ delimiter, move past that closing delimiter; otherwise, move forward
2.1952+ past the S-expression following the point."
2.1953+ (let ((n (or arg 1)))
2.1954+ (cond ((< 0 n) (dotimes (i n) (paredit-move-forward)))
2.1955+ ((< n 0) (dotimes (i (- n)) (paredit-move-backward))))))
2.1956+
2.1957+(defun-motion paredit-backward (&optional arg)
2.1958+ "Move backward an S-expression, or up an S-expression backward.
2.1959+If there are no more S-expressions in this one before the opening
2.1960+ delimiter, move past that opening delimiter backward; otherwise,
2.1961+ move backward past the S-expression preceding the point."
2.1962+ (let ((n (or arg 1)))
2.1963+ (cond ((< 0 n) (dotimes (i n) (paredit-move-backward)))
2.1964+ ((< n 0) (dotimes (i (- n)) (paredit-move-forward))))))
2.1965+
2.1966+(defun paredit-move-forward ()
2.1967+ (cond ((paredit-in-string-p)
2.1968+ (let ((end (paredit-enclosing-string-end)))
2.1969+ ;; `forward-sexp' and `up-list' may move into the next string
2.1970+ ;; in the buffer. Don't do that; move out of the current one.
2.1971+ (if (paredit-handle-sexp-errors
2.1972+ (progn (paredit-handle-sexp-errors (forward-sexp)
2.1973+ (up-list))
2.1974+ (<= end (point)))
2.1975+ t)
2.1976+ (goto-char end))))
2.1977+ ((paredit-in-char-p)
2.1978+ (forward-char))
2.1979+ (t
2.1980+ (paredit-handle-sexp-errors (forward-sexp)
2.1981+ (up-list)))))
2.1982+
2.1983+(defun paredit-move-backward ()
2.1984+ (cond ((paredit-in-string-p)
2.1985+ (let ((start (paredit-enclosing-string-start)))
2.1986+ (if (paredit-handle-sexp-errors
2.1987+ (progn (paredit-handle-sexp-errors (backward-sexp)
2.1988+ (backward-up-list))
2.1989+ (<= (point) start))
2.1990+ t)
2.1991+ (goto-char start))))
2.1992+ ((paredit-in-char-p)
2.1993+ ;++ Corner case: a buffer of `\|x'. What to do?
2.1994+ (backward-char 2))
2.1995+ (t
2.1996+ (paredit-handle-sexp-errors (backward-sexp)
2.1997+ (backward-up-list)))))
2.1998+
2.1999+;;;; Window Positioning
2.2000+
2.2001+(defalias 'paredit-recentre-on-sexp 'paredit-recenter-on-sexp)
2.2002+
2.2003+(defun paredit-recenter-on-sexp (&optional n)
2.2004+ "Recenter the screen on the S-expression following the point.
2.2005+With a prefix argument N, encompass all N S-expressions forward."
2.2006+ (interactive "P")
2.2007+ (let* ((p (point))
2.2008+ (end-point (progn (forward-sexp n) (point)))
2.2009+ (start-point (progn (goto-char end-point) (backward-sexp n) (point))))
2.2010+ ;; Point is at beginning of first S-expression.
2.2011+ (let ((p-visible nil) (start-visible nil))
2.2012+ (save-excursion
2.2013+ (forward-line (/ (count-lines start-point end-point) 2))
2.2014+ (recenter)
2.2015+ (setq p-visible (pos-visible-in-window-p p))
2.2016+ (setq start-visible (pos-visible-in-window-p start-point)))
2.2017+ (cond ((not start-visible)
2.2018+ ;; Implies (not p-visible). Put the start at the top of
2.2019+ ;; the screen.
2.2020+ (recenter 0))
2.2021+ (p-visible
2.2022+ ;; Go back to p if we can.
2.2023+ (goto-char p))))))
2.2024+
2.2025+(defun paredit-recenter-on-defun ()
2.2026+ "Recenter the screen on the definition at point."
2.2027+ (interactive)
2.2028+ (save-excursion
2.2029+ (beginning-of-defun)
2.2030+ (paredit-recenter-on-sexp)))
2.2031+
2.2032+(defun paredit-focus-on-defun ()
2.2033+ "Moves display to the top of the definition at point."
2.2034+ (interactive)
2.2035+ (beginning-of-defun)
2.2036+ (recenter 0))
2.2037+
2.2038+;;;; Generalized Upward/Downward Motion
2.2039+
2.2040+(defun paredit-up/down (n vertical-direction)
2.2041+ (let ((horizontal-direction (if (< 0 n) +1 -1)))
2.2042+ (while (/= n 0)
2.2043+ (goto-char
2.2044+ (paredit-next-up/down-point horizontal-direction vertical-direction))
2.2045+ (setq n (- n horizontal-direction)))))
2.2046+
2.2047+(defun paredit-next-up/down-point (horizontal-direction vertical-direction)
2.2048+ (let ((state (paredit-current-parse-state))
2.2049+ (scan-lists
2.2050+ (lambda ()
2.2051+ (scan-lists (point) horizontal-direction vertical-direction))))
2.2052+ (cond ((paredit-in-string-p state)
2.2053+ (let ((start+end (paredit-string-start+end-points state)))
2.2054+ (if (< 0 vertical-direction)
2.2055+ (if (< 0 horizontal-direction)
2.2056+ (+ 1 (cdr start+end))
2.2057+ (car start+end))
2.2058+ ;; We could let the user try to descend into lists
2.2059+ ;; within the string, but that would be asymmetric
2.2060+ ;; with the up case, which rises out of the whole
2.2061+ ;; string and not just out of a list within the
2.2062+ ;; string, so this case will just be an error.
2.2063+ (error "Can't descend further into string."))))
2.2064+ ((< 0 vertical-direction)
2.2065+ ;; When moving up, just try to rise up out of the list.
2.2066+ (or (funcall scan-lists)
2.2067+ (buffer-end horizontal-direction)))
2.2068+ ((< vertical-direction 0)
2.2069+ ;; When moving down, look for a string closer than a list,
2.2070+ ;; and use that if we find it.
2.2071+ (let* ((list-start
2.2072+ (paredit-handle-sexp-errors (funcall scan-lists) nil))
2.2073+ (string-start
2.2074+ (paredit-find-next-string-start horizontal-direction
2.2075+ list-start)))
2.2076+ (if (and string-start list-start)
2.2077+ (if (< 0 horizontal-direction)
2.2078+ (min string-start list-start)
2.2079+ (max string-start list-start))
2.2080+ (or string-start
2.2081+ ;; Scan again: this is a kludgey way to report the
2.2082+ ;; error if there really was one.
2.2083+ (funcall scan-lists)
2.2084+ (buffer-end horizontal-direction)))))
2.2085+ (t
2.2086+ (error "Vertical direction must be nonzero in `%s'."
2.2087+ 'paredit-up/down)))))
2.2088+
2.2089+(defun paredit-find-next-string-start (horizontal-direction limit)
2.2090+ (let ((buffer-limit-p (if (< 0 horizontal-direction) 'eobp 'bobp))
2.2091+ (next-char (if (< 0 horizontal-direction) 'char-after 'char-before))
2.2092+ (pastp (if (< 0 horizontal-direction) '> '<)))
2.2093+ (paredit-handle-sexp-errors
2.2094+ (save-excursion
2.2095+ (catch 'exit
2.2096+ (while t
2.2097+ (if (or (funcall buffer-limit-p)
2.2098+ (and limit (funcall pastp (point) limit)))
2.2099+ (throw 'exit nil))
2.2100+ (forward-sexp horizontal-direction)
2.2101+ (save-excursion
2.2102+ (backward-sexp horizontal-direction)
2.2103+ (if (eq ?\" (char-syntax (funcall next-char)))
2.2104+ (throw 'exit (+ (point) horizontal-direction)))))))
2.2105+ nil)))
2.2106+
2.2107+(defun-motion paredit-forward-down (&optional argument)
2.2108+ "Move forward down into a list.
2.2109+With a positive argument, move forward down that many levels.
2.2110+With a negative argument, move backward down that many levels."
2.2111+ (paredit-up/down (or argument +1) -1))
2.2112+
2.2113+(defun-motion paredit-backward-up (&optional argument)
2.2114+ "Move backward up out of the enclosing list.
2.2115+With a positive argument, move backward up that many levels.
2.2116+With a negative argument, move forward up that many levels.
2.2117+If in a string initially, that counts as one level."
2.2118+ (paredit-up/down (- 0 (or argument +1)) +1))
2.2119+
2.2120+(defun-motion paredit-forward-up (&optional argument)
2.2121+ "Move forward up out of the enclosing list.
2.2122+With a positive argument, move forward up that many levels.
2.2123+With a negative argument, move backward up that many levels.
2.2124+If in a string initially, that counts as one level."
2.2125+ (paredit-up/down (or argument +1) +1))
2.2126+
2.2127+(defun-motion paredit-backward-down (&optional argument)
2.2128+ "Move backward down into a list.
2.2129+With a positive argument, move backward down that many levels.
2.2130+With a negative argument, move forward down that many levels."
2.2131+ (paredit-up/down (- 0 (or argument +1)) -1))
2.2132+
2.2133+;;;; Depth-Changing Commands: Wrapping, Splicing, & Raising
2.2134+
2.2135+(defun paredit-wrap-sexp (&optional argument open close)
2.2136+ "Wrap the following S-expression.
2.2137+If a `C-u' prefix argument is given, wrap all S-expressions following
2.2138+ the point until the end of the buffer or of the enclosing list.
2.2139+If a numeric prefix argument N is given, wrap N S-expressions.
2.2140+Automatically indent the newly wrapped S-expression.
2.2141+As a special case, if the point is at the end of a list, simply insert
2.2142+ a parenthesis pair, rather than inserting a lone opening delimiter
2.2143+ and then signalling an error, in the interest of preserving
2.2144+ structure.
2.2145+By default OPEN and CLOSE are round delimiters."
2.2146+ (interactive "P")
2.2147+ (paredit-lose-if-not-in-sexp 'paredit-wrap-sexp)
2.2148+ (let ((open (or open ?\( ))
2.2149+ (close (or close ?\) )))
2.2150+ (paredit-handle-sexp-errors
2.2151+ ((lambda (n) (paredit-insert-pair n open close 'goto-char))
2.2152+ (cond ((integerp argument) argument)
2.2153+ ((consp argument) (paredit-count-sexps-forward))
2.2154+ ((paredit-region-active-p) nil)
2.2155+ (t 1)))
2.2156+ (insert close)
2.2157+ (backward-char)))
2.2158+ (save-excursion (backward-up-list) (indent-sexp)))
2.2159+
2.2160+(defun paredit-yank-pop (&optional argument)
2.2161+ "Replace just-yanked text with the next item in the kill ring.
2.2162+If this command follows a `yank', just run `yank-pop'.
2.2163+If this command follows a `paredit-wrap-sexp', or any other paredit
2.2164+ wrapping command (see `paredit-wrap-commands'), run `yank' and
2.2165+ reindent the enclosing S-expression.
2.2166+If this command is repeated, run `yank-pop' and reindent the enclosing
2.2167+ S-expression.
2.2168+
2.2169+The argument is passed on to `yank' or `yank-pop'; see their
2.2170+ documentation for details."
2.2171+ (interactive "*p")
2.2172+ (cond ((eq last-command 'yank)
2.2173+ (yank-pop argument))
2.2174+ ((memq last-command paredit-wrap-commands)
2.2175+ (yank argument)
2.2176+ ;; `yank' futzes with `this-command'.
2.2177+ (setq this-command 'paredit-yank-pop)
2.2178+ (save-excursion (backward-up-list) (indent-sexp)))
2.2179+ ((eq last-command 'paredit-yank-pop)
2.2180+ ;; Pretend we just did a `yank', so that we can use
2.2181+ ;; `yank-pop' without duplicating its definition.
2.2182+ (setq last-command 'yank)
2.2183+ (yank-pop argument)
2.2184+ ;; Return to our original state.
2.2185+ (setq last-command 'paredit-yank-pop)
2.2186+ (setq this-command 'paredit-yank-pop)
2.2187+ (save-excursion (backward-up-list) (indent-sexp)))
2.2188+ (t (error "Last command was not a yank or a wrap: %s" last-command))))
2.2189+
2.2190+(defun paredit-splice-sexp (&optional argument)
2.2191+ "Splice the list that the point is on by removing its delimiters.
2.2192+With a prefix argument as in `C-u', kill all S-expressions backward in
2.2193+ the current list before splicing all S-expressions forward into the
2.2194+ enclosing list.
2.2195+With two prefix arguments as in `C-u C-u', kill all S-expressions
2.2196+ forward in the current list before splicing all S-expressions
2.2197+ backward into the enclosing list.
2.2198+With a numerical prefix argument N, kill N S-expressions backward in
2.2199+ the current list before splicing the remaining S-expressions into the
2.2200+ enclosing list. If N is negative, kill forward.
2.2201+Inside a string, unescape all backslashes, or signal an error if doing
2.2202+ so would invalidate the buffer's structure."
2.2203+ (interactive "P")
2.2204+ (if (paredit-in-string-p)
2.2205+ (paredit-splice-string argument)
2.2206+ (if (paredit-in-comment-p)
2.2207+ (error "Can't splice comment."))
2.2208+ (paredit-handle-sexp-errors (paredit-enclosing-list-start)
2.2209+ (error "Can't splice top level."))
2.2210+ (paredit-kill-surrounding-sexps-for-splice argument)
2.2211+ (let ((delete-start (paredit-enclosing-list-start))
2.2212+ (delete-end
2.2213+ (let ((limit
2.2214+ (save-excursion
2.2215+ (paredit-ignore-sexp-errors (forward-sexp) (backward-sexp))
2.2216+ (point))))
2.2217+ (save-excursion
2.2218+ (backward-up-list)
2.2219+ (forward-char +1)
2.2220+ (paredit-skip-whitespace t limit)
2.2221+ (point)))))
2.2222+ (let ((end-marker (make-marker)))
2.2223+ (save-excursion
2.2224+ (up-list)
2.2225+ (delete-char -1)
2.2226+ (set-marker end-marker (point)))
2.2227+ (delete-region delete-start delete-end)
2.2228+ (paredit-splice-reindent delete-start (marker-position end-marker))))))
2.2229+
2.2230+(defun paredit-splice-reindent (start end)
2.2231+ (paredit-preserving-column
2.2232+ ;; If we changed the first subform of the enclosing list, we must
2.2233+ ;; reindent the whole enclosing list.
2.2234+ (if (paredit-handle-sexp-errors
2.2235+ (save-excursion
2.2236+ (backward-up-list)
2.2237+ (down-list)
2.2238+ (paredit-ignore-sexp-errors (forward-sexp))
2.2239+ (< start (point)))
2.2240+ nil)
2.2241+ (save-excursion (backward-up-list) (indent-sexp))
2.2242+ (paredit-indent-region start end))))
2.2243+
2.2244+(defun paredit-kill-surrounding-sexps-for-splice (argument)
2.2245+ (cond ((or (paredit-in-string-p)
2.2246+ (paredit-in-comment-p))
2.2247+ (error "Invalid context for splicing S-expressions."))
2.2248+ ((or (not argument) (eq argument 0)) nil)
2.2249+ ((or (numberp argument) (eq argument '-))
2.2250+ ;; Kill S-expressions before/after the point by saving the
2.2251+ ;; point, moving across them, and killing the region.
2.2252+ (let* ((argument (if (eq argument '-) -1 argument))
2.2253+ (saved (paredit-point-at-sexp-boundary (- argument))))
2.2254+ (goto-char saved)
2.2255+ (paredit-ignore-sexp-errors (backward-sexp argument))
2.2256+ (paredit-hack-kill-region saved (point))))
2.2257+ ((consp argument)
2.2258+ (let ((v (car argument)))
2.2259+ (if (= v 4) ;One `C-u'.
2.2260+ ;; Move backward until we hit the open paren; then
2.2261+ ;; kill that selected region.
2.2262+ (let ((end (point)))
2.2263+ (paredit-ignore-sexp-errors
2.2264+ (while (not (bobp))
2.2265+ (backward-sexp)))
2.2266+ (paredit-hack-kill-region (point) end))
2.2267+ ;; Move forward until we hit the close paren; then
2.2268+ ;; kill that selected region.
2.2269+ (let ((beginning (point)))
2.2270+ (paredit-ignore-sexp-errors
2.2271+ (while (not (eobp))
2.2272+ (forward-sexp)))
2.2273+ (paredit-hack-kill-region beginning (point))))))
2.2274+ (t (error "Bizarre prefix argument `%s'." argument))))
2.2275+
2.2276+(defun paredit-splice-sexp-killing-backward (&optional n)
2.2277+ "Splice the list the point is on by removing its delimiters, and
2.2278+ also kill all S-expressions before the point in the current list.
2.2279+With a prefix argument N, kill only the preceding N S-expressions."
2.2280+ (interactive "P")
2.2281+ (paredit-splice-sexp (if n
2.2282+ (prefix-numeric-value n)
2.2283+ '(4))))
2.2284+
2.2285+(defun paredit-splice-sexp-killing-forward (&optional n)
2.2286+ "Splice the list the point is on by removing its delimiters, and
2.2287+ also kill all S-expressions after the point in the current list.
2.2288+With a prefix argument N, kill only the following N S-expressions."
2.2289+ (interactive "P")
2.2290+ (paredit-splice-sexp (if n
2.2291+ (- (prefix-numeric-value n))
2.2292+ '(16))))
2.2293+
2.2294+(defun paredit-raise-sexp (&optional argument)
2.2295+ "Raise the following S-expression in a tree, deleting its siblings.
2.2296+With a prefix argument N, raise the following N S-expressions. If N
2.2297+ is negative, raise the preceding N S-expressions.
2.2298+If the point is on an S-expression, such as a string or a symbol, not
2.2299+ between them, that S-expression is considered to follow the point."
2.2300+ (interactive "P")
2.2301+ (save-excursion
2.2302+ ;; Select the S-expressions we want to raise in a buffer substring.
2.2303+ (let* ((bound
2.2304+ (if (and (not argument) (paredit-region-active-p))
2.2305+ (progn (if (< (mark) (point))
2.2306+ (paredit-check-region (mark) (point))
2.2307+ (paredit-check-region (point) (mark)))
2.2308+ (mark))
2.2309+ (cond ((paredit-in-string-p)
2.2310+ (goto-char (car (paredit-string-start+end-points))))
2.2311+ ((paredit-in-char-p)
2.2312+ (backward-sexp))
2.2313+ ((paredit-in-comment-p)
2.2314+ (error "No S-expression to raise in comment.")))
2.2315+ (scan-sexps (point) (prefix-numeric-value argument))))
2.2316+ (sexps
2.2317+ (if (< bound (point))
2.2318+ (buffer-substring bound (paredit-point-at-sexp-end))
2.2319+ (buffer-substring (paredit-point-at-sexp-start) bound))))
2.2320+ ;; Move up to the list we're raising those S-expressions out of and
2.2321+ ;; delete it.
2.2322+ (backward-up-list)
2.2323+ (delete-region (point) (scan-sexps (point) 1))
2.2324+ (let* ((indent-start (point))
2.2325+ (indent-end (save-excursion (insert sexps) (point))))
2.2326+ ;; If the expression spans multiple lines, its indentation is
2.2327+ ;; probably broken, so reindent it -- but don't reindent
2.2328+ ;; anything that we didn't touch outside the expression.
2.2329+ ;;
2.2330+ ;; XXX What if the *column* of the starting point was preserved
2.2331+ ;; too? Should we avoid reindenting in that case?
2.2332+ (if (not (eq (save-excursion (goto-char indent-start) (point-at-eol))
2.2333+ (save-excursion (goto-char indent-end) (point-at-eol))))
2.2334+ (indent-region indent-start indent-end nil))))))
2.2335+
2.2336+;;; The effects of convolution on the surrounding whitespace are pretty
2.2337+;;; random. If you have better suggestions, please let me know.
2.2338+
2.2339+(defun paredit-convolute-sexp (&optional n)
2.2340+ "Convolute S-expressions.
2.2341+Save the S-expressions preceding point and delete them.
2.2342+Splice the S-expressions following point.
2.2343+Wrap the enclosing list in a new list prefixed by the saved text.
2.2344+With a prefix argument N, move up N lists before wrapping."
2.2345+ (interactive "p")
2.2346+ (paredit-lose-if-not-in-sexp 'paredit-convolute-sexp)
2.2347+ ;; Make sure we can move up before destroying anything.
2.2348+ (save-excursion (backward-up-list n) (backward-up-list))
2.2349+ (let (open close) ;++ Is this a good idea?
2.2350+ (let ((prefix
2.2351+ (let ((end (point)))
2.2352+ (paredit-ignore-sexp-errors
2.2353+ (while (not (bobp)) (backward-sexp)))
2.2354+ (prog1 (buffer-substring (point) end)
2.2355+ (backward-up-list)
2.2356+ (save-excursion (forward-sexp)
2.2357+ (setq close (char-before))
2.2358+ (delete-char -1))
2.2359+ (setq open (char-after))
2.2360+ (delete-region (point) end)
2.2361+ ;; I'm not sure this makes sense...
2.2362+ (if (not (eolp)) (just-one-space))))))
2.2363+ (backward-up-list n)
2.2364+ (paredit-insert-pair 1 open close 'goto-char)
2.2365+ (insert prefix)
2.2366+ ;; I'm not sure this makes sense either...
2.2367+ (if (not (eolp)) (just-one-space))
2.2368+ (save-excursion
2.2369+ (backward-up-list)
2.2370+ (paredit-ignore-sexp-errors (indent-sexp))))))
2.2371+
2.2372+(defun paredit-splice-string (argument)
2.2373+ (let ((original-point (point))
2.2374+ (start+end (paredit-string-start+end-points)))
2.2375+ (let ((start (car start+end))
2.2376+ (end (cdr start+end)))
2.2377+ ;; START and END both lie before the respective quote
2.2378+ ;; characters, which we want to delete; thus we increment START
2.2379+ ;; by one to extract the string, and we increment END by one to
2.2380+ ;; delete the string.
2.2381+ (let* ((escaped-string
2.2382+ (cond ((not (consp argument))
2.2383+ (buffer-substring (1+ start) end))
2.2384+ ((= 4 (car argument))
2.2385+ (buffer-substring original-point end))
2.2386+ (t
2.2387+ (buffer-substring (1+ start) original-point))))
2.2388+ (unescaped-string
2.2389+ (paredit-unescape-string escaped-string)))
2.2390+ (if (not unescaped-string)
2.2391+ (error "Unspliceable string.")
2.2392+ (save-excursion
2.2393+ (goto-char start)
2.2394+ (delete-region start (1+ end))
2.2395+ (insert unescaped-string))
2.2396+ (if (not (and (consp argument)
2.2397+ (= 4 (car argument))))
2.2398+ (goto-char (- original-point 1))))))))
2.2399+
2.2400+(defun paredit-unescape-string (string)
2.2401+ (with-temp-buffer
2.2402+ (insert string)
2.2403+ (goto-char (point-min))
2.2404+ (while (and (not (eobp))
2.2405+ ;; nil -> no bound; t -> no errors.
2.2406+ (search-forward "\\" nil t))
2.2407+ (delete-char -1)
2.2408+ (forward-char))
2.2409+ (paredit-handle-sexp-errors
2.2410+ (progn (scan-sexps (point-min) (point-max))
2.2411+ (buffer-string))
2.2412+ nil)))
2.2413+
2.2414+;;;; Slurpage & Barfage
2.2415+
2.2416+(defun paredit-forward-slurp-sexp (&optional argument)
2.2417+ "Add the S-expression following the current list into that list
2.2418+ by moving the closing delimiter.
2.2419+Automatically reindent the newly slurped S-expression with respect to
2.2420+ its new enclosing form.
2.2421+If in a string, move the opening double-quote forward by one
2.2422+ S-expression and escape any intervening characters as necessary,
2.2423+ without altering any indentation or formatting."
2.2424+ (interactive "P")
2.2425+ (save-excursion
2.2426+ (cond ((paredit-in-comment-p)
2.2427+ (error "Invalid context for slurping S-expressions."))
2.2428+ ((numberp argument)
2.2429+ (if (< argument 0)
2.2430+ (paredit-forward-barf-sexp (- 0 argument))
2.2431+ (while (< 0 argument)
2.2432+ (paredit-forward-slurp-sexp)
2.2433+ (setq argument (- argument 1)))))
2.2434+ ((paredit-in-string-p)
2.2435+ ;; If there is anything to slurp into the string, take that.
2.2436+ ;; Otherwise, try to slurp into the enclosing list.
2.2437+ (if (save-excursion
2.2438+ (goto-char (paredit-enclosing-string-end))
2.2439+ (paredit-handle-sexp-errors (progn (forward-sexp) nil)
2.2440+ t))
2.2441+ (progn
2.2442+ (goto-char (paredit-enclosing-string-end))
2.2443+ (paredit-forward-slurp-into-list argument))
2.2444+ (paredit-forward-slurp-into-string argument)))
2.2445+ (t
2.2446+ (paredit-forward-slurp-into-list argument)))))
2.2447+
2.2448+(defun paredit-forward-slurp-into-list (&optional argument)
2.2449+ (let ((nestedp nil))
2.2450+ (save-excursion
2.2451+ (up-list) ; Up to the end of the list to
2.2452+ (let ((close (char-before))) ; save and delete the closing
2.2453+ (delete-char -1) ; delimiter.
2.2454+ (let ((start (point)))
2.2455+ (catch 'return ; Go to the end of the desired
2.2456+ (while t ; S-expression, going up a
2.2457+ (paredit-handle-sexp-errors ; list if it's not in this,
2.2458+ (progn (forward-sexp)
2.2459+ (if argument
2.2460+ (paredit-ignore-sexp-errors
2.2461+ (while (not (eobp))
2.2462+ (forward-sexp))))
2.2463+ (throw 'return nil))
2.2464+ (setq nestedp t)
2.2465+ (up-list)
2.2466+ (setq close ; adjusting for mixed
2.2467+ (prog1 (char-before) ; delimiters as necessary,
2.2468+ (delete-char -1)
2.2469+ (insert close))))))
2.2470+ (insert close) ; to insert that delimiter.
2.2471+ (indent-region start (point) nil))))
2.2472+ (if (and (not nestedp)
2.2473+ (eq (save-excursion (paredit-skip-whitespace nil) (point))
2.2474+ (save-excursion (backward-up-list) (forward-char) (point)))
2.2475+ (eq (save-excursion (forward-sexp) (backward-sexp) (point))
2.2476+ (save-excursion (paredit-skip-whitespace t) (point))))
2.2477+ (delete-region (save-excursion (paredit-skip-whitespace nil) (point))
2.2478+ (save-excursion (paredit-skip-whitespace t) (point))))))
2.2479+
2.2480+(defun paredit-forward-slurp-into-string (&optional argument)
2.2481+ (let ((start (paredit-enclosing-string-start))
2.2482+ (end (paredit-enclosing-string-end)))
2.2483+ (goto-char end)
2.2484+ ;; Signal any errors that we might get first, before mucking with
2.2485+ ;; the buffer's contents.
2.2486+ (save-excursion (forward-sexp))
2.2487+ (let ((close (char-before)))
2.2488+ ;; Skip intervening whitespace if we're slurping into an empty
2.2489+ ;; string. XXX What about nonempty strings?
2.2490+ (if (and (= (+ start 2) end)
2.2491+ (eq (save-excursion (paredit-skip-whitespace t) (point))
2.2492+ (save-excursion (forward-sexp) (backward-sexp) (point))))
2.2493+ (delete-region (- (point) 1)
2.2494+ (save-excursion (paredit-skip-whitespace t) (point)))
2.2495+ (delete-char -1))
2.2496+ (paredit-forward-for-quote
2.2497+ (save-excursion
2.2498+ (forward-sexp)
2.2499+ (if argument
2.2500+ (while (paredit-handle-sexp-errors (progn (forward-sexp) t) nil)))
2.2501+ (point)))
2.2502+ (insert close))))
2.2503+
2.2504+(defun paredit-forward-barf-sexp (&optional argument)
2.2505+ "Remove the last S-expression in the current list from that list
2.2506+ by moving the closing delimiter.
2.2507+Automatically reindent the newly barfed S-expression with respect to
2.2508+ its new enclosing form."
2.2509+ (interactive "P")
2.2510+ (paredit-lose-if-not-in-sexp 'paredit-forward-barf-sexp)
2.2511+ (if (and (numberp argument) (< argument 0))
2.2512+ (paredit-forward-slurp-sexp (- 0 argument))
2.2513+ (let ((start (point)) (end nil))
2.2514+ (save-excursion
2.2515+ (up-list) ; Up to the end of the list to
2.2516+ (let ((close (char-before))) ; save and delete the closing
2.2517+ (delete-char -1) ; delimiter.
2.2518+ (setq end (point))
2.2519+ (paredit-ignore-sexp-errors ; Go back to where we want to
2.2520+ (if (or (not argument) ; insert the delimiter.
2.2521+ (numberp argument))
2.2522+ (backward-sexp argument)
2.2523+ (while (paredit-handle-sexp-errors
2.2524+ (save-excursion (backward-sexp) (<= start (point)))
2.2525+ nil)
2.2526+ (backward-sexp))))
2.2527+ (paredit-skip-whitespace nil) ; Skip leading whitespace.
2.2528+ (cond ((bobp)
2.2529+ ;++ We'll have deleted the close, but there's no open.
2.2530+ ;++ Is that OK?
2.2531+ (error "Barfing all subexpressions with no open-paren?"))
2.2532+ ((paredit-in-comment-p) ; Don't put the close-paren in
2.2533+ (newline))) ; a comment.
2.2534+ (insert close))
2.2535+ ;; Reindent all of the newly barfed S-expressions. Start at the
2.2536+ ;; start of the first barfed S-expression, not at the close we
2.2537+ ;; just inserted.
2.2538+ (forward-sexp)
2.2539+ (backward-sexp)
2.2540+ (if (or (not argument) (numberp argument))
2.2541+ (paredit-forward-and-indent argument)
2.2542+ (indent-region (point) end))))))
2.2543+
2.2544+(defun paredit-backward-slurp-sexp (&optional argument)
2.2545+ "Add the S-expression preceding the current list into that list
2.2546+ by moving the closing delimiter.
2.2547+Automatically reindent the whole form into which new S-expression was
2.2548+ slurped.
2.2549+If in a string, move the opening double-quote backward by one
2.2550+ S-expression and escape any intervening characters as necessary,
2.2551+ without altering any indentation or formatting."
2.2552+ (interactive "P")
2.2553+ (save-excursion
2.2554+ (cond ((paredit-in-comment-p)
2.2555+ (error "Invalid context for slurping S-expressions."))
2.2556+ ((numberp argument)
2.2557+ (if (< argument 0)
2.2558+ (paredit-backward-barf-sexp (- 0 argument))
2.2559+ (while (< 0 argument)
2.2560+ (paredit-backward-slurp-sexp)
2.2561+ (setq argument (- argument 1)))))
2.2562+ ((paredit-in-string-p)
2.2563+ ;; If there is anything to slurp into the string, take that.
2.2564+ ;; Otherwise, try to slurp into the enclosing list.
2.2565+ (if (save-excursion
2.2566+ (goto-char (paredit-enclosing-string-start))
2.2567+ (paredit-handle-sexp-errors (progn (backward-sexp) nil)
2.2568+ t))
2.2569+ (progn
2.2570+ (goto-char (paredit-enclosing-string-start))
2.2571+ (paredit-backward-slurp-into-list argument))
2.2572+ (paredit-backward-slurp-into-string argument)))
2.2573+ (t
2.2574+ (paredit-backward-slurp-into-list argument)))))
2.2575+
2.2576+(defun paredit-backward-slurp-into-list (&optional argument)
2.2577+ (let ((nestedp nil))
2.2578+ (save-excursion
2.2579+ (backward-up-list)
2.2580+ (let ((open (char-after)))
2.2581+ (delete-char +1)
2.2582+ (catch 'return
2.2583+ (while t
2.2584+ (paredit-handle-sexp-errors
2.2585+ (progn (backward-sexp)
2.2586+ (if argument
2.2587+ (paredit-ignore-sexp-errors
2.2588+ (while (not (bobp))
2.2589+ (backward-sexp))))
2.2590+ (throw 'return nil))
2.2591+ (setq nestedp t)
2.2592+ (backward-up-list)
2.2593+ (setq open
2.2594+ (prog1 (char-after)
2.2595+ (save-excursion (insert open) (delete-char +1)))))))
2.2596+ (insert open))
2.2597+ ;; Reindent the line at the beginning of wherever we inserted the
2.2598+ ;; opening delimiter, and then indent the whole S-expression.
2.2599+ (backward-up-list)
2.2600+ (lisp-indent-line)
2.2601+ (indent-sexp))
2.2602+ ;; If we slurped into an empty list, don't leave dangling space:
2.2603+ ;; (foo |).
2.2604+ (if (and (not nestedp)
2.2605+ (eq (save-excursion (paredit-skip-whitespace nil) (point))
2.2606+ (save-excursion (backward-sexp) (forward-sexp) (point)))
2.2607+ (eq (save-excursion (up-list) (backward-char) (point))
2.2608+ (save-excursion (paredit-skip-whitespace t) (point))))
2.2609+ (delete-region (save-excursion (paredit-skip-whitespace nil) (point))
2.2610+ (save-excursion (paredit-skip-whitespace t) (point))))))
2.2611+
2.2612+(defun paredit-backward-slurp-into-string (&optional argument)
2.2613+ (let ((start (paredit-enclosing-string-start))
2.2614+ (end (paredit-enclosing-string-end)))
2.2615+ (goto-char start)
2.2616+ ;; Signal any errors that we might get first, before mucking with
2.2617+ ;; the buffer's contents.
2.2618+ (save-excursion (backward-sexp))
2.2619+ (let ((open (char-after))
2.2620+ (target (point)))
2.2621+ ;; Skip intervening whitespace if we're slurping into an empty
2.2622+ ;; string. XXX What about nonempty strings?
2.2623+ (if (and (= (+ start 2) end)
2.2624+ (eq (save-excursion (paredit-skip-whitespace nil) (point))
2.2625+ (save-excursion (backward-sexp) (forward-sexp) (point))))
2.2626+ (delete-region (save-excursion (paredit-skip-whitespace nil) (point))
2.2627+ (+ (point) 1))
2.2628+ (delete-char +1))
2.2629+ (backward-sexp)
2.2630+ (if argument
2.2631+ (paredit-ignore-sexp-errors
2.2632+ (while (not (bobp))
2.2633+ (backward-sexp))))
2.2634+ (insert open)
2.2635+ (paredit-forward-for-quote target))))
2.2636+
2.2637+(defun paredit-backward-barf-sexp (&optional argument)
2.2638+ "Remove the first S-expression in the current list from that list
2.2639+ by moving the closing delimiter.
2.2640+Automatically reindent the barfed S-expression and the form from which
2.2641+ it was barfed."
2.2642+ (interactive "P")
2.2643+ (paredit-lose-if-not-in-sexp 'paredit-backward-barf-sexp)
2.2644+ (if (and (numberp argument) (< argument 0))
2.2645+ (paredit-backward-slurp-sexp (- 0 argument))
2.2646+ (let ((end (make-marker)))
2.2647+ (set-marker end (point))
2.2648+ (save-excursion
2.2649+ (backward-up-list)
2.2650+ (let ((open (char-after)))
2.2651+ (delete-char +1)
2.2652+ (paredit-ignore-sexp-errors
2.2653+ (paredit-forward-and-indent
2.2654+ (if (or (not argument) (numberp argument))
2.2655+ argument
2.2656+ (let ((n 0))
2.2657+ (save-excursion
2.2658+ (while (paredit-handle-sexp-errors
2.2659+ (save-excursion
2.2660+ (forward-sexp)
2.2661+ (<= (point) end))
2.2662+ nil)
2.2663+ (forward-sexp)
2.2664+ (setq n (+ n 1))))
2.2665+ n))))
2.2666+ (while (progn (paredit-skip-whitespace t) (eq (char-after) ?\; ))
2.2667+ (forward-line 1))
2.2668+ (if (eobp)
2.2669+ ;++ We'll have deleted the close, but there's no open.
2.2670+ ;++ Is that OK?
2.2671+ (error "Barfing all subexpressions with no close-paren?"))
2.2672+ ;** Don't use `insert' here. Consider, e.g., barfing from
2.2673+ ;** (foo|)
2.2674+ ;** and how `save-excursion' works.
2.2675+ (insert-before-markers open))
2.2676+ (backward-up-list)
2.2677+ (lisp-indent-line)
2.2678+ (indent-sexp)))))
2.2679+
2.2680+;;;; Splitting & Joining
2.2681+
2.2682+(defun paredit-split-sexp ()
2.2683+ "Split the list or string the point is on into two."
2.2684+ (interactive)
2.2685+ (cond ((paredit-in-string-p)
2.2686+ (insert "\"")
2.2687+ (save-excursion (insert " \"")))
2.2688+ ((or (paredit-in-comment-p)
2.2689+ (paredit-in-char-p))
2.2690+ (error "Invalid context for splitting S-expression."))
2.2691+ (t
2.2692+ (let ((open (save-excursion (backward-up-list) (char-after)))
2.2693+ (close (save-excursion (up-list) (char-before))))
2.2694+ (delete-horizontal-space)
2.2695+ (insert close)
2.2696+ (save-excursion
2.2697+ (insert ?\ )
2.2698+ (insert open)
2.2699+ (backward-char)
2.2700+ (indent-sexp))))))
2.2701+
2.2702+(defun paredit-join-sexps ()
2.2703+ "Join the S-expressions adjacent on either side of the point.
2.2704+Both must be lists, strings, or atoms; error if there is a mismatch."
2.2705+ (interactive)
2.2706+ (cond ((paredit-in-comment-p) (error "Can't join S-expressions in comment."))
2.2707+ ((paredit-in-string-p) (error "Nothing to join in a string."))
2.2708+ ((paredit-in-char-p) (error "Can't join characters.")))
2.2709+ (let ((left-point (paredit-point-at-sexp-end))
2.2710+ (right-point (paredit-point-at-sexp-start)))
2.2711+ (let ((left-char (char-before left-point))
2.2712+ (right-char (char-after right-point)))
2.2713+ (let ((left-syntax (char-syntax left-char))
2.2714+ (right-syntax (char-syntax right-char)))
2.2715+ (cond ((< right-point left-point)
2.2716+ (error "Can't join a datum with itself."))
2.2717+ ((and (eq left-syntax ?\) )
2.2718+ (eq right-syntax ?\( )
2.2719+ (eq left-char (matching-paren right-char))
2.2720+ (eq right-char (matching-paren left-char)))
2.2721+ (paredit-join-lists-internal left-point right-point)
2.2722+ (paredit-preserving-column
2.2723+ (save-excursion
2.2724+ (backward-up-list)
2.2725+ (indent-sexp))))
2.2726+ ((and (eq left-syntax ?\" )
2.2727+ (eq right-syntax ?\" ))
2.2728+ ;; Delete any intermediate formatting.
2.2729+ (delete-region (1- left-point) (1+ right-point)))
2.2730+ ((and (memq left-syntax '(?w ?_)) ; Word or symbol
2.2731+ (memq right-syntax '(?w ?_)))
2.2732+ (delete-region left-point right-point))
2.2733+ (t (error "Mismatched S-expressions to join.")))))))
2.2734+
2.2735+(defun paredit-join-lists-internal (left-point right-point)
2.2736+ (save-excursion
2.2737+ ;; Leave intermediate formatting alone.
2.2738+ (goto-char right-point)
2.2739+ (delete-char +1)
2.2740+ (goto-char left-point)
2.2741+ (delete-char -1)
2.2742+ ;; Kludge: Add an extra space in several conditions.
2.2743+ (if (or
2.2744+ ;; (foo)| ;x\n(bar) => (foo | ;x\nbar), not (foo| ;x\nbar).
2.2745+ (and (not (eolp))
2.2746+ (save-excursion
2.2747+ (paredit-skip-whitespace t (point-at-eol))
2.2748+ (eq (char-after) ?\;)))
2.2749+ ;; (foo)|(bar) => (foo| bar), not (foo|bar).
2.2750+ (and (= left-point right-point)
2.2751+ (not (or (eq ?\ (char-syntax (char-before)))
2.2752+ (eq ?\ (char-syntax (char-after)))))))
2.2753+ (insert ?\ ))))
2.2754+
2.2755+;++ How ought paredit-join to handle comments intervening symbols or strings?
2.2756+;++ Idea:
2.2757+;++
2.2758+;++ "foo" | ;bar
2.2759+;++ "baz" ;quux
2.2760+;++
2.2761+;++ =>
2.2762+;++
2.2763+;++ "foo|baz" ;bar
2.2764+;++ ;quux
2.2765+;++
2.2766+;++ The point should stay where it is relative to the comments, and the
2.2767+;++ the comments' columns should all be preserved, perhaps. Hmmmm...
2.2768+;++ What about this?
2.2769+;++
2.2770+;++ "foo" ;bar
2.2771+;++ | ;baz
2.2772+;++ "quux" ;zot
2.2773+
2.2774+;++ Should rename:
2.2775+;++ paredit-point-at-sexp-start -> paredit-start-of-sexp-after-point
2.2776+;++ paredit-point-at-sexp-end -> paredit-end-of-sexp-before-point
2.2777+
2.2778+;;;; Variations on the Lurid Theme
2.2779+
2.2780+;;; I haven't the imagination to concoct clever names for these.
2.2781+
2.2782+(defun paredit-add-to-previous-list ()
2.2783+ "Add the S-expression following point to the list preceding point."
2.2784+ (interactive)
2.2785+ (paredit-lose-if-not-in-sexp 'paredit-add-to-previous-list)
2.2786+ (save-excursion
2.2787+ (down-list -1) ;++ backward-down-list...
2.2788+ (paredit-forward-slurp-sexp)))
2.2789+
2.2790+(defun paredit-add-to-next-list ()
2.2791+ "Add the S-expression preceding point to the list following point.
2.2792+If no S-expression precedes point, move up the tree until one does."
2.2793+ (interactive)
2.2794+ (paredit-lose-if-not-in-sexp 'paredit-add-to-next-list)
2.2795+ (save-excursion
2.2796+ (down-list)
2.2797+ (paredit-backward-slurp-sexp)))
2.2798+
2.2799+(defun paredit-join-with-previous-list ()
2.2800+ "Join the list the point is on with the previous list in the buffer."
2.2801+ (interactive)
2.2802+ (paredit-lose-if-not-in-sexp 'paredit-join-with-previous-list)
2.2803+ (save-excursion
2.2804+ (while (paredit-handle-sexp-errors (save-excursion (backward-sexp) nil)
2.2805+ (backward-up-list)
2.2806+ t))
2.2807+ (paredit-join-sexps)))
2.2808+
2.2809+(defun paredit-join-with-next-list ()
2.2810+ "Join the list the point is on with the next list in the buffer."
2.2811+ (interactive)
2.2812+ (paredit-lose-if-not-in-sexp 'paredit-join-with-next-list)
2.2813+ (save-excursion
2.2814+ (while (paredit-handle-sexp-errors (save-excursion (forward-sexp) nil)
2.2815+ (up-list)
2.2816+ t))
2.2817+ (paredit-join-sexps)))
2.2818+
2.2819+;;;; Utilities
2.2820+
2.2821+(defun paredit-in-string-escape-p ()
2.2822+ "True if the point is on a character escape of a string.
2.2823+This is true only if the character is preceded by an odd number of
2.2824+ backslashes.
2.2825+This assumes that `paredit-in-string-p' has already returned true."
2.2826+ (let ((oddp nil))
2.2827+ (save-excursion
2.2828+ (while (eq (char-before) ?\\ )
2.2829+ (setq oddp (not oddp))
2.2830+ (backward-char)))
2.2831+ oddp))
2.2832+
2.2833+(defun paredit-in-char-p (&optional position)
2.2834+ "True if point is on a character escape outside a string."
2.2835+ (save-excursion
2.2836+ (goto-char (or position (point)))
2.2837+ (paredit-in-string-escape-p)))
2.2838+
2.2839+(defun paredit-skip-whitespace (trailing-p &optional limit)
2.2840+ "Skip past any whitespace, or until the point LIMIT is reached.
2.2841+If TRAILING-P is nil, skip leading whitespace; otherwise, skip trailing
2.2842+ whitespace."
2.2843+ (funcall (if trailing-p 'skip-chars-forward 'skip-chars-backward)
2.2844+ " \t\n " ; This should skip using the syntax table, but LF
2.2845+ limit)) ; is a comment end, not newline, in Lisp mode.
2.2846+
2.2847+(defalias 'paredit-region-active-p
2.2848+ (xcond ((paredit-xemacs-p) 'region-active-p)
2.2849+ ((paredit-gnu-emacs-p)
2.2850+ (lambda ()
2.2851+ (and mark-active transient-mark-mode)))))
2.2852+
2.2853+(defun paredit-hack-kill-region (start end)
2.2854+ "Kill the region between START and END.
2.2855+Do not append to any current kill, and
2.2856+ do not let the next kill append to this one."
2.2857+ (interactive "r") ;Eh, why not?
2.2858+ ;; KILL-REGION sets THIS-COMMAND to tell the next kill that the last
2.2859+ ;; command was a kill. It also checks LAST-COMMAND to see whether it
2.2860+ ;; should append. If we bind these locally, any modifications to
2.2861+ ;; THIS-COMMAND will be masked, and it will not see LAST-COMMAND to
2.2862+ ;; indicate that it should append.
2.2863+ (let ((this-command nil)
2.2864+ (last-command nil))
2.2865+ (kill-region start end)))
2.2866+
2.2867+;;;;; Reindentation utilities
2.2868+
2.2869+;++ Should `paredit-indent-sexps' and `paredit-forward-and-indent' use
2.2870+;++ `paredit-indent-region' rather than `indent-region'?
2.2871+
2.2872+(defun paredit-indent-sexps ()
2.2873+ "If in a list, indent all following S-expressions in the list."
2.2874+ (let* ((start (point))
2.2875+ (end (paredit-handle-sexp-errors (progn (up-list) (point)) nil)))
2.2876+ (if end
2.2877+ (indent-region start end nil))))
2.2878+
2.2879+(defun paredit-forward-and-indent (&optional n)
2.2880+ "Move forward by N S-expressions, indenting them with `indent-region'."
2.2881+ (let ((start (point)))
2.2882+ (forward-sexp n)
2.2883+ (indent-region start (point) nil)))
2.2884+
2.2885+(defun paredit-indent-region (start end)
2.2886+ "Indent the region from START to END.
2.2887+Don't reindent the line starting at START, however."
2.2888+ (if (not (<= start end))
2.2889+ (error "Incorrectly related points: %S, %S" start end))
2.2890+ (save-excursion
2.2891+ (goto-char start)
2.2892+ (let ((bol (point-at-bol)))
2.2893+ ;; Skip all S-expressions that end on the starting line, but
2.2894+ ;; don't go past `end'.
2.2895+ (if (and (save-excursion (goto-char end) (not (eq bol (point-at-bol))))
2.2896+ (paredit-handle-sexp-errors
2.2897+ (catch 'exit
2.2898+ (while t
2.2899+ (save-excursion
2.2900+ (forward-sexp)
2.2901+ (if (not (eq bol (point-at-bol)))
2.2902+ (throw 'exit t))
2.2903+ (if (not (< (point) end))
2.2904+ (throw 'exit nil)))
2.2905+ (forward-sexp)))
2.2906+ nil))
2.2907+ (progn
2.2908+ ;; Point is still on the same line, but precedes an
2.2909+ ;; S-expression that ends on a different line.
2.2910+ (if (not (eq bol (point-at-bol)))
2.2911+ (error "Internal error -- we moved forward a line!"))
2.2912+ (goto-char (+ 1 (point-at-eol)))
2.2913+ (if (not (<= (point) end))
2.2914+ (error "Internal error -- we frobnitzed the garfnut!"))
2.2915+ (indent-region (point) end nil))))))
2.2916+
2.2917+;;;;; S-expression Parsing Utilities
2.2918+
2.2919+;++ These routines redundantly traverse S-expressions a great deal.
2.2920+;++ If performance issues arise, this whole section will probably have
2.2921+;++ to be refactored to preserve the state longer, like paredit.scm
2.2922+;++ does, rather than to traverse the definition N times for every key
2.2923+;++ stroke as it presently does.
2.2924+
2.2925+(defun paredit-current-parse-state ()
2.2926+ "Return parse state of point from beginning of defun."
2.2927+ (let ((point (point)))
2.2928+ (beginning-of-defun)
2.2929+ ;; Calling PARSE-PARTIAL-SEXP will advance the point to its second
2.2930+ ;; argument (unless parsing stops due to an error, but we assume it
2.2931+ ;; won't in paredit-mode).
2.2932+ (parse-partial-sexp (point) point)))
2.2933+
2.2934+(defun paredit-in-string-p (&optional state)
2.2935+ "True if the parse state is within a double-quote-delimited string.
2.2936+If no parse state is supplied, compute one from the beginning of the
2.2937+ defun to the point."
2.2938+ ;; 3. non-nil if inside a string (the terminator character, really)
2.2939+ (and (nth 3 (or state (paredit-current-parse-state)))
2.2940+ t))
2.2941+
2.2942+(defun paredit-string-start+end-points (&optional state)
2.2943+ "Return a cons of the points of open and close quotes of the string.
2.2944+The string is determined from the parse state STATE, or the parse state
2.2945+ from the beginning of the defun to the point.
2.2946+This assumes that `paredit-in-string-p' has already returned true, i.e.
2.2947+ that the point is already within a string."
2.2948+ (save-excursion
2.2949+ ;; 8. character address of start of comment or string; nil if not
2.2950+ ;; in one
2.2951+ (let ((start (nth 8 (or state (paredit-current-parse-state)))))
2.2952+ (goto-char start)
2.2953+ (forward-sexp 1)
2.2954+ (cons start (1- (point))))))
2.2955+
2.2956+(defun paredit-enclosing-string-start ()
2.2957+ (car (paredit-string-start+end-points)))
2.2958+
2.2959+(defun paredit-enclosing-string-end ()
2.2960+ (+ 1 (cdr (paredit-string-start+end-points))))
2.2961+
2.2962+(defun paredit-enclosing-list-start ()
2.2963+ (save-excursion
2.2964+ (backward-up-list)
2.2965+ (point)))
2.2966+
2.2967+(defun paredit-enclosing-list-end ()
2.2968+ (save-excursion
2.2969+ (up-list)
2.2970+ (point)))
2.2971+
2.2972+(defun paredit-in-comment-p (&optional state)
2.2973+ "True if parse state STATE is within a comment.
2.2974+If no parse state is supplied, compute one from the beginning of the
2.2975+ defun to the point."
2.2976+ ;; 4. nil if outside a comment, t if inside a non-nestable comment,
2.2977+ ;; else an integer (the current comment nesting)
2.2978+ (and (nth 4 (or state (paredit-current-parse-state)))
2.2979+ t))
2.2980+
2.2981+(defun paredit-prefix-numeric-value (argument)
2.2982+ ;++ Kludgerific.
2.2983+ (cond ((integerp argument) argument)
2.2984+ ((eq argument '-) -1)
2.2985+ ((consp argument)
2.2986+ (cond ((equal argument '(4)) (paredit-count-sexps-forward)) ;C-u
2.2987+ ((equal argument '(16)) (paredit-count-sexps-backward)) ;C-u C-u
2.2988+ (t (error "Invalid prefix argument: %S" argument))))
2.2989+ ((paredit-region-active-p)
2.2990+ (save-excursion
2.2991+ (save-restriction
2.2992+ (narrow-to-region (region-beginning) (region-end))
2.2993+ (cond ((= (point) (point-min)) (paredit-count-sexps-forward))
2.2994+ ((= (point) (point-max)) (paredit-count-sexps-backward))
2.2995+ (t
2.2996+ (error "Point %S is not start or end of region: %S..%S"
2.2997+ (point) (region-beginning) (region-end)))))))
2.2998+ (t 1)))
2.2999+
2.3000+(defun paredit-count-sexps-forward ()
2.3001+ (save-excursion
2.3002+ (let ((n 0) (p nil)) ;hurk
2.3003+ (paredit-ignore-sexp-errors
2.3004+ (while (setq p (scan-sexps (point) +1))
2.3005+ (goto-char p)
2.3006+ (setq n (+ n 1))))
2.3007+ n)))
2.3008+
2.3009+(defun paredit-count-sexps-backward ()
2.3010+ (save-excursion
2.3011+ (let ((n 0) (p nil)) ;hurk
2.3012+ (paredit-ignore-sexp-errors
2.3013+ (while (setq p (scan-sexps (point) -1))
2.3014+ (goto-char p)
2.3015+ (setq n (+ n 1))))
2.3016+ n)))
2.3017+
2.3018+(defun paredit-point-at-sexp-boundary (n)
2.3019+ (cond ((< n 0) (paredit-point-at-sexp-start))
2.3020+ ((= n 0) (point))
2.3021+ ((> n 0) (paredit-point-at-sexp-end))))
2.3022+
2.3023+(defun paredit-point-at-sexp-start ()
2.3024+ (save-excursion
2.3025+ (forward-sexp)
2.3026+ (backward-sexp)
2.3027+ (point)))
2.3028+
2.3029+(defun paredit-point-at-sexp-end ()
2.3030+ (save-excursion
2.3031+ (backward-sexp)
2.3032+ (forward-sexp)
2.3033+ (point)))
2.3034+
2.3035+(defun paredit-lose-if-not-in-sexp (command)
2.3036+ (if (or (paredit-in-string-p)
2.3037+ (paredit-in-comment-p)
2.3038+ (paredit-in-char-p))
2.3039+ (error "Invalid context for command `%s'." command)))
2.3040+
2.3041+(defun paredit-check-region (start end)
2.3042+ "Signal an error if text between `start' and `end' is unbalanced."
2.3043+ ;; `narrow-to-region' will move the point, so avoid calling it if we
2.3044+ ;; don't need to. We don't want to use `save-excursion' because we
2.3045+ ;; want the point to move if `check-parens' reports an error.
2.3046+ (if (not (paredit-region-ok-p start end))
2.3047+ (save-restriction
2.3048+ (narrow-to-region start end)
2.3049+ (check-parens))))
2.3050+
2.3051+(defun paredit-region-ok-p (start end)
2.3052+ "Return true iff the region between `start' and `end' is balanced.
2.3053+This is independent of context -- it doesn't check what state the
2.3054+ text at `start' is in."
2.3055+ (save-excursion
2.3056+ (paredit-handle-sexp-errors
2.3057+ (progn
2.3058+ (save-restriction
2.3059+ (narrow-to-region start end)
2.3060+ (scan-sexps (point-min) (point-max)))
2.3061+ t)
2.3062+ nil)))
2.3063+
2.3064+(defun paredit-current-column ()
2.3065+ ;; Like current-column, but respects field boundaries in interactive
2.3066+ ;; modes like ielm. For use only with paredit-restore-column, which
2.3067+ ;; works relative to point-at-bol.
2.3068+ (- (point) (point-at-bol)))
2.3069+
2.3070+(defun paredit-current-indentation ()
2.3071+ (save-excursion
2.3072+ (back-to-indentation)
2.3073+ (paredit-current-column)))
2.3074+
2.3075+(defun paredit-restore-column (column indentation)
2.3076+ ;; Preserve the point's position either in the indentation or in the
2.3077+ ;; code: if on code, move with the code; if in indentation, leave it
2.3078+ ;; in the indentation, either where it was (if still on indentation)
2.3079+ ;; or at the end of the indentation (if the code moved far enough
2.3080+ ;; left).
2.3081+ (let ((indentation* (paredit-current-indentation)))
2.3082+ (goto-char
2.3083+ (+ (point-at-bol)
2.3084+ (cond ((not (< column indentation))
2.3085+ (+ column (- indentation* indentation)))
2.3086+ ((<= indentation* column) indentation*)
2.3087+ (t column))))))
2.3088+
2.3089+;;;; Initialization
2.3090+
2.3091+(paredit-define-keys)
2.3092+(paredit-annotate-mode-with-examples)
2.3093+(paredit-annotate-functions-with-examples)
2.3094+
2.3095+(provide 'paredit)
2.3096+
2.3097+;;; Local Variables:
2.3098+;;; outline-regexp: " \n;;;;+"
2.3099+;;; End:
2.3100+
2.3101+;;; paredit.el ends here
3.1--- a/.emacs.d/paredit.el Tue May 21 22:20:59 2024 -0400
3.2+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
3.3@@ -1,3098 +0,0 @@
3.4-;;; paredit.el --- minor mode for editing parentheses -*- Mode: Emacs-Lisp -*-
3.5-
3.6-;; Copyright (C) 2005--2023 Taylor R. Campbell
3.7-
3.8-;; Author: Taylor R. Campbell <campbell@paredit.org>
3.9-;; Version: 27beta
3.10-;; Created: 2005-07-31
3.11-;; Keywords: lisp
3.12-;; URL: https://paredit.org
3.13-
3.14-;; Paredit is free software: you can redistribute it and/or modify it
3.15-;; under the terms of the GNU General Public License as published by
3.16-;; the Free Software Foundation, either version 3 of the License, or
3.17-;; (at your option) any later version.
3.18-;;
3.19-;; Paredit is distributed in the hope that it will be useful, but
3.20-;; WITHOUT ANY WARRANTY; without even the implied warranty of
3.21-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
3.22-;; GNU General Public License for more details.
3.23-;;
3.24-;; You should have received a copy of the GNU General Public License
3.25-;; along with paredit. If not, see <http://www.gnu.org/licenses/>.
3.26-
3.27-;;; Paredit - https://paredit.org
3.28-;;;
3.29-;;; Latest release: https://paredit.org/paredit.el
3.30-;;; Current development version: https://paredit.org/paredit-beta.el
3.31-;;; Release notes: https://paredit.org/NEWS
3.32-
3.33-;;; Commentary:
3.34-
3.35-;; Paredit keeps your parentheses balanced while editing. Paredit Mode
3.36-;; binds keys like `(', `)', and `"' to insert or delete parentheses
3.37-;; and string quotes in balanced pairs as you're editing without
3.38-;; getting in your way, augments editing keys like `C-k' to handle
3.39-;; balanced expressions, and provides advanced commands for editing
3.40-;; balanced expressions like splicing and joining while judiciously
3.41-;; keeping the code you're working on indented.
3.42-
3.43-;;; Install paredit by placing `paredit.el' in `/path/to/elisp', a
3.44-;;; directory of your choice, and adding to your .emacs file:
3.45-;;;
3.46-;;; (add-to-list 'load-path "/path/to/elisp")
3.47-;;; (autoload 'enable-paredit-mode "paredit"
3.48-;;; "Turn on pseudo-structural editing of Lisp code."
3.49-;;; t)
3.50-;;;
3.51-;;; Start Paredit Mode on the fly with `M-x enable-paredit-mode RET',
3.52-;;; or always enable it in a major mode `M' (e.g., `lisp') with:
3.53-;;;
3.54-;;; (add-hook 'M-mode-hook 'enable-paredit-mode)
3.55-;;;
3.56-;;; Customize paredit using `eval-after-load':
3.57-;;;
3.58-;;; (eval-after-load 'paredit
3.59-;;; '(progn
3.60-;;; (define-key paredit-mode-map (kbd "ESC M-A-C-s-)")
3.61-;;; 'paredit-dwim)))
3.62-;;;
3.63-;;; Send questions, bug reports, comments, feature suggestions, &c.,
3.64-;;; via email to the author's surname at paredit.org.
3.65-;;;
3.66-;;; Paredit should run in GNU Emacs 21 or later and XEmacs 21.5.28 or
3.67-;;; later.
3.68-
3.69-;;; The paredit minor mode, Paredit Mode, binds common character keys,
3.70-;;; such as `(', `)', `"', and `\', to commands that carefully insert
3.71-;;; S-expression structures in the buffer:
3.72-;;;
3.73-;;; ( inserts `()', leaving the point in the middle;
3.74-;;; ) moves the point over the next closing delimiter;
3.75-;;; " inserts `""' if outside a string, or inserts an escaped
3.76-;;; double-quote if in the middle of a string, or moves over the
3.77-;;; closing double-quote if at the end of a string; and
3.78-;;; \ prompts for the character to escape, to avoid inserting lone
3.79-;;; backslashes that may break structure.
3.80-;;;
3.81-;;; In comments, these keys insert themselves. If necessary, you can
3.82-;;; insert these characters literally outside comments by pressing
3.83-;;; `C-q' before these keys, in case a mistake has broken the
3.84-;;; structure.
3.85-;;;
3.86-;;; These key bindings are designed so that when typing new code in
3.87-;;; Paredit Mode, you can generally type exactly the same sequence of
3.88-;;; keys you would have typed without Paredit Mode.
3.89-;;;
3.90-;;; Paredit Mode also binds common editing keys, such as `DEL', `C-d',
3.91-;;; and `C-k', to commands that respect S-expression structures in the
3.92-;;; buffer:
3.93-;;;
3.94-;;; DEL deletes the previous character, unless it is a delimiter: DEL
3.95-;;; will move the point backward over a closing delimiter, and
3.96-;;; will delete a delimiter pair together if between an open and
3.97-;;; closing delimiter;
3.98-;;;
3.99-;;; C-d deletes the next character in much the same manner; and
3.100-;;;
3.101-;;; C-k kills all S-expressions that begin anywhere between the point
3.102-;;; and the end of the line or the closing delimiter of the
3.103-;;; enclosing list, whichever is first.
3.104-;;;
3.105-;;; If necessary, you can delete a character, kill a line, &c.,
3.106-;;; irrespective of S-expression structure, by pressing `C-u' before
3.107-;;; these keys, in case a mistake has broken the structure.
3.108-;;;
3.109-;;; Finally, Paredit Mode binds some keys to complex S-expression
3.110-;;; editing operations. For example, `C-<right>' makes the enclosing
3.111-;;; list slurp up an S-expression to its right (here `|' denotes the
3.112-;;; point):
3.113-;;;
3.114-;;; (foo (bar | baz) quux) C-<right> (foo (bar | baz quux))
3.115-;;;
3.116-;;; Note: Paredit Mode is not compatible with Electric Indent Mode.
3.117-;;; Use one or the other, not both. If you want RET to auto-indent and
3.118-;;; C-j to just insert newline in Paredit Mode, simply rebind the keys
3.119-;;; with the following fragment in your .emacs file:
3.120-;;;
3.121-;;; (eval-after-load 'paredit
3.122-;;; '(progn
3.123-;;; (define-key paredit-mode-map (kbd "RET") 'paredit-newline)
3.124-;;; (define-key paredit-mode-map (kbd "C-j") nil)))
3.125-;;;
3.126-;;; Some paredit commands automatically reindent code. When they do,
3.127-;;; they try to indent as locally as possible, to avoid interfering
3.128-;;; with any indentation you might have manually written. Only the
3.129-;;; advanced S-expression manipulation commands automatically reindent,
3.130-;;; and only the forms that they immediately operated upon (and their
3.131-;;; subforms).
3.132-;;;
3.133-;;; This code is written for clarity, not efficiency. It frequently
3.134-;;; walks over S-expressions redundantly. If you have problems with
3.135-;;; the time it takes to execute some of the commands, let me know.
3.136-
3.137-;;; This assumes Unix-style LF line endings.
3.138-
3.139-(defconst paredit-version 27)
3.140-(defconst paredit-beta-p t)
3.141-
3.142-(eval-and-compile
3.143-
3.144- (defun paredit-xemacs-p ()
3.145- ;; No idea where I got this definition from. Edward O'Connor
3.146- ;; (hober in #emacs) suggested the current definition.
3.147- ;; (and (boundp 'running-xemacs)
3.148- ;; running-xemacs)
3.149- (featurep 'xemacs))
3.150-
3.151- (defun paredit-gnu-emacs-p ()
3.152- ;++ This could probably be improved.
3.153- (not (paredit-xemacs-p)))
3.154-
3.155- (defmacro xcond (&rest clauses)
3.156- "Exhaustive COND.
3.157-Signal an error if no clause matches."
3.158- `(cond ,@clauses
3.159- (t (error "XCOND lost."))))
3.160-
3.161- (defalias 'paredit-warn (if (fboundp 'warn) 'warn 'message))
3.162-
3.163- (defvar paredit-sexp-error-type
3.164- (with-temp-buffer
3.165- (insert "(")
3.166- (condition-case condition
3.167- (backward-sexp)
3.168- (error (if (eq (car condition) 'error)
3.169- (paredit-warn "%s%s%s%s%s"
3.170- "Paredit is unable to discriminate"
3.171- " S-expression parse errors from"
3.172- " other errors. "
3.173- " This may cause obscure problems. "
3.174- " Please upgrade Emacs."))
3.175- (car condition)))))
3.176-
3.177- (defmacro paredit-handle-sexp-errors (body &rest handler)
3.178- `(condition-case ()
3.179- ,body
3.180- (,paredit-sexp-error-type ,@handler)))
3.181-
3.182- (put 'paredit-handle-sexp-errors 'lisp-indent-function 1)
3.183-
3.184- (defmacro paredit-ignore-sexp-errors (&rest body)
3.185- `(paredit-handle-sexp-errors (progn ,@body)
3.186- nil))
3.187-
3.188- (put 'paredit-ignore-sexp-errors 'lisp-indent-function 0)
3.189-
3.190- (defmacro paredit-preserving-column (&rest body)
3.191- "Evaluate BODY and restore point to former column, relative to code.
3.192-Assumes BODY will change only indentation.
3.193-If point was on code, it moves with the code.
3.194-If point was on indentation, it stays in indentation."
3.195- (let ((column (make-symbol "column"))
3.196- (indentation (make-symbol "indentation")))
3.197- `(let ((,column (paredit-current-column))
3.198- (,indentation (paredit-current-indentation)))
3.199- (let ((value (progn ,@body)))
3.200- (paredit-restore-column ,column ,indentation)
3.201- value))))
3.202-
3.203- (put 'paredit-preserving-column 'lisp-indent-function 0)
3.204-
3.205- nil)
3.206-
3.207-;;;; Minor Mode Definition
3.208-
3.209-(defvar paredit-lighter " Paredit"
3.210- "Mode line lighter Paredit Mode.")
3.211-
3.212-(defvar paredit-mode-map (make-sparse-keymap)
3.213- "Keymap for the paredit minor mode.")
3.214-
3.215-(defvar paredit-override-check-parens-function
3.216- (lambda (condition) (declare ignore condition) nil)
3.217- "Function to tell whether unbalanced text should inhibit Paredit Mode.")
3.218-
3.219-;;;###autoload
3.220-(define-minor-mode paredit-mode
3.221- "Minor mode for pseudo-structurally editing Lisp code.
3.222-With a prefix argument, enable Paredit Mode even if there are
3.223- unbalanced parentheses in the buffer.
3.224-Paredit behaves badly if parentheses are unbalanced, so exercise
3.225- caution when forcing Paredit Mode to be enabled, and consider
3.226- fixing unbalanced parentheses instead.
3.227-\\<paredit-mode-map>"
3.228- :lighter paredit-lighter
3.229- ;; Setting `paredit-mode' to false here aborts enabling Paredit Mode.
3.230- (if (and paredit-mode
3.231- (not current-prefix-arg))
3.232- (condition-case condition
3.233- (check-parens)
3.234- (error
3.235- (if (not (funcall paredit-override-check-parens-function condition))
3.236- (progn (setq paredit-mode nil)
3.237- (signal (car condition) (cdr condition))))))))
3.238-
3.239-(defun paredit-override-check-parens-interactively (condition)
3.240- (y-or-n-p (format "Enable Paredit Mode despite condition %S? " condition)))
3.241-
3.242-;;;###autoload
3.243-(defun enable-paredit-mode ()
3.244- "Turn on pseudo-structural editing of Lisp code."
3.245- (interactive)
3.246- (paredit-mode +1))
3.247-
3.248-(defun disable-paredit-mode ()
3.249- "Turn off pseudo-structural editing of Lisp code."
3.250- (interactive)
3.251- (paredit-mode -1))
3.252-
3.253-(defvar paredit-backward-delete-key
3.254- (xcond ((paredit-xemacs-p) "BS")
3.255- ((paredit-gnu-emacs-p) "DEL")))
3.256-
3.257-(defvar paredit-forward-delete-keys
3.258- (xcond ((paredit-xemacs-p) '("DEL"))
3.259- ((paredit-gnu-emacs-p) '("<delete>" "<deletechar>"))))
3.260-
3.261-;;;; Paredit Keys
3.262-
3.263-;;; Separating the definition and initialization of this variable
3.264-;;; simplifies the development of paredit, since re-evaluating DEFVAR
3.265-;;; forms doesn't actually do anything.
3.266-
3.267-(defvar paredit-commands nil
3.268- "List of paredit commands with their keys and examples.")
3.269-
3.270-;;; Each specifier is of the form:
3.271-;;; (key[s] function (example-input example-output) ...)
3.272-;;; where key[s] is either a single string suitable for passing to KBD
3.273-;;; or a list of such strings. Entries in this list may also just be
3.274-;;; strings, in which case they are headings for the next entries.
3.275-
3.276-(progn (setq paredit-commands
3.277- `(
3.278- "Basic Insertion Commands"
3.279- ("(" paredit-open-round
3.280- ("(a b |c d)"
3.281- "(a b (|) c d)")
3.282- ("(foo \"bar |baz\" quux)"
3.283- "(foo \"bar (|baz\" quux)"))
3.284- (")" paredit-close-round
3.285- ("(a b |c )" "(a b c)|")
3.286- ("; Hello,| world!"
3.287- "; Hello,)| world!"))
3.288- ("M-)" paredit-close-round-and-newline
3.289- ("(defun f (x| ))"
3.290- "(defun f (x)\n |)")
3.291- ("; (Foo.|"
3.292- "; (Foo.)|"))
3.293- ("[" paredit-open-square
3.294- ("(a b |c d)"
3.295- "(a b [|] c d)")
3.296- ("(foo \"bar |baz\" quux)"
3.297- "(foo \"bar [|baz\" quux)"))
3.298- ("]" paredit-close-square
3.299- ("(define-key keymap [frob| ] 'frobnicate)"
3.300- "(define-key keymap [frob]| 'frobnicate)")
3.301- ("; [Bar.|"
3.302- "; [Bar.]|"))
3.303-
3.304- ("\"" paredit-doublequote
3.305- ("(frob grovel |full lexical)"
3.306- "(frob grovel \"|\" full lexical)"
3.307- "(frob grovel \"\"| full lexical)")
3.308- ("(foo \"bar |baz\" quux)"
3.309- "(foo \"bar \\\"|baz\" quux)")
3.310- ("(frob grovel) ; full |lexical"
3.311- "(frob grovel) ; full \"|lexical"))
3.312- ("M-\"" paredit-meta-doublequote
3.313- ("(foo \"bar |baz\" quux)"
3.314- "(foo \"bar baz\"| quux)")
3.315- ("(foo |(bar #\\x \"baz \\\\ quux\") zot)"
3.316- ,(concat "(foo \"|(bar #\\\\x \\\"baz \\\\"
3.317- "\\\\ quux\\\")\" zot)")))
3.318- ("\\" paredit-backslash
3.319- ("(string #|)\n ; Character to escape: x"
3.320- "(string #\\x|)")
3.321- ("\"foo|bar\"\n ; Character to escape: \""
3.322- "\"foo\\\"|bar\""))
3.323- (";" paredit-semicolon
3.324- ("|(frob grovel)"
3.325- ";|(frob grovel)")
3.326- ("(frob |grovel)"
3.327- "(frob ;|grovel\n )")
3.328- ("(frob |grovel (bloit\n zargh))"
3.329- "(frob ;|grovel\n (bloit\n zargh))")
3.330- ("(frob grovel) |"
3.331- "(frob grovel) ;|"))
3.332- ("M-;" paredit-comment-dwim
3.333- ("(foo |bar) ; baz"
3.334- "(foo bar) ; |baz")
3.335- ("(frob grovel)|"
3.336- "(frob grovel) ;|")
3.337- ("(zot (foo bar)\n|\n (baz quux))"
3.338- "(zot (foo bar)\n ;; |\n (baz quux))")
3.339- ("(zot (foo bar) |(baz quux))"
3.340- "(zot (foo bar)\n ;; |\n (baz quux))")
3.341- ("|(defun hello-world ...)"
3.342- ";;; |\n(defun hello-world ...)"))
3.343-
3.344- (() paredit-newline
3.345- ("(let ((n (frobbotz))) |(display (+ n 1)\nport))"
3.346- ,(concat "(let ((n (frobbotz)))"
3.347- "\n |(display (+ n 1)"
3.348- "\n port))")))
3.349- ("RET" paredit-RET)
3.350- ("C-j" paredit-C-j)
3.351-
3.352- "Deleting & Killing"
3.353- (,paredit-forward-delete-keys
3.354- paredit-forward-delete
3.355- ("(quu|x \"zot\")" "(quu| \"zot\")")
3.356- ("(quux |\"zot\")"
3.357- "(quux \"|zot\")"
3.358- "(quux \"|ot\")")
3.359- ("(foo (|) bar)" "(foo | bar)")
3.360- ("|(foo bar)" "(|foo bar)"))
3.361- (,paredit-backward-delete-key
3.362- paredit-backward-delete
3.363- ("(\"zot\" q|uux)" "(\"zot\" |uux)")
3.364- ("(\"zot\"| quux)"
3.365- "(\"zot|\" quux)"
3.366- "(\"zo|\" quux)")
3.367- ("(foo (|) bar)" "(foo | bar)")
3.368- ("(foo bar)|" "(foo bar|)"))
3.369- ("C-d" paredit-delete-char
3.370- ("(quu|x \"zot\")" "(quu| \"zot\")")
3.371- ("(quux |\"zot\")"
3.372- "(quux \"|zot\")"
3.373- "(quux \"|ot\")")
3.374- ("(foo (|) bar)" "(foo | bar)")
3.375- ("|(foo bar)" "(|foo bar)"))
3.376- ("C-k" paredit-kill
3.377- ("(foo bar)| ; Useless comment!"
3.378- "(foo bar)|")
3.379- ("(|foo bar) ; Useful comment!"
3.380- "(|) ; Useful comment!")
3.381- ("|(foo bar) ; Useless line!"
3.382- "|")
3.383- ("(foo \"|bar baz\"\n quux)"
3.384- "(foo \"|\"\n quux)"))
3.385- ("M-d" paredit-forward-kill-word
3.386- ("|(foo bar) ; baz"
3.387- "(| bar) ; baz"
3.388- "(|) ; baz"
3.389- "() ;|")
3.390- (";;;| Frobnicate\n(defun frobnicate ...)"
3.391- ";;;|\n(defun frobnicate ...)"
3.392- ";;;\n(| frobnicate ...)"))
3.393- (,(concat "M-" paredit-backward-delete-key)
3.394- paredit-backward-kill-word
3.395- ("(foo bar) ; baz\n(quux)|"
3.396- "(foo bar) ; baz\n(|)"
3.397- "(foo bar) ; |\n()"
3.398- "(foo |) ; \n()"
3.399- "(|) ; \n()"))
3.400-
3.401- "Movement & Navigation"
3.402- ("C-M-f" paredit-forward
3.403- ("(foo |(bar baz) quux)"
3.404- "(foo (bar baz)| quux)")
3.405- ("(foo (bar)|)"
3.406- "(foo (bar))|"))
3.407- ("C-M-b" paredit-backward
3.408- ("(foo (bar baz)| quux)"
3.409- "(foo |(bar baz) quux)")
3.410- ("(|(foo) bar)"
3.411- "|((foo) bar)"))
3.412- ("C-M-u" paredit-backward-up)
3.413- ("C-M-d" paredit-forward-down)
3.414- ("C-M-p" paredit-backward-down) ; Built-in, these are FORWARD-
3.415- ("C-M-n" paredit-forward-up) ; & BACKWARD-LIST, which have
3.416- ; no need given C-M-f & C-M-b.
3.417-
3.418- "Depth-Changing Commands"
3.419- ("M-(" paredit-wrap-round
3.420- ("(foo |bar baz)"
3.421- "(foo (|bar) baz)"))
3.422- ("M-s" paredit-splice-sexp
3.423- ("(foo (bar| baz) quux)"
3.424- "(foo bar| baz quux)"))
3.425- (("M-<up>" "ESC <up>")
3.426- paredit-splice-sexp-killing-backward
3.427- ("(foo (let ((x 5)) |(sqrt n)) bar)"
3.428- "(foo |(sqrt n) bar)"))
3.429- (("M-<down>" "ESC <down>")
3.430- paredit-splice-sexp-killing-forward
3.431- ("(a (b c| d e) f)"
3.432- "(a b c| f)"))
3.433- ("M-r" paredit-raise-sexp
3.434- ("(dynamic-wind in (lambda () |body) out)"
3.435- "(dynamic-wind in |body out)"
3.436- "|body"))
3.437- ("M-?" paredit-convolute-sexp
3.438- ("(let ((x 5) (y 3)) (frob |(zwonk)) (wibblethwop))"
3.439- "(frob |(let ((x 5) (y 3)) (zwonk) (wibblethwop)))"))
3.440-
3.441- "Barfage & Slurpage"
3.442- (("C-)" "C-<right>")
3.443- paredit-forward-slurp-sexp
3.444- ("(foo (bar |baz) quux zot)"
3.445- "(foo (bar |baz quux) zot)")
3.446- ("(a b ((c| d)) e f)"
3.447- "(a b ((c| d) e) f)"))
3.448- (("C-}" "C-<left>")
3.449- paredit-forward-barf-sexp
3.450- ("(foo (bar |baz quux) zot)"
3.451- "(foo (bar |baz) quux zot)"))
3.452- (("C-(" "C-M-<left>" "ESC C-<left>")
3.453- paredit-backward-slurp-sexp
3.454- ("(foo bar (baz| quux) zot)"
3.455- "(foo (bar baz| quux) zot)")
3.456- ("(a b ((c| d)) e f)"
3.457- "(a (b (c| d)) e f)"))
3.458- (("C-{" "C-M-<right>" "ESC C-<right>")
3.459- paredit-backward-barf-sexp
3.460- ("(foo (bar baz |quux) zot)"
3.461- "(foo bar (baz |quux) zot)"))
3.462-
3.463- "Miscellaneous Commands"
3.464- ("M-S" paredit-split-sexp
3.465- ("(hello| world)"
3.466- "(hello)| (world)")
3.467- ("\"Hello, |world!\""
3.468- "\"Hello, \"| \"world!\""))
3.469- ("M-J" paredit-join-sexps
3.470- ("(hello)| (world)"
3.471- "(hello| world)")
3.472- ("\"Hello, \"| \"world!\""
3.473- "\"Hello, |world!\"")
3.474- ("hello-\n| world"
3.475- "hello-|world"))
3.476- ("C-c C-M-l" paredit-recenter-on-sexp)
3.477- ("M-q" paredit-reindent-defun)
3.478- ))
3.479- nil) ; end of PROGN
3.480-
3.481-;;;;; Command Examples
3.482-
3.483-(eval-and-compile
3.484- (defmacro paredit-do-commands (vars string-case &rest body)
3.485- (let ((spec (nth 0 vars))
3.486- (keys (nth 1 vars))
3.487- (fn (nth 2 vars))
3.488- (examples (nth 3 vars)))
3.489- `(dolist (,spec paredit-commands)
3.490- (if (stringp ,spec)
3.491- ,string-case
3.492- (let ((,keys (let ((k (car ,spec)))
3.493- (cond ((stringp k) (list k))
3.494- ((listp k) k)
3.495- (t (error "Invalid paredit command %s."
3.496- ,spec)))))
3.497- (,fn (cadr ,spec))
3.498- (,examples (cddr ,spec)))
3.499- ,@body)))))
3.500-
3.501- (put 'paredit-do-commands 'lisp-indent-function 2))
3.502-
3.503-(defun paredit-define-keys ()
3.504- (paredit-do-commands (spec keys fn examples)
3.505- nil ; string case
3.506- (dolist (key keys)
3.507- (define-key paredit-mode-map (read-kbd-macro key) fn))))
3.508-
3.509-(defun paredit-function-documentation (fn)
3.510- (let ((original-doc (get fn 'paredit-original-documentation))
3.511- (doc (documentation fn 'function-documentation)))
3.512- (or original-doc
3.513- (progn (put fn 'paredit-original-documentation doc)
3.514- doc))))
3.515-
3.516-(defun paredit-annotate-mode-with-examples ()
3.517- (let ((contents
3.518- (list (paredit-function-documentation 'paredit-mode))))
3.519- (paredit-do-commands (spec keys fn examples)
3.520- (push (concat "\n \n" spec "\n")
3.521- contents)
3.522- (let ((name (symbol-name fn)))
3.523- (if (string-match (symbol-name 'paredit-) name)
3.524- (push (concat "\n\n\\[" name "]\t" name
3.525- (if examples
3.526- (mapconcat (lambda (example)
3.527- (concat
3.528- "\n"
3.529- (mapconcat 'identity
3.530- example
3.531- "\n --->\n")
3.532- "\n"))
3.533- examples
3.534- "")
3.535- "\n (no examples)\n"))
3.536- contents))))
3.537- (put 'paredit-mode 'function-documentation
3.538- (apply 'concat (reverse contents))))
3.539- ;; PUT returns the huge string we just constructed, which we don't
3.540- ;; want it to return.
3.541- nil)
3.542-
3.543-(defun paredit-annotate-functions-with-examples ()
3.544- (paredit-do-commands (spec keys fn examples)
3.545- nil ; string case
3.546- (put fn 'function-documentation
3.547- (concat (paredit-function-documentation fn)
3.548- "\n\n\\<paredit-mode-map>\\[" (symbol-name fn) "]\n"
3.549- (mapconcat (lambda (example)
3.550- (concat "\n"
3.551- (mapconcat 'identity
3.552- example
3.553- "\n ->\n")
3.554- "\n"))
3.555- examples
3.556- "")))))
3.557-
3.558-;;;;; HTML Examples
3.559-
3.560-(defun paredit-insert-html-examples ()
3.561- "Insert HTML for a paredit quick reference table."
3.562- (interactive)
3.563- (let ((insert-lines
3.564- (lambda (&rest lines) (dolist (line lines) (insert line) (newline))))
3.565- (initp nil))
3.566- (paredit-do-commands (spec keys fn examples)
3.567- (progn (if initp
3.568- (funcall insert-lines "</table>")
3.569- (setq initp t))
3.570- (funcall insert-lines (concat "<h3>" spec "</h3>"))
3.571- (funcall insert-lines "<table>"))
3.572- (let ((name (symbol-name fn))
3.573- (keys
3.574- (mapconcat (lambda (key)
3.575- (concat "<tt>" (paredit-html-quote key) "</tt>"))
3.576- keys
3.577- ", ")))
3.578- (funcall insert-lines "<tr>")
3.579- (funcall insert-lines (concat " <th align=\"left\">" keys "</th>"))
3.580- (funcall insert-lines (concat " <th align=\"left\">" name "</th>"))
3.581- (funcall insert-lines "</tr>")
3.582- (funcall insert-lines
3.583- "<tr><td colspan=\"2\"><table cellpadding=\"5\"><tr>")
3.584- (dolist (example examples)
3.585- (let ((prefix "<td><table border=\"1\"><tr><td><table><tr><td><pre>")
3.586- (examples
3.587- (mapconcat 'paredit-html-quote
3.588- example
3.589- (concat "</pre></td></tr>"
3.590- "<tr><th>↓</th></tr>"
3.591- "<tr><td><pre>")))
3.592- (suffix "</pre></td></tr></table></td></tr></table></td>"))
3.593- (funcall insert-lines (concat prefix examples suffix))))
3.594- (funcall insert-lines "</tr></table></td></tr>")))
3.595- (funcall insert-lines "</table>")))
3.596-
3.597-(defun paredit-html-quote (string)
3.598- (with-temp-buffer
3.599- (dotimes (i (length string))
3.600- (insert (let ((c (elt string i)))
3.601- (cond ((eq c ?\<) "<")
3.602- ((eq c ?\>) ">")
3.603- ((eq c ?\&) "&")
3.604- ((eq c ?\') "'")
3.605- ((eq c ?\") """)
3.606- (t c)))))
3.607- (buffer-string)))
3.608-
3.609-;;;; Delimiter Insertion
3.610-
3.611-(eval-and-compile
3.612- (defun paredit-conc-name (&rest strings)
3.613- (intern (apply 'concat strings)))
3.614-
3.615- (defmacro define-paredit-pair (open close name)
3.616- `(progn
3.617- (defun ,(paredit-conc-name "paredit-open-" name) (&optional n)
3.618- ,(concat "Insert a balanced " name " pair.
3.619-With a prefix argument N, put the closing " name " after N
3.620- S-expressions forward.
3.621-If the region is active, `transient-mark-mode' is enabled, and the
3.622- region's start and end fall in the same parenthesis depth, insert a
3.623- " name " pair around the region.
3.624-If in a string or a comment, insert a single " name ".
3.625-If in a character literal, do nothing. This prevents changing what was
3.626- in the character literal to a meaningful delimiter unintentionally.")
3.627- (interactive "P")
3.628- (cond ((or (paredit-in-string-p)
3.629- (paredit-in-comment-p))
3.630- (insert ,open))
3.631- ((not (paredit-in-char-p))
3.632- (paredit-insert-pair n ,open ,close 'goto-char)
3.633- (save-excursion (backward-up-list) (indent-sexp)))))
3.634- (defun ,(paredit-conc-name "paredit-close-" name) ()
3.635- ,(concat "Move past one closing delimiter and reindent.
3.636-\(Agnostic to the specific closing delimiter.)
3.637-If in a string or comment, insert a single closing " name ".
3.638-If in a character literal, do nothing. This prevents changing what was
3.639- in the character literal to a meaningful delimiter unintentionally.")
3.640- (interactive)
3.641- (paredit-move-past-close ,close))
3.642- (defun ,(paredit-conc-name "paredit-close-" name "-and-newline") ()
3.643- ,(concat "Move past one closing delimiter, add a newline,"
3.644- " and reindent.
3.645-If there was a margin comment after the closing delimiter, preserve it
3.646- on the same line.")
3.647- (interactive)
3.648- (paredit-move-past-close-and-newline ,close))
3.649- (defun ,(paredit-conc-name "paredit-wrap-" name)
3.650- (&optional argument)
3.651- ,(concat "Wrap the following S-expression.
3.652-See `paredit-wrap-sexp' for more details.")
3.653- (interactive "P")
3.654- (paredit-wrap-sexp argument ,open ,close))
3.655- (add-to-list 'paredit-wrap-commands
3.656- ',(paredit-conc-name "paredit-wrap-" name)))))
3.657-
3.658-(defvar paredit-wrap-commands '(paredit-wrap-sexp)
3.659- "List of paredit commands that wrap S-expressions.
3.660-Used by `paredit-yank-pop'; for internal paredit use only.")
3.661-
3.662-(define-paredit-pair ?\( ?\) "round")
3.663-(define-paredit-pair ?\[ ?\] "square")
3.664-(define-paredit-pair ?\{ ?\} "curly")
3.665-(define-paredit-pair ?\< ?\> "angled")
3.666-
3.667-;;; Aliases for the old names.
3.668-
3.669-(defalias 'paredit-open-parenthesis 'paredit-open-round)
3.670-(defalias 'paredit-close-parenthesis 'paredit-close-round)
3.671-(defalias 'paredit-close-parenthesis-and-newline
3.672- 'paredit-close-round-and-newline)
3.673-
3.674-(defalias 'paredit-open-bracket 'paredit-open-square)
3.675-(defalias 'paredit-close-bracket 'paredit-close-square)
3.676-(defalias 'paredit-close-bracket-and-newline
3.677- 'paredit-close-square-and-newline)
3.678-
3.679-(defun paredit-move-past-close (close)
3.680- (paredit-move-past-close-and close
3.681- (lambda ()
3.682- (paredit-blink-paren-match nil))))
3.683-
3.684-(defun paredit-move-past-close-and-newline (close)
3.685- (paredit-move-past-close-and close
3.686- (lambda ()
3.687- (let ((comment.point (paredit-find-comment-on-line)))
3.688- (newline)
3.689- (if comment.point
3.690- (save-excursion
3.691- (forward-line -1)
3.692- (end-of-line)
3.693- (indent-to (cdr comment.point))
3.694- (insert (car comment.point)))))
3.695- (lisp-indent-line)
3.696- (paredit-ignore-sexp-errors (indent-sexp))
3.697- (paredit-blink-paren-match t))))
3.698-
3.699-(defun paredit-move-past-close-and (close if-moved)
3.700- (if (or (paredit-in-string-p)
3.701- (paredit-in-comment-p))
3.702- (insert close)
3.703- (if (paredit-in-char-p) (forward-char))
3.704- (paredit-move-past-close-and-reindent close)
3.705- (funcall if-moved)))
3.706-
3.707-(defun paredit-find-comment-on-line ()
3.708- "Find a margin comment on the current line.
3.709-Return nil if there is no such comment or if there is anything but
3.710- whitespace until such a comment.
3.711-If such a comment exists, delete the comment (including all leading
3.712- whitespace) and return a cons whose car is the comment as a string
3.713- and whose cdr is the point of the comment's initial semicolon,
3.714- relative to the start of the line."
3.715- (save-excursion
3.716- (paredit-skip-whitespace t (point-at-eol))
3.717- (and (eq ?\; (char-after))
3.718- (not (eq ?\; (char-after (1+ (point)))))
3.719- (not (or (paredit-in-string-p)
3.720- (paredit-in-char-p)))
3.721- (let* ((start ;Move to before the semicolon.
3.722- (progn (backward-char) (point)))
3.723- (comment
3.724- (buffer-substring start (point-at-eol))))
3.725- (paredit-skip-whitespace nil (point-at-bol))
3.726- (delete-region (point) (point-at-eol))
3.727- (cons comment (- start (point-at-bol)))))))
3.728-
3.729-(defun paredit-insert-pair (n open close forward)
3.730- (let* ((regionp
3.731- (and (paredit-region-active-p)
3.732- (paredit-region-safe-for-insert-p)))
3.733- (end
3.734- (and regionp
3.735- (not n)
3.736- (prog1 (region-end) (goto-char (region-beginning))))))
3.737- (let ((spacep (paredit-space-for-delimiter-p nil open)))
3.738- (if spacep (insert " "))
3.739- (insert open)
3.740- (save-excursion
3.741- ;; Move past the desired region.
3.742- (cond (n
3.743- (funcall forward
3.744- (paredit-scan-sexps-hack (point)
3.745- (prefix-numeric-value n))))
3.746- (regionp
3.747- (funcall forward (+ end (if spacep 2 1)))))
3.748- ;; The string case can happen if we are inserting string
3.749- ;; delimiters. The comment case may happen by moving to the
3.750- ;; end of a buffer that has a comment with no trailing newline.
3.751- (if (and (not (paredit-in-string-p))
3.752- (paredit-in-comment-p))
3.753- (newline))
3.754- (insert close)
3.755- (if (paredit-space-for-delimiter-p t close)
3.756- (insert " "))))))
3.757-
3.758-;++ This needs a better name...
3.759-
3.760-(defun paredit-scan-sexps-hack (point n)
3.761- (save-excursion
3.762- (goto-char point)
3.763- (let ((direction (if (< 0 n) +1 -1))
3.764- (magnitude (abs n))
3.765- (count 0))
3.766- (catch 'exit
3.767- (while (< count magnitude)
3.768- (let ((p
3.769- (paredit-handle-sexp-errors (scan-sexps (point) direction)
3.770- nil)))
3.771- (if (not p) (throw 'exit nil))
3.772- (goto-char p))
3.773- (setq count (+ count 1)))))
3.774- (point)))
3.775-
3.776-(defun paredit-region-safe-for-insert-p ()
3.777- (save-excursion
3.778- (let ((beginning (region-beginning))
3.779- (end (region-end)))
3.780- (goto-char beginning)
3.781- (let* ((beginning-state (paredit-current-parse-state))
3.782- (end-state
3.783- (parse-partial-sexp beginning end nil nil beginning-state)))
3.784- (and (= (nth 0 beginning-state) ; 0. depth in parens
3.785- (nth 0 end-state))
3.786- (eq (nth 3 beginning-state) ; 3. non-nil if inside a
3.787- (nth 3 end-state)) ; string
3.788- (eq (nth 4 beginning-state) ; 4. comment status, yada
3.789- (nth 4 end-state))
3.790- (eq (nth 5 beginning-state) ; 5. t if following char
3.791- (nth 5 end-state))))))) ; quote
3.792-
3.793-(defvar paredit-space-for-delimiter-predicates nil
3.794- "List of predicates for whether to put space by delimiter at point.
3.795-Each predicate is a function that is is applied to two arguments, ENDP
3.796- and DELIMITER, and that returns a boolean saying whether to put a
3.797- space next to the delimiter -- before/after the delimiter if ENDP is
3.798- false/true, respectively.
3.799-If any predicate returns false, no space is inserted: every predicate
3.800- has veto power.
3.801-Each predicate may assume that the point is not at the beginning/end of
3.802- the buffer, and that the point is preceded/followed by a word
3.803- constituent, symbol constituent, string quote, or delimiter matching
3.804- DELIMITER, if ENDP is false/true, respectively.
3.805-Each predicate should examine only text before/after the point if ENDP is
3.806- false/true, respectively.")
3.807-
3.808-(defun paredit-space-for-delimiter-p (endp delimiter)
3.809- ;; If at the buffer limit, don't insert a space. If there is a word,
3.810- ;; symbol, other quote, or non-matching parenthesis delimiter (i.e. a
3.811- ;; close when want an open the string or an open when we want to
3.812- ;; close the string), do insert a space.
3.813- (and (not (if endp (eobp) (bobp)))
3.814- (memq (char-syntax (if endp (char-after) (char-before)))
3.815- (list ?w ?_ ?\"
3.816- (let ((matching (matching-paren delimiter)))
3.817- (and matching (char-syntax matching)))
3.818- (and (not endp)
3.819- (eq ?\" (char-syntax delimiter))
3.820- ?\) )))
3.821- (catch 'exit
3.822- (dolist (predicate paredit-space-for-delimiter-predicates)
3.823- (if (not (funcall predicate endp delimiter))
3.824- (throw 'exit nil)))
3.825- t)))
3.826-
3.827-(defun paredit-move-past-close-and-reindent (close)
3.828- (let ((open (paredit-missing-close)))
3.829- (if open
3.830- (if (eq close (matching-paren open))
3.831- (save-excursion
3.832- (message "Missing closing delimiter: %c" close)
3.833- (insert close))
3.834- (error "Mismatched missing closing delimiter: %c ... %c"
3.835- open close))))
3.836- (up-list)
3.837- (if (catch 'return ; This CATCH returns T if it
3.838- (while t ; should delete leading spaces
3.839- (save-excursion ; and NIL if not.
3.840- (let ((before-paren (1- (point))))
3.841- (back-to-indentation)
3.842- (cond ((not (eq (point) before-paren))
3.843- ;; Can't call PAREDIT-DELETE-LEADING-WHITESPACE
3.844- ;; here -- we must return from SAVE-EXCURSION
3.845- ;; first.
3.846- (throw 'return t))
3.847- ((save-excursion (forward-line -1)
3.848- (end-of-line)
3.849- (paredit-in-comment-p))
3.850- ;; Moving the closing delimiter any further
3.851- ;; would put it into a comment, so we just
3.852- ;; indent the closing delimiter where it is and
3.853- ;; abort the loop, telling its continuation that
3.854- ;; no leading whitespace should be deleted.
3.855- (lisp-indent-line)
3.856- (throw 'return nil))
3.857- (t (delete-indentation)))))))
3.858- (paredit-delete-leading-whitespace)))
3.859-
3.860-(defun paredit-missing-close ()
3.861- (save-excursion
3.862- (paredit-handle-sexp-errors (backward-up-list)
3.863- (error "Not inside a list."))
3.864- (let ((open (char-after)))
3.865- (paredit-handle-sexp-errors (progn (forward-sexp) nil)
3.866- open))))
3.867-
3.868-(defun paredit-delete-leading-whitespace ()
3.869- ;; This assumes that we're on the closing delimiter already.
3.870- (save-excursion
3.871- (backward-char)
3.872- (while (let ((syn (char-syntax (char-before))))
3.873- (and (or (eq syn ?\ ) (eq syn ?-)) ; whitespace syntax
3.874- ;; The above line is a perfect example of why the
3.875- ;; following test is necessary.
3.876- (not (paredit-in-char-p (1- (point))))))
3.877- (delete-char -1))))
3.878-
3.879-(defun paredit-blink-paren-match (another-line-p)
3.880- (if (and blink-matching-paren
3.881- (or (not show-paren-mode) another-line-p))
3.882- (paredit-ignore-sexp-errors
3.883- (save-excursion
3.884- (backward-sexp)
3.885- (forward-sexp)
3.886- ;; SHOW-PAREN-MODE inhibits any blinking, so we disable it
3.887- ;; locally here.
3.888- (let ((show-paren-mode nil))
3.889- (blink-matching-open))))))
3.890-
3.891-(defun paredit-doublequote (&optional n)
3.892- "Insert a pair of double-quotes.
3.893-With a prefix argument N, wrap the following N S-expressions in
3.894- double-quotes, escaping intermediate characters if necessary.
3.895-If the region is active, `transient-mark-mode' is enabled, and the
3.896- region's start and end fall in the same parenthesis depth, insert a
3.897- pair of double-quotes around the region, again escaping intermediate
3.898- characters if necessary.
3.899-Inside a comment, insert a literal double-quote.
3.900-At the end of a string, move past the closing double-quote.
3.901-In the middle of a string, insert a backslash-escaped double-quote.
3.902-If in a character literal, do nothing. This prevents accidentally
3.903- changing a what was in the character literal to become a meaningful
3.904- delimiter unintentionally."
3.905- (interactive "P")
3.906- (cond ((paredit-in-string-p)
3.907- (if (eq (point) (- (paredit-enclosing-string-end) 1))
3.908- (forward-char) ; Just move past the closing quote.
3.909- ;; Don't split a \x into an escaped backslash and a string end.
3.910- (if (paredit-in-string-escape-p) (forward-char))
3.911- (insert ?\\ ?\" )))
3.912- ((paredit-in-comment-p)
3.913- (insert ?\" ))
3.914- ((not (paredit-in-char-p))
3.915- (paredit-insert-pair n ?\" ?\" 'paredit-forward-for-quote))))
3.916-
3.917-(defun paredit-meta-doublequote (&optional n)
3.918- "Move to the end of the string.
3.919-If not in a string, act as `paredit-doublequote'; if no prefix argument
3.920- is specified and the region is not active or `transient-mark-mode' is
3.921- disabled, the default is to wrap one S-expression, however, not zero."
3.922- (interactive "P")
3.923- (if (not (paredit-in-string-p))
3.924- (paredit-doublequote (or n (and (not (paredit-region-active-p)) 1)))
3.925- (goto-char (paredit-enclosing-string-end))))
3.926-
3.927-(defun paredit-meta-doublequote-and-newline (&optional n)
3.928- "Move to the end of the string, insert a newline, and indent.
3.929-If not in a string, act as `paredit-doublequote'; if no prefix argument
3.930- is specified and the region is not active or `transient-mark-mode' is
3.931- disabled, the default is to wrap one S-expression, however, not zero."
3.932- (interactive "P")
3.933- (if (not (paredit-in-string-p))
3.934- (paredit-doublequote (or n (and (not (paredit-region-active-p)) 1)))
3.935- (progn (goto-char (paredit-enclosing-string-end))
3.936- (newline)
3.937- (lisp-indent-line)
3.938- (paredit-ignore-sexp-errors (indent-sexp)))))
3.939-
3.940-(defun paredit-forward-for-quote (end)
3.941- (let ((state (paredit-current-parse-state)))
3.942- (while (< (point) end)
3.943- (let ((new-state (parse-partial-sexp (point) (1+ (point))
3.944- nil nil state)))
3.945- (if (paredit-in-string-p new-state)
3.946- (if (not (paredit-in-string-escape-p))
3.947- (setq state new-state)
3.948- ;; Escape character: turn it into an escaped escape
3.949- ;; character by appending another backslash.
3.950- (insert ?\\ )
3.951- ;; Now the point is after both escapes, and we want to
3.952- ;; rescan from before the first one to after the second
3.953- ;; one.
3.954- (setq state
3.955- (parse-partial-sexp (- (point) 2) (point)
3.956- nil nil state))
3.957- ;; Advance the end point, since we just inserted a new
3.958- ;; character.
3.959- (setq end (1+ end)))
3.960- ;; String: escape by inserting a backslash before the quote.
3.961- (backward-char)
3.962- (insert ?\\ )
3.963- ;; The point is now between the escape and the quote, and we
3.964- ;; want to rescan from before the escape to after the quote.
3.965- (setq state
3.966- (parse-partial-sexp (1- (point)) (1+ (point))
3.967- nil nil state))
3.968- ;; Advance the end point for the same reason as above.
3.969- (setq end (1+ end)))))))
3.970-
3.971-;;;; Escape Insertion
3.972-
3.973-(defun paredit-backslash ()
3.974- "Insert a backslash followed by a character to escape."
3.975- (interactive)
3.976- (cond ((paredit-in-string-p) (paredit-backslash-interactive))
3.977- ((paredit-in-comment-p) (insert ?\\))
3.978- ((paredit-in-char-p) (forward-char) (paredit-backslash-interactive))
3.979- (t (paredit-backslash-interactive))))
3.980-
3.981-(defun paredit-backslash-interactive ()
3.982- (insert ?\\ )
3.983- ;; Read a character to insert after the backslash. If anything
3.984- ;; goes wrong -- the user hits delete (entering the rubout
3.985- ;; `character'), aborts with C-g, or enters non-character input
3.986- ;; -- then delete the backslash to avoid a dangling escape.
3.987- (let ((delete-p t))
3.988- (unwind-protect
3.989- (let ((char (read-char "Character to escape: " t)))
3.990- (if (not (eq char ?\^?))
3.991- (progn (message "Character to escape: %c" char)
3.992- (insert char)
3.993- (setq delete-p nil))))
3.994- (if delete-p
3.995- (progn (message "Deleting escape.")
3.996- (delete-char -1))))))
3.997-
3.998-(defun paredit-newline ()
3.999- "Insert a newline and indent it.
3.1000-This is like `newline-and-indent', but it not only indents the line
3.1001- that the point is on but also the S-expression following the point,
3.1002- if there is one.
3.1003-Move forward one character first if on an escaped character.
3.1004-If in a string, just insert a literal newline.
3.1005-If in a comment and if followed by invalid structure, call
3.1006- `indent-new-comment-line' to keep the invalid structure in a
3.1007- comment."
3.1008- (interactive)
3.1009- (cond ((paredit-in-string-p)
3.1010- (newline))
3.1011- ((paredit-in-comment-p)
3.1012- (if (paredit-region-ok-p (point) (point-at-eol))
3.1013- (progn (newline-and-indent)
3.1014- (paredit-ignore-sexp-errors (indent-sexp)))
3.1015- (indent-new-comment-line)))
3.1016- (t
3.1017- (if (paredit-in-char-p)
3.1018- (forward-char))
3.1019- (newline-and-indent)
3.1020- ;; Indent the following S-expression, but don't signal an
3.1021- ;; error if there's only a closing delimiter after the point.
3.1022- (paredit-ignore-sexp-errors (indent-sexp)))))
3.1023-
3.1024-(defun paredit-electric-indent-mode-p ()
3.1025- "True if Electric Indent Mode is on, false if not.
3.1026-Electric Indent Mode is generally not compatible with paredit and
3.1027- users are advised to disable it, since paredit does essentially
3.1028- everything it tries to do better.
3.1029-However, to mitigate the negative user experience of combining
3.1030- Electric Indent Mode with paredit, the default key bindings for
3.1031- RET and C-j in paredit are exchanged depending on whether
3.1032- Electric Indent Mode is enabled."
3.1033- (and (boundp 'electric-indent-mode)
3.1034- electric-indent-mode))
3.1035-
3.1036-(defun paredit-RET ()
3.1037- "Default key binding for RET in Paredit Mode.
3.1038-Normally, inserts a newline, like traditional Emacs RET.
3.1039-With Electric Indent Mode enabled, inserts a newline and indents
3.1040- the new line, as well as any subexpressions of it on subsequent
3.1041- lines; see `paredit-newline' for details and examples."
3.1042- (interactive)
3.1043- (if (paredit-electric-indent-mode-p)
3.1044- (let ((electric-indent-mode nil))
3.1045- (paredit-newline))
3.1046- (newline)))
3.1047-
3.1048-(defun paredit-C-j ()
3.1049- "Default key binding for C-j in Paredit Mode.
3.1050-Normally, inserts a newline and indents
3.1051- the new line, as well as any subexpressions of it on subsequent
3.1052- lines; see `paredit-newline' for details and examples.
3.1053-With Electric Indent Mode enabled, inserts a newline, like
3.1054- traditional Emacs RET."
3.1055- (interactive)
3.1056- (if (paredit-electric-indent-mode-p)
3.1057- (let ((electric-indent-mode nil))
3.1058- (newline))
3.1059- (paredit-newline)))
3.1060-
3.1061-(defun paredit-reindent-defun (&optional argument)
3.1062- "Reindent the definition that the point is on.
3.1063-If the point is in a string or a comment, fill the paragraph instead,
3.1064- and with a prefix argument, justify as well."
3.1065- (interactive "P")
3.1066- (if (or (paredit-in-string-p)
3.1067- (paredit-in-comment-p))
3.1068- (if (memq fill-paragraph-function '(t nil))
3.1069- (lisp-fill-paragraph argument)
3.1070- (funcall fill-paragraph-function argument))
3.1071- (paredit-preserving-column
3.1072- (save-excursion
3.1073- (end-of-defun)
3.1074- (beginning-of-defun)
3.1075- (indent-sexp)))))
3.1076-
3.1077-;;;; Comment Insertion
3.1078-
3.1079-(defun paredit-semicolon (&optional n)
3.1080- "Insert a semicolon.
3.1081-With a prefix argument N, insert N semicolons.
3.1082-If in a string, do just that and nothing else.
3.1083-If in a character literal, move to the beginning of the character
3.1084- literal before inserting the semicolon.
3.1085-If the enclosing list ends on the line after the point, break the line
3.1086- after the last S-expression following the point.
3.1087-If a list begins on the line after the point but ends on a different
3.1088- line, break the line after the last S-expression following the point
3.1089- before the list."
3.1090- (interactive "p")
3.1091- (if (or (paredit-in-string-p) (paredit-in-comment-p))
3.1092- (insert (make-string (or n 1) ?\; ))
3.1093- (if (paredit-in-char-p)
3.1094- (backward-char 2))
3.1095- (let ((line-break-point (paredit-semicolon-find-line-break-point)))
3.1096- (if line-break-point
3.1097- (paredit-semicolon-with-line-break line-break-point (or n 1))
3.1098- (insert (make-string (or n 1) ?\; ))))))
3.1099-
3.1100-(defun paredit-semicolon-find-line-break-point ()
3.1101- (and (not (eolp)) ;Implies (not (eobp)).
3.1102- (let ((eol (point-at-eol)))
3.1103- (save-excursion
3.1104- (catch 'exit
3.1105- (while t
3.1106- (let ((line-break-point (point)))
3.1107- (cond ((paredit-handle-sexp-errors (progn (forward-sexp) t)
3.1108- nil)
3.1109- ;; Successfully advanced by an S-expression.
3.1110- ;; If that S-expression started on this line
3.1111- ;; and ended on another one, break here.
3.1112- (cond ((not (eq eol (point-at-eol)))
3.1113- (throw 'exit
3.1114- (and (save-excursion
3.1115- (backward-sexp)
3.1116- (eq eol (point-at-eol)))
3.1117- line-break-point)))
3.1118- ((eobp)
3.1119- (throw 'exit nil))))
3.1120- ((save-excursion
3.1121- (paredit-skip-whitespace t (point-at-eol))
3.1122- (or (eolp) (eobp) (eq (char-after) ?\;)))
3.1123- ;; Can't move further, but there's no closing
3.1124- ;; delimiter we're about to clobber -- either
3.1125- ;; it's on the next line or we're at the end of
3.1126- ;; the buffer. Don't break the line.
3.1127- (throw 'exit nil))
3.1128- (t
3.1129- ;; Can't move because we hit a delimiter at the
3.1130- ;; end of this line. Break here.
3.1131- (throw 'exit line-break-point))))))))))
3.1132-
3.1133-(defun paredit-semicolon-with-line-break (line-break-point n)
3.1134- (let ((line-break-marker (make-marker)))
3.1135- (set-marker line-break-marker line-break-point)
3.1136- (set-marker-insertion-type line-break-marker t)
3.1137- (insert (make-string (or n 1) ?\; ))
3.1138- (save-excursion
3.1139- (goto-char line-break-marker)
3.1140- (set-marker line-break-marker nil)
3.1141- (newline)
3.1142- (lisp-indent-line)
3.1143- ;; This step is redundant if we are inside a list, but even if we
3.1144- ;; are at the top level, we want at least to indent whatever we
3.1145- ;; bumped off the line.
3.1146- (paredit-ignore-sexp-errors (indent-sexp))
3.1147- (paredit-indent-sexps))))
3.1148-
3.1149-;;; This is all a horrible, horrible hack, primarily for GNU Emacs 21,
3.1150-;;; in which there is no `comment-or-uncomment-region'.
3.1151-
3.1152-(autoload 'comment-forward "newcomment")
3.1153-(autoload 'comment-normalize-vars "newcomment")
3.1154-(autoload 'comment-region "newcomment")
3.1155-(autoload 'comment-search-forward "newcomment")
3.1156-(autoload 'uncomment-region "newcomment")
3.1157-
3.1158-(defun paredit-initialize-comment-dwim ()
3.1159- (require 'newcomment)
3.1160- (if (not (fboundp 'comment-or-uncomment-region))
3.1161- (defalias 'comment-or-uncomment-region
3.1162- (lambda (beginning end &optional argument)
3.1163- (interactive "*r\nP")
3.1164- (if (save-excursion (goto-char beginning)
3.1165- (comment-forward (point-max))
3.1166- (<= end (point)))
3.1167- (uncomment-region beginning end argument)
3.1168- (comment-region beginning end argument)))))
3.1169- (defalias 'paredit-initialize-comment-dwim 'comment-normalize-vars)
3.1170- (comment-normalize-vars))
3.1171-
3.1172-(defvar paredit-comment-prefix-toplevel ";;; "
3.1173- "String of prefix for top-level comments aligned at the left margin.")
3.1174-
3.1175-(defvar paredit-comment-prefix-code ";; "
3.1176- "String of prefix for comments indented at the same depth as code.")
3.1177-
3.1178-(defvar paredit-comment-prefix-margin ";"
3.1179- "String of prefix for comments on the same line as code in the margin.")
3.1180-
3.1181-(defun paredit-comment-dwim (&optional argument)
3.1182- "Call the Lisp comment command you want (Do What I Mean).
3.1183-This is like `comment-dwim', but it is specialized for Lisp editing.
3.1184-If transient mark mode is enabled and the mark is active, comment or
3.1185- uncomment the selected region, depending on whether it was entirely
3.1186- commented not not already.
3.1187-If there is already a comment on the current line, with no prefix
3.1188- argument, indent to that comment; with a prefix argument, kill that
3.1189- comment.
3.1190-Otherwise, insert a comment appropriate for the context and ensure that
3.1191- any code following the comment is moved to the next line.
3.1192-At the top level, where indentation is calculated to be at column 0,
3.1193- insert a triple-semicolon comment; within code, where the indentation
3.1194- is calculated to be non-zero, and on the line there is either no code
3.1195- at all or code after the point, insert a double-semicolon comment;
3.1196- and if the point is after all code on the line, insert a single-
3.1197- semicolon margin comment at `comment-column'."
3.1198- (interactive "*P")
3.1199- (paredit-initialize-comment-dwim)
3.1200- (cond ((paredit-region-active-p)
3.1201- (comment-or-uncomment-region (region-beginning)
3.1202- (region-end)
3.1203- argument))
3.1204- ((paredit-comment-on-line-p)
3.1205- (if argument
3.1206- (comment-kill (if (integerp argument) argument nil))
3.1207- (comment-indent)))
3.1208- (t (paredit-insert-comment))))
3.1209-
3.1210-(defun paredit-comment-on-line-p ()
3.1211- "True if there is a comment on the line following point.
3.1212-This is expected to be called only in `paredit-comment-dwim'; do not
3.1213- call it elsewhere."
3.1214- (save-excursion
3.1215- (beginning-of-line)
3.1216- (let ((comment-p nil))
3.1217- ;; Search forward for a comment beginning. If there is one, set
3.1218- ;; COMMENT-P to true; if not, it will be nil.
3.1219- (while (progn
3.1220- (setq comment-p ;t -> no error
3.1221- (comment-search-forward (point-at-eol) t))
3.1222- (and comment-p
3.1223- (or (paredit-in-string-p)
3.1224- (paredit-in-char-p (1- (point))))))
3.1225- (forward-char))
3.1226- comment-p)))
3.1227-
3.1228-(defun paredit-insert-comment ()
3.1229- (let ((code-after-p
3.1230- (save-excursion (paredit-skip-whitespace t (point-at-eol))
3.1231- (not (eolp))))
3.1232- (code-before-p
3.1233- (save-excursion (paredit-skip-whitespace nil (point-at-bol))
3.1234- (not (bolp)))))
3.1235- (cond ((and (bolp)
3.1236- (let ((indent
3.1237- (let ((indent (calculate-lisp-indent)))
3.1238- (if (consp indent) (car indent) indent))))
3.1239- (and indent (zerop indent))))
3.1240- ;; Top-level comment
3.1241- (if code-after-p (save-excursion (newline)))
3.1242- (insert paredit-comment-prefix-toplevel))
3.1243- ((or code-after-p (not code-before-p))
3.1244- ;; Code comment
3.1245- (if code-before-p
3.1246- (newline-and-indent)
3.1247- (lisp-indent-line))
3.1248- (insert paredit-comment-prefix-code)
3.1249- (if code-after-p
3.1250- (save-excursion
3.1251- (newline)
3.1252- (lisp-indent-line)
3.1253- (paredit-indent-sexps))))
3.1254- (t
3.1255- ;; Margin comment
3.1256- (indent-to comment-column 1) ; 1 -> force one leading space
3.1257- (insert paredit-comment-prefix-margin)))))
3.1258-
3.1259-;;;; Character Deletion
3.1260-
3.1261-(defun paredit-delete-char (&optional argument)
3.1262- "Delete a character forward or move forward over a delimiter.
3.1263-If on an opening S-expression delimiter, move forward into the
3.1264- S-expression.
3.1265-If on a closing S-expression delimiter, refuse to delete unless the
3.1266- S-expression is empty, in which case delete the whole S-expression.
3.1267-With a numeric prefix argument N, delete N characters forward.
3.1268-With a `C-u' prefix argument, simply delete a character forward,
3.1269- without regard for delimiter balancing.
3.1270-
3.1271-Like `delete-char', ignores `delete-active-region'."
3.1272- (interactive "P")
3.1273- (let ((delete-active-region nil))
3.1274- (paredit-forward-delete argument)))
3.1275-
3.1276-(defun paredit-delete-active-region-p ()
3.1277- "True if the region is active and to be deleted."
3.1278- (and (paredit-region-active-p)
3.1279- (boundp 'delete-active-region)
3.1280- (eq delete-active-region t)))
3.1281-
3.1282-(defun paredit-kill-active-region-p ()
3.1283- "True if the region is active and to be killed."
3.1284- (and (paredit-region-active-p)
3.1285- (boundp 'delete-active-region)
3.1286- (eq delete-active-region 'kill)))
3.1287-
3.1288-(defun paredit-forward-delete (&optional argument)
3.1289- "Delete a character forward or move forward over a delimiter.
3.1290-If on an opening S-expression delimiter, move forward into the
3.1291- S-expression.
3.1292-If on a closing S-expression delimiter, refuse to delete unless the
3.1293- S-expression is empty, in which case delete the whole S-expression.
3.1294-With a numeric prefix argument N, delete N characters forward.
3.1295-With a `C-u' prefix argument, simply delete a character forward,
3.1296- without regard for delimiter balancing.
3.1297-
3.1298-If `delete-active-region' is enabled and the mark is active and
3.1299- no prefix argument is specified, act as `paredit-delete-region'
3.1300- or `paredit-kill-region' as appropriate instead."
3.1301- (interactive "P")
3.1302- (cond ((consp argument)
3.1303- (delete-char +1))
3.1304- ((integerp argument)
3.1305- (let ((delete-active-region nil))
3.1306- (if (< argument 0)
3.1307- (paredit-backward-delete argument)
3.1308- (while (> argument 0)
3.1309- (paredit-forward-delete)
3.1310- (setq argument (- argument 1))))))
3.1311- ((paredit-delete-active-region-p)
3.1312- (paredit-delete-region (region-beginning) (region-end)))
3.1313- ((paredit-kill-active-region-p)
3.1314- (paredit-kill-region (region-beginning) (region-end)))
3.1315- ((eobp)
3.1316- (delete-char +1))
3.1317- ((paredit-in-string-p)
3.1318- (paredit-forward-delete-in-string))
3.1319- ((paredit-in-comment-p)
3.1320- (paredit-forward-delete-in-comment))
3.1321- ((paredit-in-char-p) ; Escape -- delete both chars.
3.1322- (delete-char -1)
3.1323- (delete-char +1))
3.1324- ((eq (char-after) ?\\ ) ; ditto
3.1325- (delete-char +2))
3.1326- ((let ((syn (char-syntax (char-after))))
3.1327- (or (eq syn ?\( )
3.1328- (eq syn ?\" )))
3.1329- (if (save-excursion
3.1330- (paredit-handle-sexp-errors (progn (forward-sexp) t)
3.1331- nil))
3.1332- (forward-char)
3.1333- (message "Deleting spurious opening delimiter.")
3.1334- (delete-char +1)))
3.1335- ((and (not (paredit-in-char-p (1- (point))))
3.1336- (eq (char-syntax (char-after)) ?\) )
3.1337- (eq (char-before) (matching-paren (char-after))))
3.1338- (delete-char -1) ; Empty list -- delete both
3.1339- (delete-char +1)) ; delimiters.
3.1340- ((eq ?\; (char-after))
3.1341- (paredit-forward-delete-comment-start))
3.1342- ((eq (char-syntax (char-after)) ?\) )
3.1343- (if (paredit-handle-sexp-errors
3.1344- (save-excursion (forward-char) (backward-sexp) t)
3.1345- nil)
3.1346- (message "End of list!")
3.1347- (progn
3.1348- (message "Deleting spurious closing delimiter.")
3.1349- (delete-char +1))))
3.1350- ;; Just delete a single character, if it's not a closing
3.1351- ;; delimiter. (The character literal case is already handled
3.1352- ;; by now.)
3.1353- (t (delete-char +1))))
3.1354-
3.1355-(defun paredit-forward-delete-in-string ()
3.1356- (let ((start+end (paredit-string-start+end-points)))
3.1357- (cond ((not (eq (point) (cdr start+end)))
3.1358- ;; If it's not the close-quote, it's safe to delete. But
3.1359- ;; first handle the case that we're in a string escape.
3.1360- (cond ((paredit-in-string-escape-p)
3.1361- ;; We're right after the backslash, so backward
3.1362- ;; delete it before deleting the escaped character.
3.1363- (delete-char -1))
3.1364- ((eq (char-after) ?\\ )
3.1365- ;; If we're not in a string escape, but we are on a
3.1366- ;; backslash, it must start the escape for the next
3.1367- ;; character, so delete the backslash before deleting
3.1368- ;; the next character.
3.1369- (delete-char +1)))
3.1370- (delete-char +1))
3.1371- ((eq (1- (point)) (car start+end))
3.1372- ;; If it is the close-quote, delete only if we're also right
3.1373- ;; past the open-quote (i.e. it's empty), and then delete
3.1374- ;; both quotes. Otherwise we refuse to delete it.
3.1375- (delete-char -1)
3.1376- (delete-char +1)))))
3.1377-
3.1378-(defun paredit-check-forward-delete-in-comment ()
3.1379- ;; Point is in a comment, possibly at eol. We are about to delete
3.1380- ;; some characters forward; if we are at eol, we are about to delete
3.1381- ;; the line break. Refuse to do so if if moving the next line into
3.1382- ;; the comment would break structure.
3.1383- (if (eolp)
3.1384- (let ((next-line-start (point-at-bol 2))
3.1385- (next-line-end (point-at-eol 2)))
3.1386- (paredit-check-region next-line-start next-line-end))))
3.1387-
3.1388-(defun paredit-forward-delete-in-comment ()
3.1389- (paredit-check-forward-delete-in-comment)
3.1390- (delete-char +1))
3.1391-
3.1392-(defun paredit-forward-delete-comment-start ()
3.1393- ;; Point precedes a comment start (not at eol). Refuse to delete a
3.1394- ;; comment start if the comment contains unbalanced junk.
3.1395- (paredit-check-region (+ (point) 1) (point-at-eol))
3.1396- (delete-char +1))
3.1397-
3.1398-(defun paredit-backward-delete (&optional argument)
3.1399- "Delete a character backward or move backward over a delimiter.
3.1400-If on a closing S-expression delimiter, move backward into the
3.1401- S-expression.
3.1402-If on an opening S-expression delimiter, refuse to delete unless the
3.1403- S-expression is empty, in which case delete the whole S-expression.
3.1404-With a numeric prefix argument N, delete N characters backward.
3.1405-With a `C-u' prefix argument, simply delete a character backward,
3.1406- without regard for delimiter balancing.
3.1407-
3.1408-If `delete-active-region' is enabled and the mark is active and
3.1409- no prefix argument is specified, act as `paredit-delete-region'
3.1410- or `paredit-kill-region' as appropriate instead."
3.1411- (interactive "P")
3.1412- (cond ((consp argument)
3.1413- ;++ Should this untabify?
3.1414- (delete-char -1))
3.1415- ((integerp argument)
3.1416- (let ((delete-active-region nil))
3.1417- (if (< argument 0)
3.1418- (paredit-forward-delete (- 0 argument))
3.1419- (while (> argument 0)
3.1420- (paredit-backward-delete)
3.1421- (setq argument (- argument 1))))))
3.1422- ((paredit-delete-active-region-p)
3.1423- (paredit-delete-region (region-beginning) (region-end)))
3.1424- ((paredit-kill-active-region-p)
3.1425- (paredit-kill-region (region-beginning) (region-end)))
3.1426- ((bobp)
3.1427- (delete-char -1))
3.1428- ((paredit-in-string-p)
3.1429- (paredit-backward-delete-in-string))
3.1430- ((paredit-in-comment-p)
3.1431- (paredit-backward-delete-in-comment))
3.1432- ((paredit-in-char-p) ; Escape -- delete both chars.
3.1433- (delete-char -1)
3.1434- (delete-char +1))
3.1435- ((paredit-in-char-p (1- (point)))
3.1436- (delete-char -2)) ; ditto
3.1437- ((let ((syn (char-syntax (char-before))))
3.1438- (or (eq syn ?\) )
3.1439- (eq syn ?\" )))
3.1440- (if (save-excursion
3.1441- (paredit-handle-sexp-errors (progn (backward-sexp) t)
3.1442- nil))
3.1443- (backward-char)
3.1444- (message "Deleting spurious closing delimiter.")
3.1445- (delete-char -1)))
3.1446- ((and (eq (char-syntax (char-before)) ?\( )
3.1447- (eq (char-after) (matching-paren (char-before))))
3.1448- (delete-char -1) ; Empty list -- delete both
3.1449- (delete-char +1)) ; delimiters.
3.1450- ((bolp)
3.1451- (paredit-backward-delete-maybe-comment-end))
3.1452- ((eq (char-syntax (char-before)) ?\( )
3.1453- (if (paredit-handle-sexp-errors
3.1454- (save-excursion (backward-char) (forward-sexp) t)
3.1455- nil)
3.1456- (message "Beginning of list!")
3.1457- (progn
3.1458- (message "Deleting spurious closing delimiter.")
3.1459- (delete-char -1))))
3.1460- ;; Delete it, unless it's an opening delimiter. The case of
3.1461- ;; character literals is already handled by now.
3.1462- (t
3.1463- ;; Turn off the @#&*&!^&(%^ botch in GNU Emacs 24 that changed
3.1464- ;; `backward-delete-char' and `backward-delete-char-untabify'
3.1465- ;; semantically so that they delete the region in transient
3.1466- ;; mark mode.
3.1467- (let ((delete-active-region nil))
3.1468- (backward-delete-char-untabify +1)))))
3.1469-
3.1470-(defun paredit-backward-delete-in-string ()
3.1471- (let ((start+end (paredit-string-start+end-points)))
3.1472- (cond ((not (eq (1- (point)) (car start+end)))
3.1473- ;; If it's not the open-quote, it's safe to delete.
3.1474- (if (paredit-in-string-escape-p)
3.1475- ;; If we're on a string escape, since we're about to
3.1476- ;; delete the backslash, we must first delete the
3.1477- ;; escaped char.
3.1478- (delete-char +1))
3.1479- (delete-char -1)
3.1480- (if (paredit-in-string-escape-p)
3.1481- ;; If, after deleting a character, we find ourselves in
3.1482- ;; a string escape, we must have deleted the escaped
3.1483- ;; character, and the backslash is behind the point, so
3.1484- ;; backward delete it.
3.1485- (delete-char -1)))
3.1486- ((eq (point) (cdr start+end))
3.1487- ;; If it is the open-quote, delete only if we're also right
3.1488- ;; past the close-quote (i.e. it's empty), and then delete
3.1489- ;; both quotes. Otherwise we refuse to delete it.
3.1490- (delete-char -1)
3.1491- (delete-char +1)))))
3.1492-
3.1493-(defun paredit-backward-delete-in-comment ()
3.1494- ;; Point is in a comment, possibly just after the comment start.
3.1495- ;; Refuse to delete a comment start if the comment contains
3.1496- ;; unbalanced junk.
3.1497- (if (save-excursion
3.1498- (backward-char)
3.1499- ;; Must call `paredit-in-string-p' before
3.1500- ;; `paredit-in-comment-p'.
3.1501- (not (or (paredit-in-string-p) (paredit-in-comment-p))))
3.1502- (paredit-check-region (point) (point-at-eol)))
3.1503- (backward-delete-char-untabify +1))
3.1504-
3.1505-(defun paredit-backward-delete-maybe-comment-end ()
3.1506- ;; Point is at bol, possibly just after a comment end (i.e., the
3.1507- ;; previous line may have had a line comment). Refuse to delete a
3.1508- ;; comment end if moving the current line into the previous line's
3.1509- ;; comment would break structure.
3.1510- (if (save-excursion
3.1511- (backward-char)
3.1512- (and (not (paredit-in-string-p)) (paredit-in-comment-p)))
3.1513- (paredit-check-region (point-at-eol) (point-at-bol)))
3.1514- (delete-char -1))
3.1515-
3.1516-;;;; Killing
3.1517-
3.1518-(defun paredit-kill (&optional argument)
3.1519- "Kill a line as if with `kill-line', but respecting delimiters.
3.1520-In a string, act exactly as `kill-line' but do not kill past the
3.1521- closing string delimiter.
3.1522-On a line with no S-expressions on it starting after the point or
3.1523- within a comment, act exactly as `kill-line'.
3.1524-Otherwise, kill all S-expressions that start after the point.
3.1525-With a `C-u' prefix argument, just do the standard `kill-line'.
3.1526-With a numeric prefix argument N, do `kill-line' that many times.
3.1527-
3.1528-If `kill-whole-line' is true, kills the newline character and
3.1529- indentation on the next line as well.
3.1530-In that case, ensure there is at least one space between the
3.1531- preceding S-expression and whatever follows on the next line."
3.1532- (interactive "P")
3.1533- (cond (argument
3.1534- (kill-line (if (integerp argument) argument 1)))
3.1535- ((paredit-in-string-p)
3.1536- (paredit-kill-line-in-string))
3.1537- ((paredit-in-comment-p)
3.1538- (paredit-kill-line-in-comment))
3.1539- ((save-excursion (paredit-skip-whitespace t (point-at-eol))
3.1540- (or (eolp) (eq (char-after) ?\; )))
3.1541- ;** Be careful about trailing backslashes.
3.1542- (if (paredit-in-char-p)
3.1543- (backward-char))
3.1544- (kill-line))
3.1545- (t (paredit-kill-sexps-on-line))))
3.1546-
3.1547-(defun paredit-kill-line-in-string ()
3.1548- (if (save-excursion (paredit-skip-whitespace t (point-at-eol))
3.1549- (eolp))
3.1550- (kill-line)
3.1551- (save-excursion
3.1552- ;; Be careful not to split an escape sequence.
3.1553- (if (paredit-in-string-escape-p)
3.1554- (backward-char))
3.1555- (kill-region (point)
3.1556- (min (point-at-eol)
3.1557- (cdr (paredit-string-start+end-points)))))))
3.1558-
3.1559-(defun paredit-kill-line-in-comment ()
3.1560- ;; The variable `kill-whole-line' is not relevant: the point is in a
3.1561- ;; comment, and hence not at the beginning of the line.
3.1562- (paredit-check-forward-delete-in-comment)
3.1563- (kill-line))
3.1564-
3.1565-(defun paredit-kill-sexps-on-line ()
3.1566- (if (paredit-in-char-p) ; Move past the \ and prefix.
3.1567- (backward-char 2)) ; (# in Scheme/CL, ? in elisp)
3.1568- (let ((beginning (point))
3.1569- (eol (point-at-eol)))
3.1570- (let ((end-of-list-p (paredit-forward-sexps-to-kill beginning eol)))
3.1571- ;; If we got to the end of the list and it's on the same line,
3.1572- ;; move backward past the closing delimiter before killing. (This
3.1573- ;; allows something like killing the whitespace in ( ).)
3.1574- (if end-of-list-p (progn (up-list) (backward-char)))
3.1575- (if kill-whole-line
3.1576- (paredit-kill-sexps-on-whole-line beginning)
3.1577- (kill-region beginning
3.1578- ;; If all of the S-expressions were on one line,
3.1579- ;; i.e. we're still on that line after moving past
3.1580- ;; the last one, kill the whole line, including
3.1581- ;; any comments; otherwise just kill to the end of
3.1582- ;; the last S-expression we found. Be sure,
3.1583- ;; though, not to kill any closing parentheses.
3.1584- (if (and (not end-of-list-p)
3.1585- (eq (point-at-eol) eol))
3.1586- eol
3.1587- (point)))))))
3.1588-
3.1589-;;; Move to the end of the last S-expression that started on this line,
3.1590-;;; or to the closing delimiter if the last S-expression in this list
3.1591-;;; and the closing delimiter both lie on this line. Return true if
3.1592-;;; the closing delimiter of this list is on this line, false if not.
3.1593-;;;
3.1594-;;; beginning is (point), and eol is (point-at-eol). Handling of
3.1595-;;; `kill-whole-line' is trick, and probably kind of broken.
3.1596-
3.1597-(defun paredit-forward-sexps-to-kill (beginning eol)
3.1598- (let ((end-of-list-p nil) ;Have we hit a closing delimiter on this line?
3.1599- (firstp t)) ;Is this still the first line?
3.1600- (catch 'return
3.1601- (while t
3.1602- ;; This and the `kill-whole-line' business below fix a bug that
3.1603- ;; inhibited any S-expression at the very end of the buffer
3.1604- ;; (with no trailing newline) from being deleted. It's a
3.1605- ;; bizarre fix that I ought to document at some point, but I am
3.1606- ;; too busy at the moment to do so.
3.1607- (if (and kill-whole-line (eobp)) (throw 'return nil))
3.1608- ;; See if we can move forward, and stay on an S-expression that
3.1609- ;; started on this line.
3.1610- (save-excursion
3.1611- (paredit-handle-sexp-errors (forward-sexp)
3.1612- ;; Can't move forward -- we must have hit the end of a
3.1613- ;; list. Stop here, but record whether the closing
3.1614- ;; delimiter occurred on the starting line.
3.1615- (up-list)
3.1616- (setq end-of-list-p (eq (point-at-eol) eol))
3.1617- (throw 'return nil))
3.1618- ;; We can move forward. Where did we move to? Stop if:
3.1619- ;;
3.1620- ;; (a) we hit the end of the buffer in certain circumstances
3.1621- ;; (XXX why are these circumstances? necessary according
3.1622- ;; to tests, need explanation), because forward-sexp
3.1623- ;; didn't/won't make any progress and we'll get stuck in
3.1624- ;; a loop; or
3.1625- ;;
3.1626- ;; (b) the S-expression we moved to the end to actually
3.1627- ;; started on line after where we started so it's not
3.1628- ;; under our jurisdiction.
3.1629- (if (or (and (not firstp) ;(a)
3.1630- (not kill-whole-line)
3.1631- (eobp))
3.1632- (paredit-handle-sexp-errors ;(b)
3.1633- (progn (backward-sexp) nil)
3.1634- t)
3.1635- (not (eq (point-at-eol) eol)))
3.1636- (throw 'return nil)))
3.1637- ;; Determined we can and should move forward. Do so.
3.1638- (forward-sexp)
3.1639- ;; In certain other circumstances (XXX need explanation), if we
3.1640- ;; hit the end of the buffer, stop here; otherwise the next
3.1641- ;; forward-sexp will fail to make progress and we might get
3.1642- ;; stuck in a loop.
3.1643- (if (and firstp
3.1644- (not kill-whole-line)
3.1645- (eobp))
3.1646- (throw 'return nil))
3.1647- ;; We have made it past one S-expression.
3.1648- (setq firstp nil)))
3.1649- end-of-list-p))
3.1650-
3.1651-;;; Handle the actual kill when `kill-whole-line' is enabled.
3.1652-;;;
3.1653-;;; XXX This has various broken edge cases (see the xfails in test.el)
3.1654-;;; and it doesn't make paredit-kill/yank a noop on round-trip, in an
3.1655-;;; attempt to avoid inadvertently joining S-expressions when it
3.1656-;;; deletes the newline. It could use some input and logic from a user
3.1657-;;; who relies on `kill-whole-line' and has a better sense of
3.1658-;;; expectations.
3.1659-
3.1660-(defun paredit-kill-sexps-on-whole-line (beginning)
3.1661- (kill-region beginning
3.1662- (or (save-excursion ; Delete trailing indentation...
3.1663- (paredit-skip-whitespace t)
3.1664- (and (not (eq (char-after) ?\; ))
3.1665- (point)))
3.1666- ;; ...or just use the point past the newline, if
3.1667- ;; we encounter a comment.
3.1668- (point-at-eol)))
3.1669- (cond ((save-excursion (paredit-skip-whitespace nil (point-at-bol))
3.1670- (bolp))
3.1671- ;; Nothing but indentation before the point, so indent it.
3.1672- (lisp-indent-line))
3.1673- ((eobp) nil) ; Protect the CHAR-SYNTAX below against NIL.
3.1674- ;; Insert a space to avoid invalid joining if necessary.
3.1675- ((let ((syn-before (char-syntax (char-before)))
3.1676- (syn-after (char-syntax (char-after))))
3.1677- (and (memq syn-before '(?\) ?\" ?_ ?w))
3.1678- (memq syn-after '(?\( ?\" ?_ ?w))))
3.1679- (save-excursion (insert " ")))))
3.1680-
3.1681-;;;;; Killing Words
3.1682-
3.1683-;;; This is tricky and asymmetrical because backward parsing is
3.1684-;;; extraordinarily difficult or impossible, so we have to implement
3.1685-;;; killing in both directions by parsing forward.
3.1686-
3.1687-(defun paredit-forward-kill-word (&optional argument)
3.1688- "Kill a word forward, skipping over intervening delimiters."
3.1689- (interactive "p")
3.1690- (let ((argument (or argument 1)))
3.1691- (if (< argument 0)
3.1692- (paredit-backward-kill-word (- argument))
3.1693- (dotimes (i argument)
3.1694- (let ((beginning (point)))
3.1695- (skip-syntax-forward " -")
3.1696- (let* ((parse-state (paredit-current-parse-state))
3.1697- (state (paredit-kill-word-state parse-state 'char-after)))
3.1698- (while (not (or (eobp)
3.1699- (eq ?w (char-syntax (char-after)))))
3.1700- (setq parse-state
3.1701- (progn (forward-char 1) (paredit-current-parse-state))
3.1702- ;; XXX Why did I comment this out?
3.1703- ;; (parse-partial-sexp (point) (1+ (point))
3.1704- ;; nil nil parse-state)
3.1705- )
3.1706- (let* ((old-state state)
3.1707- (new-state
3.1708- (paredit-kill-word-state parse-state 'char-after)))
3.1709- (cond ((not (eq old-state new-state))
3.1710- (setq parse-state
3.1711- (paredit-kill-word-hack old-state
3.1712- new-state
3.1713- parse-state))
3.1714- (setq state
3.1715- (paredit-kill-word-state parse-state
3.1716- 'char-after))
3.1717- (setq beginning (point)))))))
3.1718- (goto-char beginning)
3.1719- (kill-word 1))))))
3.1720-
3.1721-(defun paredit-backward-kill-word (&optional argument)
3.1722- "Kill a word backward, skipping over any intervening delimiters."
3.1723- (interactive "p")
3.1724- (let ((argument (or argument 1)))
3.1725- (if (< argument 0)
3.1726- (paredit-forward-kill-word (- argument))
3.1727- (dotimes (i argument)
3.1728- (if (not (or (bobp)
3.1729- (eq (char-syntax (char-before)) ?w)))
3.1730- (let ((end (point)))
3.1731- (backward-word 1)
3.1732- (forward-word 1)
3.1733- (goto-char (min end (point)))
3.1734- (let* ((parse-state (paredit-current-parse-state))
3.1735- (state
3.1736- (paredit-kill-word-state parse-state 'char-before)))
3.1737- (while (and (< (point) end)
3.1738- (progn
3.1739- (setq parse-state
3.1740- (parse-partial-sexp (point) (1+ (point))
3.1741- nil nil parse-state))
3.1742- (or (eq state
3.1743- (paredit-kill-word-state parse-state
3.1744- 'char-before))
3.1745- (progn (backward-char 1) nil)))))
3.1746- (if (and (eq state 'comment)
3.1747- (eq ?\# (char-after (point)))
3.1748- (eq ?\| (char-before (point))))
3.1749- (backward-char 1)))))
3.1750- (backward-kill-word 1)))))
3.1751-
3.1752-;;;;;; Word-Killing Auxiliaries
3.1753-
3.1754-(defun paredit-kill-word-state (parse-state adjacent-char-fn)
3.1755- (cond ((paredit-in-comment-p parse-state) 'comment)
3.1756- ((paredit-in-string-p parse-state) 'string)
3.1757- ((memq (char-syntax (funcall adjacent-char-fn))
3.1758- '(?\( ?\) ))
3.1759- 'delimiter)
3.1760- (t 'other)))
3.1761-
3.1762-;;; This optionally advances the point past any comment delimiters that
3.1763-;;; should probably not be touched, based on the last state change and
3.1764-;;; the characters around the point. It returns a new parse state,
3.1765-;;; starting from the PARSE-STATE parameter.
3.1766-
3.1767-(defun paredit-kill-word-hack (old-state new-state parse-state)
3.1768- (cond ((and (not (eq old-state 'comment))
3.1769- (not (eq new-state 'comment))
3.1770- (not (paredit-in-string-escape-p))
3.1771- (eq ?\# (char-before))
3.1772- (eq ?\| (char-after)))
3.1773- (forward-char 1)
3.1774- (paredit-current-parse-state)
3.1775-;; (parse-partial-sexp (point) (1+ (point))
3.1776-;; nil nil parse-state)
3.1777- )
3.1778- ((and (not (eq old-state 'comment))
3.1779- (eq new-state 'comment)
3.1780- (eq ?\; (char-before)))
3.1781- (skip-chars-forward ";")
3.1782- (paredit-current-parse-state)
3.1783-;; (parse-partial-sexp (point) (save-excursion
3.1784-;; (skip-chars-forward ";"))
3.1785-;; nil nil parse-state)
3.1786- )
3.1787- (t parse-state)))
3.1788-
3.1789-(defun paredit-copy-as-kill ()
3.1790- "Save in the kill ring the region that `paredit-kill' would kill."
3.1791- (interactive)
3.1792- (cond ((paredit-in-string-p)
3.1793- (paredit-copy-as-kill-in-string))
3.1794- ((paredit-in-comment-p)
3.1795- (copy-region-as-kill (point) (point-at-eol)))
3.1796- ((save-excursion (paredit-skip-whitespace t (point-at-eol))
3.1797- (or (eolp) (eq (char-after) ?\; )))
3.1798- ;** Be careful about trailing backslashes.
3.1799- (save-excursion
3.1800- (if (paredit-in-char-p)
3.1801- (backward-char))
3.1802- (copy-region-as-kill (point) (point-at-eol))))
3.1803- (t (paredit-copy-sexps-as-kill))))
3.1804-
3.1805-(defun paredit-copy-as-kill-in-string ()
3.1806- (save-excursion
3.1807- (if (paredit-in-string-escape-p)
3.1808- (backward-char))
3.1809- (copy-region-as-kill (point)
3.1810- (min (point-at-eol)
3.1811- (cdr (paredit-string-start+end-points))))))
3.1812-
3.1813-(defun paredit-copy-sexps-as-kill ()
3.1814- (save-excursion
3.1815- (if (paredit-in-char-p)
3.1816- (backward-char 2))
3.1817- (let ((beginning (point))
3.1818- (eol (point-at-eol)))
3.1819- (let ((end-of-list-p (paredit-forward-sexps-to-kill beginning eol)))
3.1820- (if end-of-list-p (progn (up-list) (backward-char)))
3.1821- (copy-region-as-kill beginning
3.1822- (cond (kill-whole-line
3.1823- (or (save-excursion
3.1824- (paredit-skip-whitespace t)
3.1825- (and (not (eq (char-after) ?\; ))
3.1826- (point)))
3.1827- (point-at-eol)))
3.1828- ((and (not end-of-list-p)
3.1829- (eq (point-at-eol) eol))
3.1830- eol)
3.1831- (t
3.1832- (point))))))))
3.1833-
3.1834-;;;; Deleting Regions
3.1835-
3.1836-(defun paredit-delete-region (start end)
3.1837- "Delete the text between point and mark, like `delete-region'.
3.1838-If that text is unbalanced, signal an error instead.
3.1839-With a prefix argument, skip the balance check."
3.1840- (interactive "r")
3.1841- (if (and start end (not current-prefix-arg))
3.1842- (paredit-check-region-for-delete start end))
3.1843- (setq this-command 'delete-region)
3.1844- (delete-region start end))
3.1845-
3.1846-(defun paredit-kill-region (start end)
3.1847- "Kill the text between point and mark, like `kill-region'.
3.1848-If that text is unbalanced, signal an error instead.
3.1849-With a prefix argument, skip the balance check."
3.1850- (interactive "r")
3.1851- (if (and start end (not current-prefix-arg))
3.1852- (paredit-check-region-for-delete start end))
3.1853- (setq this-command 'kill-region)
3.1854- (kill-region start end))
3.1855-
3.1856-(defun paredit-check-region-for-delete (start end)
3.1857- "Signal an error deleting text between START and END is unsafe."
3.1858- (save-excursion
3.1859- (goto-char start)
3.1860- (let* ((start-state (paredit-current-parse-state))
3.1861- (end-state (parse-partial-sexp start end nil nil start-state)))
3.1862- (paredit-check-region-for-delete:depth start start-state end end-state)
3.1863- (paredit-check-region-for-delete:string start start-state end end-state)
3.1864- (paredit-check-region-for-delete:comment start start-state end end-state)
3.1865- (paredit-check-region-for-delete:char-quote start start-state
3.1866- end end-state))))
3.1867-
3.1868-(defun paredit-check-region-for-delete:depth (start start-state end end-state)
3.1869- (let ((start-depth (nth 0 start-state))
3.1870- (end-depth (nth 0 end-state)))
3.1871- (if (not (= start-depth end-depth))
3.1872- (error "Mismatched parenthesis depth: %S at start, %S at end."
3.1873- start-depth
3.1874- end-depth))))
3.1875-
3.1876-(defun paredit-check-region-for-delete:string (start start-state end end-state)
3.1877- (let ((start-string-p (nth 3 start-state))
3.1878- (end-string-p (nth 3 end-state)))
3.1879- (if (not (eq start-string-p end-string-p))
3.1880- (error "Mismatched string state: start %sin string, end %sin string."
3.1881- (if start-string-p "" "not ")
3.1882- (if end-string-p "" "not ")))))
3.1883-
3.1884-(defun paredit-check-region-for-delete:comment
3.1885- (start start-state end end-state)
3.1886- (let ((start-comment-state (nth 4 start-state))
3.1887- (end-comment-state (nth 4 end-state)))
3.1888- (if (not (or (eq start-comment-state end-comment-state)
3.1889- ;; If we are moving text into or out of a line
3.1890- ;; comment, make sure that the text is balanced. (The
3.1891- ;; comment state may be a number, not t or nil at all,
3.1892- ;; for nestable comments, which are not handled by
3.1893- ;; this heuristic (or any of paredit, really).)
3.1894- (and (or (and (eq start-comment-state nil)
3.1895- (eq end-comment-state t))
3.1896- (and (eq start-comment-state t)
3.1897- (eq end-comment-state nil)))
3.1898- (save-excursion
3.1899- (goto-char end)
3.1900- (paredit-region-ok-p (point) (point-at-eol))))))
3.1901- (error "Mismatched comment state: %s"
3.1902- (cond ((and (integerp start-comment-state)
3.1903- (integerp end-comment-state))
3.1904- (format "depth %S at start, depth %S at end."
3.1905- start-comment-state
3.1906- end-comment-state))
3.1907- ((integerp start-comment-state)
3.1908- "start in nested comment, end otherwise.")
3.1909- ((integerp end-comment-state)
3.1910- "end in nested comment, start otherwise.")
3.1911- (start-comment-state
3.1912- "start in comment, end not in comment.")
3.1913- (end-comment-state
3.1914- "end in comment, start not in comment.")
3.1915- (t
3.1916- (format "start %S, end %S."
3.1917- start-comment-state
3.1918- end-comment-state)))))))
3.1919-
3.1920-(defun paredit-check-region-for-delete:char-quote
3.1921- (start start-state end end-state)
3.1922- (let ((start-char-quote (nth 5 start-state))
3.1923- (end-char-quote (nth 5 end-state)))
3.1924- (if (not (eq start-char-quote end-char-quote))
3.1925- (let ((phrase "character quotation"))
3.1926- (error "Mismatched %s: start %sin %s, end %sin %s."
3.1927- phrase
3.1928- (if start-char-quote "" "not ")
3.1929- phrase
3.1930- (if end-char-quote "" "not ")
3.1931- phrase)))))
3.1932-
3.1933-;;;; Point Motion
3.1934-
3.1935-(eval-and-compile
3.1936- (defmacro defun-motion (name bvl doc &rest body)
3.1937- `(defun ,name ,bvl
3.1938- ,doc
3.1939- ,(xcond ((paredit-xemacs-p)
3.1940- '(interactive "_"))
3.1941- ((paredit-gnu-emacs-p)
3.1942- ;++ Not sure this is sufficient for the `^'.
3.1943- (if (fboundp 'handle-shift-selection)
3.1944- '(interactive "^p")
3.1945- '(interactive "p"))))
3.1946- ,@body)))
3.1947-
3.1948-(defun-motion paredit-forward (&optional arg)
3.1949- "Move forward an S-expression, or up an S-expression forward.
3.1950-If there are no more S-expressions in this one before the closing
3.1951- delimiter, move past that closing delimiter; otherwise, move forward
3.1952- past the S-expression following the point."
3.1953- (let ((n (or arg 1)))
3.1954- (cond ((< 0 n) (dotimes (i n) (paredit-move-forward)))
3.1955- ((< n 0) (dotimes (i (- n)) (paredit-move-backward))))))
3.1956-
3.1957-(defun-motion paredit-backward (&optional arg)
3.1958- "Move backward an S-expression, or up an S-expression backward.
3.1959-If there are no more S-expressions in this one before the opening
3.1960- delimiter, move past that opening delimiter backward; otherwise,
3.1961- move backward past the S-expression preceding the point."
3.1962- (let ((n (or arg 1)))
3.1963- (cond ((< 0 n) (dotimes (i n) (paredit-move-backward)))
3.1964- ((< n 0) (dotimes (i (- n)) (paredit-move-forward))))))
3.1965-
3.1966-(defun paredit-move-forward ()
3.1967- (cond ((paredit-in-string-p)
3.1968- (let ((end (paredit-enclosing-string-end)))
3.1969- ;; `forward-sexp' and `up-list' may move into the next string
3.1970- ;; in the buffer. Don't do that; move out of the current one.
3.1971- (if (paredit-handle-sexp-errors
3.1972- (progn (paredit-handle-sexp-errors (forward-sexp)
3.1973- (up-list))
3.1974- (<= end (point)))
3.1975- t)
3.1976- (goto-char end))))
3.1977- ((paredit-in-char-p)
3.1978- (forward-char))
3.1979- (t
3.1980- (paredit-handle-sexp-errors (forward-sexp)
3.1981- (up-list)))))
3.1982-
3.1983-(defun paredit-move-backward ()
3.1984- (cond ((paredit-in-string-p)
3.1985- (let ((start (paredit-enclosing-string-start)))
3.1986- (if (paredit-handle-sexp-errors
3.1987- (progn (paredit-handle-sexp-errors (backward-sexp)
3.1988- (backward-up-list))
3.1989- (<= (point) start))
3.1990- t)
3.1991- (goto-char start))))
3.1992- ((paredit-in-char-p)
3.1993- ;++ Corner case: a buffer of `\|x'. What to do?
3.1994- (backward-char 2))
3.1995- (t
3.1996- (paredit-handle-sexp-errors (backward-sexp)
3.1997- (backward-up-list)))))
3.1998-
3.1999-;;;; Window Positioning
3.2000-
3.2001-(defalias 'paredit-recentre-on-sexp 'paredit-recenter-on-sexp)
3.2002-
3.2003-(defun paredit-recenter-on-sexp (&optional n)
3.2004- "Recenter the screen on the S-expression following the point.
3.2005-With a prefix argument N, encompass all N S-expressions forward."
3.2006- (interactive "P")
3.2007- (let* ((p (point))
3.2008- (end-point (progn (forward-sexp n) (point)))
3.2009- (start-point (progn (goto-char end-point) (backward-sexp n) (point))))
3.2010- ;; Point is at beginning of first S-expression.
3.2011- (let ((p-visible nil) (start-visible nil))
3.2012- (save-excursion
3.2013- (forward-line (/ (count-lines start-point end-point) 2))
3.2014- (recenter)
3.2015- (setq p-visible (pos-visible-in-window-p p))
3.2016- (setq start-visible (pos-visible-in-window-p start-point)))
3.2017- (cond ((not start-visible)
3.2018- ;; Implies (not p-visible). Put the start at the top of
3.2019- ;; the screen.
3.2020- (recenter 0))
3.2021- (p-visible
3.2022- ;; Go back to p if we can.
3.2023- (goto-char p))))))
3.2024-
3.2025-(defun paredit-recenter-on-defun ()
3.2026- "Recenter the screen on the definition at point."
3.2027- (interactive)
3.2028- (save-excursion
3.2029- (beginning-of-defun)
3.2030- (paredit-recenter-on-sexp)))
3.2031-
3.2032-(defun paredit-focus-on-defun ()
3.2033- "Moves display to the top of the definition at point."
3.2034- (interactive)
3.2035- (beginning-of-defun)
3.2036- (recenter 0))
3.2037-
3.2038-;;;; Generalized Upward/Downward Motion
3.2039-
3.2040-(defun paredit-up/down (n vertical-direction)
3.2041- (let ((horizontal-direction (if (< 0 n) +1 -1)))
3.2042- (while (/= n 0)
3.2043- (goto-char
3.2044- (paredit-next-up/down-point horizontal-direction vertical-direction))
3.2045- (setq n (- n horizontal-direction)))))
3.2046-
3.2047-(defun paredit-next-up/down-point (horizontal-direction vertical-direction)
3.2048- (let ((state (paredit-current-parse-state))
3.2049- (scan-lists
3.2050- (lambda ()
3.2051- (scan-lists (point) horizontal-direction vertical-direction))))
3.2052- (cond ((paredit-in-string-p state)
3.2053- (let ((start+end (paredit-string-start+end-points state)))
3.2054- (if (< 0 vertical-direction)
3.2055- (if (< 0 horizontal-direction)
3.2056- (+ 1 (cdr start+end))
3.2057- (car start+end))
3.2058- ;; We could let the user try to descend into lists
3.2059- ;; within the string, but that would be asymmetric
3.2060- ;; with the up case, which rises out of the whole
3.2061- ;; string and not just out of a list within the
3.2062- ;; string, so this case will just be an error.
3.2063- (error "Can't descend further into string."))))
3.2064- ((< 0 vertical-direction)
3.2065- ;; When moving up, just try to rise up out of the list.
3.2066- (or (funcall scan-lists)
3.2067- (buffer-end horizontal-direction)))
3.2068- ((< vertical-direction 0)
3.2069- ;; When moving down, look for a string closer than a list,
3.2070- ;; and use that if we find it.
3.2071- (let* ((list-start
3.2072- (paredit-handle-sexp-errors (funcall scan-lists) nil))
3.2073- (string-start
3.2074- (paredit-find-next-string-start horizontal-direction
3.2075- list-start)))
3.2076- (if (and string-start list-start)
3.2077- (if (< 0 horizontal-direction)
3.2078- (min string-start list-start)
3.2079- (max string-start list-start))
3.2080- (or string-start
3.2081- ;; Scan again: this is a kludgey way to report the
3.2082- ;; error if there really was one.
3.2083- (funcall scan-lists)
3.2084- (buffer-end horizontal-direction)))))
3.2085- (t
3.2086- (error "Vertical direction must be nonzero in `%s'."
3.2087- 'paredit-up/down)))))
3.2088-
3.2089-(defun paredit-find-next-string-start (horizontal-direction limit)
3.2090- (let ((buffer-limit-p (if (< 0 horizontal-direction) 'eobp 'bobp))
3.2091- (next-char (if (< 0 horizontal-direction) 'char-after 'char-before))
3.2092- (pastp (if (< 0 horizontal-direction) '> '<)))
3.2093- (paredit-handle-sexp-errors
3.2094- (save-excursion
3.2095- (catch 'exit
3.2096- (while t
3.2097- (if (or (funcall buffer-limit-p)
3.2098- (and limit (funcall pastp (point) limit)))
3.2099- (throw 'exit nil))
3.2100- (forward-sexp horizontal-direction)
3.2101- (save-excursion
3.2102- (backward-sexp horizontal-direction)
3.2103- (if (eq ?\" (char-syntax (funcall next-char)))
3.2104- (throw 'exit (+ (point) horizontal-direction)))))))
3.2105- nil)))
3.2106-
3.2107-(defun-motion paredit-forward-down (&optional argument)
3.2108- "Move forward down into a list.
3.2109-With a positive argument, move forward down that many levels.
3.2110-With a negative argument, move backward down that many levels."
3.2111- (paredit-up/down (or argument +1) -1))
3.2112-
3.2113-(defun-motion paredit-backward-up (&optional argument)
3.2114- "Move backward up out of the enclosing list.
3.2115-With a positive argument, move backward up that many levels.
3.2116-With a negative argument, move forward up that many levels.
3.2117-If in a string initially, that counts as one level."
3.2118- (paredit-up/down (- 0 (or argument +1)) +1))
3.2119-
3.2120-(defun-motion paredit-forward-up (&optional argument)
3.2121- "Move forward up out of the enclosing list.
3.2122-With a positive argument, move forward up that many levels.
3.2123-With a negative argument, move backward up that many levels.
3.2124-If in a string initially, that counts as one level."
3.2125- (paredit-up/down (or argument +1) +1))
3.2126-
3.2127-(defun-motion paredit-backward-down (&optional argument)
3.2128- "Move backward down into a list.
3.2129-With a positive argument, move backward down that many levels.
3.2130-With a negative argument, move forward down that many levels."
3.2131- (paredit-up/down (- 0 (or argument +1)) -1))
3.2132-
3.2133-;;;; Depth-Changing Commands: Wrapping, Splicing, & Raising
3.2134-
3.2135-(defun paredit-wrap-sexp (&optional argument open close)
3.2136- "Wrap the following S-expression.
3.2137-If a `C-u' prefix argument is given, wrap all S-expressions following
3.2138- the point until the end of the buffer or of the enclosing list.
3.2139-If a numeric prefix argument N is given, wrap N S-expressions.
3.2140-Automatically indent the newly wrapped S-expression.
3.2141-As a special case, if the point is at the end of a list, simply insert
3.2142- a parenthesis pair, rather than inserting a lone opening delimiter
3.2143- and then signalling an error, in the interest of preserving
3.2144- structure.
3.2145-By default OPEN and CLOSE are round delimiters."
3.2146- (interactive "P")
3.2147- (paredit-lose-if-not-in-sexp 'paredit-wrap-sexp)
3.2148- (let ((open (or open ?\( ))
3.2149- (close (or close ?\) )))
3.2150- (paredit-handle-sexp-errors
3.2151- ((lambda (n) (paredit-insert-pair n open close 'goto-char))
3.2152- (cond ((integerp argument) argument)
3.2153- ((consp argument) (paredit-count-sexps-forward))
3.2154- ((paredit-region-active-p) nil)
3.2155- (t 1)))
3.2156- (insert close)
3.2157- (backward-char)))
3.2158- (save-excursion (backward-up-list) (indent-sexp)))
3.2159-
3.2160-(defun paredit-yank-pop (&optional argument)
3.2161- "Replace just-yanked text with the next item in the kill ring.
3.2162-If this command follows a `yank', just run `yank-pop'.
3.2163-If this command follows a `paredit-wrap-sexp', or any other paredit
3.2164- wrapping command (see `paredit-wrap-commands'), run `yank' and
3.2165- reindent the enclosing S-expression.
3.2166-If this command is repeated, run `yank-pop' and reindent the enclosing
3.2167- S-expression.
3.2168-
3.2169-The argument is passed on to `yank' or `yank-pop'; see their
3.2170- documentation for details."
3.2171- (interactive "*p")
3.2172- (cond ((eq last-command 'yank)
3.2173- (yank-pop argument))
3.2174- ((memq last-command paredit-wrap-commands)
3.2175- (yank argument)
3.2176- ;; `yank' futzes with `this-command'.
3.2177- (setq this-command 'paredit-yank-pop)
3.2178- (save-excursion (backward-up-list) (indent-sexp)))
3.2179- ((eq last-command 'paredit-yank-pop)
3.2180- ;; Pretend we just did a `yank', so that we can use
3.2181- ;; `yank-pop' without duplicating its definition.
3.2182- (setq last-command 'yank)
3.2183- (yank-pop argument)
3.2184- ;; Return to our original state.
3.2185- (setq last-command 'paredit-yank-pop)
3.2186- (setq this-command 'paredit-yank-pop)
3.2187- (save-excursion (backward-up-list) (indent-sexp)))
3.2188- (t (error "Last command was not a yank or a wrap: %s" last-command))))
3.2189-
3.2190-(defun paredit-splice-sexp (&optional argument)
3.2191- "Splice the list that the point is on by removing its delimiters.
3.2192-With a prefix argument as in `C-u', kill all S-expressions backward in
3.2193- the current list before splicing all S-expressions forward into the
3.2194- enclosing list.
3.2195-With two prefix arguments as in `C-u C-u', kill all S-expressions
3.2196- forward in the current list before splicing all S-expressions
3.2197- backward into the enclosing list.
3.2198-With a numerical prefix argument N, kill N S-expressions backward in
3.2199- the current list before splicing the remaining S-expressions into the
3.2200- enclosing list. If N is negative, kill forward.
3.2201-Inside a string, unescape all backslashes, or signal an error if doing
3.2202- so would invalidate the buffer's structure."
3.2203- (interactive "P")
3.2204- (if (paredit-in-string-p)
3.2205- (paredit-splice-string argument)
3.2206- (if (paredit-in-comment-p)
3.2207- (error "Can't splice comment."))
3.2208- (paredit-handle-sexp-errors (paredit-enclosing-list-start)
3.2209- (error "Can't splice top level."))
3.2210- (paredit-kill-surrounding-sexps-for-splice argument)
3.2211- (let ((delete-start (paredit-enclosing-list-start))
3.2212- (delete-end
3.2213- (let ((limit
3.2214- (save-excursion
3.2215- (paredit-ignore-sexp-errors (forward-sexp) (backward-sexp))
3.2216- (point))))
3.2217- (save-excursion
3.2218- (backward-up-list)
3.2219- (forward-char +1)
3.2220- (paredit-skip-whitespace t limit)
3.2221- (point)))))
3.2222- (let ((end-marker (make-marker)))
3.2223- (save-excursion
3.2224- (up-list)
3.2225- (delete-char -1)
3.2226- (set-marker end-marker (point)))
3.2227- (delete-region delete-start delete-end)
3.2228- (paredit-splice-reindent delete-start (marker-position end-marker))))))
3.2229-
3.2230-(defun paredit-splice-reindent (start end)
3.2231- (paredit-preserving-column
3.2232- ;; If we changed the first subform of the enclosing list, we must
3.2233- ;; reindent the whole enclosing list.
3.2234- (if (paredit-handle-sexp-errors
3.2235- (save-excursion
3.2236- (backward-up-list)
3.2237- (down-list)
3.2238- (paredit-ignore-sexp-errors (forward-sexp))
3.2239- (< start (point)))
3.2240- nil)
3.2241- (save-excursion (backward-up-list) (indent-sexp))
3.2242- (paredit-indent-region start end))))
3.2243-
3.2244-(defun paredit-kill-surrounding-sexps-for-splice (argument)
3.2245- (cond ((or (paredit-in-string-p)
3.2246- (paredit-in-comment-p))
3.2247- (error "Invalid context for splicing S-expressions."))
3.2248- ((or (not argument) (eq argument 0)) nil)
3.2249- ((or (numberp argument) (eq argument '-))
3.2250- ;; Kill S-expressions before/after the point by saving the
3.2251- ;; point, moving across them, and killing the region.
3.2252- (let* ((argument (if (eq argument '-) -1 argument))
3.2253- (saved (paredit-point-at-sexp-boundary (- argument))))
3.2254- (goto-char saved)
3.2255- (paredit-ignore-sexp-errors (backward-sexp argument))
3.2256- (paredit-hack-kill-region saved (point))))
3.2257- ((consp argument)
3.2258- (let ((v (car argument)))
3.2259- (if (= v 4) ;One `C-u'.
3.2260- ;; Move backward until we hit the open paren; then
3.2261- ;; kill that selected region.
3.2262- (let ((end (point)))
3.2263- (paredit-ignore-sexp-errors
3.2264- (while (not (bobp))
3.2265- (backward-sexp)))
3.2266- (paredit-hack-kill-region (point) end))
3.2267- ;; Move forward until we hit the close paren; then
3.2268- ;; kill that selected region.
3.2269- (let ((beginning (point)))
3.2270- (paredit-ignore-sexp-errors
3.2271- (while (not (eobp))
3.2272- (forward-sexp)))
3.2273- (paredit-hack-kill-region beginning (point))))))
3.2274- (t (error "Bizarre prefix argument `%s'." argument))))
3.2275-
3.2276-(defun paredit-splice-sexp-killing-backward (&optional n)
3.2277- "Splice the list the point is on by removing its delimiters, and
3.2278- also kill all S-expressions before the point in the current list.
3.2279-With a prefix argument N, kill only the preceding N S-expressions."
3.2280- (interactive "P")
3.2281- (paredit-splice-sexp (if n
3.2282- (prefix-numeric-value n)
3.2283- '(4))))
3.2284-
3.2285-(defun paredit-splice-sexp-killing-forward (&optional n)
3.2286- "Splice the list the point is on by removing its delimiters, and
3.2287- also kill all S-expressions after the point in the current list.
3.2288-With a prefix argument N, kill only the following N S-expressions."
3.2289- (interactive "P")
3.2290- (paredit-splice-sexp (if n
3.2291- (- (prefix-numeric-value n))
3.2292- '(16))))
3.2293-
3.2294-(defun paredit-raise-sexp (&optional argument)
3.2295- "Raise the following S-expression in a tree, deleting its siblings.
3.2296-With a prefix argument N, raise the following N S-expressions. If N
3.2297- is negative, raise the preceding N S-expressions.
3.2298-If the point is on an S-expression, such as a string or a symbol, not
3.2299- between them, that S-expression is considered to follow the point."
3.2300- (interactive "P")
3.2301- (save-excursion
3.2302- ;; Select the S-expressions we want to raise in a buffer substring.
3.2303- (let* ((bound
3.2304- (if (and (not argument) (paredit-region-active-p))
3.2305- (progn (if (< (mark) (point))
3.2306- (paredit-check-region (mark) (point))
3.2307- (paredit-check-region (point) (mark)))
3.2308- (mark))
3.2309- (cond ((paredit-in-string-p)
3.2310- (goto-char (car (paredit-string-start+end-points))))
3.2311- ((paredit-in-char-p)
3.2312- (backward-sexp))
3.2313- ((paredit-in-comment-p)
3.2314- (error "No S-expression to raise in comment.")))
3.2315- (scan-sexps (point) (prefix-numeric-value argument))))
3.2316- (sexps
3.2317- (if (< bound (point))
3.2318- (buffer-substring bound (paredit-point-at-sexp-end))
3.2319- (buffer-substring (paredit-point-at-sexp-start) bound))))
3.2320- ;; Move up to the list we're raising those S-expressions out of and
3.2321- ;; delete it.
3.2322- (backward-up-list)
3.2323- (delete-region (point) (scan-sexps (point) 1))
3.2324- (let* ((indent-start (point))
3.2325- (indent-end (save-excursion (insert sexps) (point))))
3.2326- ;; If the expression spans multiple lines, its indentation is
3.2327- ;; probably broken, so reindent it -- but don't reindent
3.2328- ;; anything that we didn't touch outside the expression.
3.2329- ;;
3.2330- ;; XXX What if the *column* of the starting point was preserved
3.2331- ;; too? Should we avoid reindenting in that case?
3.2332- (if (not (eq (save-excursion (goto-char indent-start) (point-at-eol))
3.2333- (save-excursion (goto-char indent-end) (point-at-eol))))
3.2334- (indent-region indent-start indent-end nil))))))
3.2335-
3.2336-;;; The effects of convolution on the surrounding whitespace are pretty
3.2337-;;; random. If you have better suggestions, please let me know.
3.2338-
3.2339-(defun paredit-convolute-sexp (&optional n)
3.2340- "Convolute S-expressions.
3.2341-Save the S-expressions preceding point and delete them.
3.2342-Splice the S-expressions following point.
3.2343-Wrap the enclosing list in a new list prefixed by the saved text.
3.2344-With a prefix argument N, move up N lists before wrapping."
3.2345- (interactive "p")
3.2346- (paredit-lose-if-not-in-sexp 'paredit-convolute-sexp)
3.2347- ;; Make sure we can move up before destroying anything.
3.2348- (save-excursion (backward-up-list n) (backward-up-list))
3.2349- (let (open close) ;++ Is this a good idea?
3.2350- (let ((prefix
3.2351- (let ((end (point)))
3.2352- (paredit-ignore-sexp-errors
3.2353- (while (not (bobp)) (backward-sexp)))
3.2354- (prog1 (buffer-substring (point) end)
3.2355- (backward-up-list)
3.2356- (save-excursion (forward-sexp)
3.2357- (setq close (char-before))
3.2358- (delete-char -1))
3.2359- (setq open (char-after))
3.2360- (delete-region (point) end)
3.2361- ;; I'm not sure this makes sense...
3.2362- (if (not (eolp)) (just-one-space))))))
3.2363- (backward-up-list n)
3.2364- (paredit-insert-pair 1 open close 'goto-char)
3.2365- (insert prefix)
3.2366- ;; I'm not sure this makes sense either...
3.2367- (if (not (eolp)) (just-one-space))
3.2368- (save-excursion
3.2369- (backward-up-list)
3.2370- (paredit-ignore-sexp-errors (indent-sexp))))))
3.2371-
3.2372-(defun paredit-splice-string (argument)
3.2373- (let ((original-point (point))
3.2374- (start+end (paredit-string-start+end-points)))
3.2375- (let ((start (car start+end))
3.2376- (end (cdr start+end)))
3.2377- ;; START and END both lie before the respective quote
3.2378- ;; characters, which we want to delete; thus we increment START
3.2379- ;; by one to extract the string, and we increment END by one to
3.2380- ;; delete the string.
3.2381- (let* ((escaped-string
3.2382- (cond ((not (consp argument))
3.2383- (buffer-substring (1+ start) end))
3.2384- ((= 4 (car argument))
3.2385- (buffer-substring original-point end))
3.2386- (t
3.2387- (buffer-substring (1+ start) original-point))))
3.2388- (unescaped-string
3.2389- (paredit-unescape-string escaped-string)))
3.2390- (if (not unescaped-string)
3.2391- (error "Unspliceable string.")
3.2392- (save-excursion
3.2393- (goto-char start)
3.2394- (delete-region start (1+ end))
3.2395- (insert unescaped-string))
3.2396- (if (not (and (consp argument)
3.2397- (= 4 (car argument))))
3.2398- (goto-char (- original-point 1))))))))
3.2399-
3.2400-(defun paredit-unescape-string (string)
3.2401- (with-temp-buffer
3.2402- (insert string)
3.2403- (goto-char (point-min))
3.2404- (while (and (not (eobp))
3.2405- ;; nil -> no bound; t -> no errors.
3.2406- (search-forward "\\" nil t))
3.2407- (delete-char -1)
3.2408- (forward-char))
3.2409- (paredit-handle-sexp-errors
3.2410- (progn (scan-sexps (point-min) (point-max))
3.2411- (buffer-string))
3.2412- nil)))
3.2413-
3.2414-;;;; Slurpage & Barfage
3.2415-
3.2416-(defun paredit-forward-slurp-sexp (&optional argument)
3.2417- "Add the S-expression following the current list into that list
3.2418- by moving the closing delimiter.
3.2419-Automatically reindent the newly slurped S-expression with respect to
3.2420- its new enclosing form.
3.2421-If in a string, move the opening double-quote forward by one
3.2422- S-expression and escape any intervening characters as necessary,
3.2423- without altering any indentation or formatting."
3.2424- (interactive "P")
3.2425- (save-excursion
3.2426- (cond ((paredit-in-comment-p)
3.2427- (error "Invalid context for slurping S-expressions."))
3.2428- ((numberp argument)
3.2429- (if (< argument 0)
3.2430- (paredit-forward-barf-sexp (- 0 argument))
3.2431- (while (< 0 argument)
3.2432- (paredit-forward-slurp-sexp)
3.2433- (setq argument (- argument 1)))))
3.2434- ((paredit-in-string-p)
3.2435- ;; If there is anything to slurp into the string, take that.
3.2436- ;; Otherwise, try to slurp into the enclosing list.
3.2437- (if (save-excursion
3.2438- (goto-char (paredit-enclosing-string-end))
3.2439- (paredit-handle-sexp-errors (progn (forward-sexp) nil)
3.2440- t))
3.2441- (progn
3.2442- (goto-char (paredit-enclosing-string-end))
3.2443- (paredit-forward-slurp-into-list argument))
3.2444- (paredit-forward-slurp-into-string argument)))
3.2445- (t
3.2446- (paredit-forward-slurp-into-list argument)))))
3.2447-
3.2448-(defun paredit-forward-slurp-into-list (&optional argument)
3.2449- (let ((nestedp nil))
3.2450- (save-excursion
3.2451- (up-list) ; Up to the end of the list to
3.2452- (let ((close (char-before))) ; save and delete the closing
3.2453- (delete-char -1) ; delimiter.
3.2454- (let ((start (point)))
3.2455- (catch 'return ; Go to the end of the desired
3.2456- (while t ; S-expression, going up a
3.2457- (paredit-handle-sexp-errors ; list if it's not in this,
3.2458- (progn (forward-sexp)
3.2459- (if argument
3.2460- (paredit-ignore-sexp-errors
3.2461- (while (not (eobp))
3.2462- (forward-sexp))))
3.2463- (throw 'return nil))
3.2464- (setq nestedp t)
3.2465- (up-list)
3.2466- (setq close ; adjusting for mixed
3.2467- (prog1 (char-before) ; delimiters as necessary,
3.2468- (delete-char -1)
3.2469- (insert close))))))
3.2470- (insert close) ; to insert that delimiter.
3.2471- (indent-region start (point) nil))))
3.2472- (if (and (not nestedp)
3.2473- (eq (save-excursion (paredit-skip-whitespace nil) (point))
3.2474- (save-excursion (backward-up-list) (forward-char) (point)))
3.2475- (eq (save-excursion (forward-sexp) (backward-sexp) (point))
3.2476- (save-excursion (paredit-skip-whitespace t) (point))))
3.2477- (delete-region (save-excursion (paredit-skip-whitespace nil) (point))
3.2478- (save-excursion (paredit-skip-whitespace t) (point))))))
3.2479-
3.2480-(defun paredit-forward-slurp-into-string (&optional argument)
3.2481- (let ((start (paredit-enclosing-string-start))
3.2482- (end (paredit-enclosing-string-end)))
3.2483- (goto-char end)
3.2484- ;; Signal any errors that we might get first, before mucking with
3.2485- ;; the buffer's contents.
3.2486- (save-excursion (forward-sexp))
3.2487- (let ((close (char-before)))
3.2488- ;; Skip intervening whitespace if we're slurping into an empty
3.2489- ;; string. XXX What about nonempty strings?
3.2490- (if (and (= (+ start 2) end)
3.2491- (eq (save-excursion (paredit-skip-whitespace t) (point))
3.2492- (save-excursion (forward-sexp) (backward-sexp) (point))))
3.2493- (delete-region (- (point) 1)
3.2494- (save-excursion (paredit-skip-whitespace t) (point)))
3.2495- (delete-char -1))
3.2496- (paredit-forward-for-quote
3.2497- (save-excursion
3.2498- (forward-sexp)
3.2499- (if argument
3.2500- (while (paredit-handle-sexp-errors (progn (forward-sexp) t) nil)))
3.2501- (point)))
3.2502- (insert close))))
3.2503-
3.2504-(defun paredit-forward-barf-sexp (&optional argument)
3.2505- "Remove the last S-expression in the current list from that list
3.2506- by moving the closing delimiter.
3.2507-Automatically reindent the newly barfed S-expression with respect to
3.2508- its new enclosing form."
3.2509- (interactive "P")
3.2510- (paredit-lose-if-not-in-sexp 'paredit-forward-barf-sexp)
3.2511- (if (and (numberp argument) (< argument 0))
3.2512- (paredit-forward-slurp-sexp (- 0 argument))
3.2513- (let ((start (point)) (end nil))
3.2514- (save-excursion
3.2515- (up-list) ; Up to the end of the list to
3.2516- (let ((close (char-before))) ; save and delete the closing
3.2517- (delete-char -1) ; delimiter.
3.2518- (setq end (point))
3.2519- (paredit-ignore-sexp-errors ; Go back to where we want to
3.2520- (if (or (not argument) ; insert the delimiter.
3.2521- (numberp argument))
3.2522- (backward-sexp argument)
3.2523- (while (paredit-handle-sexp-errors
3.2524- (save-excursion (backward-sexp) (<= start (point)))
3.2525- nil)
3.2526- (backward-sexp))))
3.2527- (paredit-skip-whitespace nil) ; Skip leading whitespace.
3.2528- (cond ((bobp)
3.2529- ;++ We'll have deleted the close, but there's no open.
3.2530- ;++ Is that OK?
3.2531- (error "Barfing all subexpressions with no open-paren?"))
3.2532- ((paredit-in-comment-p) ; Don't put the close-paren in
3.2533- (newline))) ; a comment.
3.2534- (insert close))
3.2535- ;; Reindent all of the newly barfed S-expressions. Start at the
3.2536- ;; start of the first barfed S-expression, not at the close we
3.2537- ;; just inserted.
3.2538- (forward-sexp)
3.2539- (backward-sexp)
3.2540- (if (or (not argument) (numberp argument))
3.2541- (paredit-forward-and-indent argument)
3.2542- (indent-region (point) end))))))
3.2543-
3.2544-(defun paredit-backward-slurp-sexp (&optional argument)
3.2545- "Add the S-expression preceding the current list into that list
3.2546- by moving the closing delimiter.
3.2547-Automatically reindent the whole form into which new S-expression was
3.2548- slurped.
3.2549-If in a string, move the opening double-quote backward by one
3.2550- S-expression and escape any intervening characters as necessary,
3.2551- without altering any indentation or formatting."
3.2552- (interactive "P")
3.2553- (save-excursion
3.2554- (cond ((paredit-in-comment-p)
3.2555- (error "Invalid context for slurping S-expressions."))
3.2556- ((numberp argument)
3.2557- (if (< argument 0)
3.2558- (paredit-backward-barf-sexp (- 0 argument))
3.2559- (while (< 0 argument)
3.2560- (paredit-backward-slurp-sexp)
3.2561- (setq argument (- argument 1)))))
3.2562- ((paredit-in-string-p)
3.2563- ;; If there is anything to slurp into the string, take that.
3.2564- ;; Otherwise, try to slurp into the enclosing list.
3.2565- (if (save-excursion
3.2566- (goto-char (paredit-enclosing-string-start))
3.2567- (paredit-handle-sexp-errors (progn (backward-sexp) nil)
3.2568- t))
3.2569- (progn
3.2570- (goto-char (paredit-enclosing-string-start))
3.2571- (paredit-backward-slurp-into-list argument))
3.2572- (paredit-backward-slurp-into-string argument)))
3.2573- (t
3.2574- (paredit-backward-slurp-into-list argument)))))
3.2575-
3.2576-(defun paredit-backward-slurp-into-list (&optional argument)
3.2577- (let ((nestedp nil))
3.2578- (save-excursion
3.2579- (backward-up-list)
3.2580- (let ((open (char-after)))
3.2581- (delete-char +1)
3.2582- (catch 'return
3.2583- (while t
3.2584- (paredit-handle-sexp-errors
3.2585- (progn (backward-sexp)
3.2586- (if argument
3.2587- (paredit-ignore-sexp-errors
3.2588- (while (not (bobp))
3.2589- (backward-sexp))))
3.2590- (throw 'return nil))
3.2591- (setq nestedp t)
3.2592- (backward-up-list)
3.2593- (setq open
3.2594- (prog1 (char-after)
3.2595- (save-excursion (insert open) (delete-char +1)))))))
3.2596- (insert open))
3.2597- ;; Reindent the line at the beginning of wherever we inserted the
3.2598- ;; opening delimiter, and then indent the whole S-expression.
3.2599- (backward-up-list)
3.2600- (lisp-indent-line)
3.2601- (indent-sexp))
3.2602- ;; If we slurped into an empty list, don't leave dangling space:
3.2603- ;; (foo |).
3.2604- (if (and (not nestedp)
3.2605- (eq (save-excursion (paredit-skip-whitespace nil) (point))
3.2606- (save-excursion (backward-sexp) (forward-sexp) (point)))
3.2607- (eq (save-excursion (up-list) (backward-char) (point))
3.2608- (save-excursion (paredit-skip-whitespace t) (point))))
3.2609- (delete-region (save-excursion (paredit-skip-whitespace nil) (point))
3.2610- (save-excursion (paredit-skip-whitespace t) (point))))))
3.2611-
3.2612-(defun paredit-backward-slurp-into-string (&optional argument)
3.2613- (let ((start (paredit-enclosing-string-start))
3.2614- (end (paredit-enclosing-string-end)))
3.2615- (goto-char start)
3.2616- ;; Signal any errors that we might get first, before mucking with
3.2617- ;; the buffer's contents.
3.2618- (save-excursion (backward-sexp))
3.2619- (let ((open (char-after))
3.2620- (target (point)))
3.2621- ;; Skip intervening whitespace if we're slurping into an empty
3.2622- ;; string. XXX What about nonempty strings?
3.2623- (if (and (= (+ start 2) end)
3.2624- (eq (save-excursion (paredit-skip-whitespace nil) (point))
3.2625- (save-excursion (backward-sexp) (forward-sexp) (point))))
3.2626- (delete-region (save-excursion (paredit-skip-whitespace nil) (point))
3.2627- (+ (point) 1))
3.2628- (delete-char +1))
3.2629- (backward-sexp)
3.2630- (if argument
3.2631- (paredit-ignore-sexp-errors
3.2632- (while (not (bobp))
3.2633- (backward-sexp))))
3.2634- (insert open)
3.2635- (paredit-forward-for-quote target))))
3.2636-
3.2637-(defun paredit-backward-barf-sexp (&optional argument)
3.2638- "Remove the first S-expression in the current list from that list
3.2639- by moving the closing delimiter.
3.2640-Automatically reindent the barfed S-expression and the form from which
3.2641- it was barfed."
3.2642- (interactive "P")
3.2643- (paredit-lose-if-not-in-sexp 'paredit-backward-barf-sexp)
3.2644- (if (and (numberp argument) (< argument 0))
3.2645- (paredit-backward-slurp-sexp (- 0 argument))
3.2646- (let ((end (make-marker)))
3.2647- (set-marker end (point))
3.2648- (save-excursion
3.2649- (backward-up-list)
3.2650- (let ((open (char-after)))
3.2651- (delete-char +1)
3.2652- (paredit-ignore-sexp-errors
3.2653- (paredit-forward-and-indent
3.2654- (if (or (not argument) (numberp argument))
3.2655- argument
3.2656- (let ((n 0))
3.2657- (save-excursion
3.2658- (while (paredit-handle-sexp-errors
3.2659- (save-excursion
3.2660- (forward-sexp)
3.2661- (<= (point) end))
3.2662- nil)
3.2663- (forward-sexp)
3.2664- (setq n (+ n 1))))
3.2665- n))))
3.2666- (while (progn (paredit-skip-whitespace t) (eq (char-after) ?\; ))
3.2667- (forward-line 1))
3.2668- (if (eobp)
3.2669- ;++ We'll have deleted the close, but there's no open.
3.2670- ;++ Is that OK?
3.2671- (error "Barfing all subexpressions with no close-paren?"))
3.2672- ;** Don't use `insert' here. Consider, e.g., barfing from
3.2673- ;** (foo|)
3.2674- ;** and how `save-excursion' works.
3.2675- (insert-before-markers open))
3.2676- (backward-up-list)
3.2677- (lisp-indent-line)
3.2678- (indent-sexp)))))
3.2679-
3.2680-;;;; Splitting & Joining
3.2681-
3.2682-(defun paredit-split-sexp ()
3.2683- "Split the list or string the point is on into two."
3.2684- (interactive)
3.2685- (cond ((paredit-in-string-p)
3.2686- (insert "\"")
3.2687- (save-excursion (insert " \"")))
3.2688- ((or (paredit-in-comment-p)
3.2689- (paredit-in-char-p))
3.2690- (error "Invalid context for splitting S-expression."))
3.2691- (t
3.2692- (let ((open (save-excursion (backward-up-list) (char-after)))
3.2693- (close (save-excursion (up-list) (char-before))))
3.2694- (delete-horizontal-space)
3.2695- (insert close)
3.2696- (save-excursion
3.2697- (insert ?\ )
3.2698- (insert open)
3.2699- (backward-char)
3.2700- (indent-sexp))))))
3.2701-
3.2702-(defun paredit-join-sexps ()
3.2703- "Join the S-expressions adjacent on either side of the point.
3.2704-Both must be lists, strings, or atoms; error if there is a mismatch."
3.2705- (interactive)
3.2706- (cond ((paredit-in-comment-p) (error "Can't join S-expressions in comment."))
3.2707- ((paredit-in-string-p) (error "Nothing to join in a string."))
3.2708- ((paredit-in-char-p) (error "Can't join characters.")))
3.2709- (let ((left-point (paredit-point-at-sexp-end))
3.2710- (right-point (paredit-point-at-sexp-start)))
3.2711- (let ((left-char (char-before left-point))
3.2712- (right-char (char-after right-point)))
3.2713- (let ((left-syntax (char-syntax left-char))
3.2714- (right-syntax (char-syntax right-char)))
3.2715- (cond ((< right-point left-point)
3.2716- (error "Can't join a datum with itself."))
3.2717- ((and (eq left-syntax ?\) )
3.2718- (eq right-syntax ?\( )
3.2719- (eq left-char (matching-paren right-char))
3.2720- (eq right-char (matching-paren left-char)))
3.2721- (paredit-join-lists-internal left-point right-point)
3.2722- (paredit-preserving-column
3.2723- (save-excursion
3.2724- (backward-up-list)
3.2725- (indent-sexp))))
3.2726- ((and (eq left-syntax ?\" )
3.2727- (eq right-syntax ?\" ))
3.2728- ;; Delete any intermediate formatting.
3.2729- (delete-region (1- left-point) (1+ right-point)))
3.2730- ((and (memq left-syntax '(?w ?_)) ; Word or symbol
3.2731- (memq right-syntax '(?w ?_)))
3.2732- (delete-region left-point right-point))
3.2733- (t (error "Mismatched S-expressions to join.")))))))
3.2734-
3.2735-(defun paredit-join-lists-internal (left-point right-point)
3.2736- (save-excursion
3.2737- ;; Leave intermediate formatting alone.
3.2738- (goto-char right-point)
3.2739- (delete-char +1)
3.2740- (goto-char left-point)
3.2741- (delete-char -1)
3.2742- ;; Kludge: Add an extra space in several conditions.
3.2743- (if (or
3.2744- ;; (foo)| ;x\n(bar) => (foo | ;x\nbar), not (foo| ;x\nbar).
3.2745- (and (not (eolp))
3.2746- (save-excursion
3.2747- (paredit-skip-whitespace t (point-at-eol))
3.2748- (eq (char-after) ?\;)))
3.2749- ;; (foo)|(bar) => (foo| bar), not (foo|bar).
3.2750- (and (= left-point right-point)
3.2751- (not (or (eq ?\ (char-syntax (char-before)))
3.2752- (eq ?\ (char-syntax (char-after)))))))
3.2753- (insert ?\ ))))
3.2754-
3.2755-;++ How ought paredit-join to handle comments intervening symbols or strings?
3.2756-;++ Idea:
3.2757-;++
3.2758-;++ "foo" | ;bar
3.2759-;++ "baz" ;quux
3.2760-;++
3.2761-;++ =>
3.2762-;++
3.2763-;++ "foo|baz" ;bar
3.2764-;++ ;quux
3.2765-;++
3.2766-;++ The point should stay where it is relative to the comments, and the
3.2767-;++ the comments' columns should all be preserved, perhaps. Hmmmm...
3.2768-;++ What about this?
3.2769-;++
3.2770-;++ "foo" ;bar
3.2771-;++ | ;baz
3.2772-;++ "quux" ;zot
3.2773-
3.2774-;++ Should rename:
3.2775-;++ paredit-point-at-sexp-start -> paredit-start-of-sexp-after-point
3.2776-;++ paredit-point-at-sexp-end -> paredit-end-of-sexp-before-point
3.2777-
3.2778-;;;; Variations on the Lurid Theme
3.2779-
3.2780-;;; I haven't the imagination to concoct clever names for these.
3.2781-
3.2782-(defun paredit-add-to-previous-list ()
3.2783- "Add the S-expression following point to the list preceding point."
3.2784- (interactive)
3.2785- (paredit-lose-if-not-in-sexp 'paredit-add-to-previous-list)
3.2786- (save-excursion
3.2787- (down-list -1) ;++ backward-down-list...
3.2788- (paredit-forward-slurp-sexp)))
3.2789-
3.2790-(defun paredit-add-to-next-list ()
3.2791- "Add the S-expression preceding point to the list following point.
3.2792-If no S-expression precedes point, move up the tree until one does."
3.2793- (interactive)
3.2794- (paredit-lose-if-not-in-sexp 'paredit-add-to-next-list)
3.2795- (save-excursion
3.2796- (down-list)
3.2797- (paredit-backward-slurp-sexp)))
3.2798-
3.2799-(defun paredit-join-with-previous-list ()
3.2800- "Join the list the point is on with the previous list in the buffer."
3.2801- (interactive)
3.2802- (paredit-lose-if-not-in-sexp 'paredit-join-with-previous-list)
3.2803- (save-excursion
3.2804- (while (paredit-handle-sexp-errors (save-excursion (backward-sexp) nil)
3.2805- (backward-up-list)
3.2806- t))
3.2807- (paredit-join-sexps)))
3.2808-
3.2809-(defun paredit-join-with-next-list ()
3.2810- "Join the list the point is on with the next list in the buffer."
3.2811- (interactive)
3.2812- (paredit-lose-if-not-in-sexp 'paredit-join-with-next-list)
3.2813- (save-excursion
3.2814- (while (paredit-handle-sexp-errors (save-excursion (forward-sexp) nil)
3.2815- (up-list)
3.2816- t))
3.2817- (paredit-join-sexps)))
3.2818-
3.2819-;;;; Utilities
3.2820-
3.2821-(defun paredit-in-string-escape-p ()
3.2822- "True if the point is on a character escape of a string.
3.2823-This is true only if the character is preceded by an odd number of
3.2824- backslashes.
3.2825-This assumes that `paredit-in-string-p' has already returned true."
3.2826- (let ((oddp nil))
3.2827- (save-excursion
3.2828- (while (eq (char-before) ?\\ )
3.2829- (setq oddp (not oddp))
3.2830- (backward-char)))
3.2831- oddp))
3.2832-
3.2833-(defun paredit-in-char-p (&optional position)
3.2834- "True if point is on a character escape outside a string."
3.2835- (save-excursion
3.2836- (goto-char (or position (point)))
3.2837- (paredit-in-string-escape-p)))
3.2838-
3.2839-(defun paredit-skip-whitespace (trailing-p &optional limit)
3.2840- "Skip past any whitespace, or until the point LIMIT is reached.
3.2841-If TRAILING-P is nil, skip leading whitespace; otherwise, skip trailing
3.2842- whitespace."
3.2843- (funcall (if trailing-p 'skip-chars-forward 'skip-chars-backward)
3.2844- " \t\n " ; This should skip using the syntax table, but LF
3.2845- limit)) ; is a comment end, not newline, in Lisp mode.
3.2846-
3.2847-(defalias 'paredit-region-active-p
3.2848- (xcond ((paredit-xemacs-p) 'region-active-p)
3.2849- ((paredit-gnu-emacs-p)
3.2850- (lambda ()
3.2851- (and mark-active transient-mark-mode)))))
3.2852-
3.2853-(defun paredit-hack-kill-region (start end)
3.2854- "Kill the region between START and END.
3.2855-Do not append to any current kill, and
3.2856- do not let the next kill append to this one."
3.2857- (interactive "r") ;Eh, why not?
3.2858- ;; KILL-REGION sets THIS-COMMAND to tell the next kill that the last
3.2859- ;; command was a kill. It also checks LAST-COMMAND to see whether it
3.2860- ;; should append. If we bind these locally, any modifications to
3.2861- ;; THIS-COMMAND will be masked, and it will not see LAST-COMMAND to
3.2862- ;; indicate that it should append.
3.2863- (let ((this-command nil)
3.2864- (last-command nil))
3.2865- (kill-region start end)))
3.2866-
3.2867-;;;;; Reindentation utilities
3.2868-
3.2869-;++ Should `paredit-indent-sexps' and `paredit-forward-and-indent' use
3.2870-;++ `paredit-indent-region' rather than `indent-region'?
3.2871-
3.2872-(defun paredit-indent-sexps ()
3.2873- "If in a list, indent all following S-expressions in the list."
3.2874- (let* ((start (point))
3.2875- (end (paredit-handle-sexp-errors (progn (up-list) (point)) nil)))
3.2876- (if end
3.2877- (indent-region start end nil))))
3.2878-
3.2879-(defun paredit-forward-and-indent (&optional n)
3.2880- "Move forward by N S-expressions, indenting them with `indent-region'."
3.2881- (let ((start (point)))
3.2882- (forward-sexp n)
3.2883- (indent-region start (point) nil)))
3.2884-
3.2885-(defun paredit-indent-region (start end)
3.2886- "Indent the region from START to END.
3.2887-Don't reindent the line starting at START, however."
3.2888- (if (not (<= start end))
3.2889- (error "Incorrectly related points: %S, %S" start end))
3.2890- (save-excursion
3.2891- (goto-char start)
3.2892- (let ((bol (point-at-bol)))
3.2893- ;; Skip all S-expressions that end on the starting line, but
3.2894- ;; don't go past `end'.
3.2895- (if (and (save-excursion (goto-char end) (not (eq bol (point-at-bol))))
3.2896- (paredit-handle-sexp-errors
3.2897- (catch 'exit
3.2898- (while t
3.2899- (save-excursion
3.2900- (forward-sexp)
3.2901- (if (not (eq bol (point-at-bol)))
3.2902- (throw 'exit t))
3.2903- (if (not (< (point) end))
3.2904- (throw 'exit nil)))
3.2905- (forward-sexp)))
3.2906- nil))
3.2907- (progn
3.2908- ;; Point is still on the same line, but precedes an
3.2909- ;; S-expression that ends on a different line.
3.2910- (if (not (eq bol (point-at-bol)))
3.2911- (error "Internal error -- we moved forward a line!"))
3.2912- (goto-char (+ 1 (point-at-eol)))
3.2913- (if (not (<= (point) end))
3.2914- (error "Internal error -- we frobnitzed the garfnut!"))
3.2915- (indent-region (point) end nil))))))
3.2916-
3.2917-;;;;; S-expression Parsing Utilities
3.2918-
3.2919-;++ These routines redundantly traverse S-expressions a great deal.
3.2920-;++ If performance issues arise, this whole section will probably have
3.2921-;++ to be refactored to preserve the state longer, like paredit.scm
3.2922-;++ does, rather than to traverse the definition N times for every key
3.2923-;++ stroke as it presently does.
3.2924-
3.2925-(defun paredit-current-parse-state ()
3.2926- "Return parse state of point from beginning of defun."
3.2927- (let ((point (point)))
3.2928- (beginning-of-defun)
3.2929- ;; Calling PARSE-PARTIAL-SEXP will advance the point to its second
3.2930- ;; argument (unless parsing stops due to an error, but we assume it
3.2931- ;; won't in paredit-mode).
3.2932- (parse-partial-sexp (point) point)))
3.2933-
3.2934-(defun paredit-in-string-p (&optional state)
3.2935- "True if the parse state is within a double-quote-delimited string.
3.2936-If no parse state is supplied, compute one from the beginning of the
3.2937- defun to the point."
3.2938- ;; 3. non-nil if inside a string (the terminator character, really)
3.2939- (and (nth 3 (or state (paredit-current-parse-state)))
3.2940- t))
3.2941-
3.2942-(defun paredit-string-start+end-points (&optional state)
3.2943- "Return a cons of the points of open and close quotes of the string.
3.2944-The string is determined from the parse state STATE, or the parse state
3.2945- from the beginning of the defun to the point.
3.2946-This assumes that `paredit-in-string-p' has already returned true, i.e.
3.2947- that the point is already within a string."
3.2948- (save-excursion
3.2949- ;; 8. character address of start of comment or string; nil if not
3.2950- ;; in one
3.2951- (let ((start (nth 8 (or state (paredit-current-parse-state)))))
3.2952- (goto-char start)
3.2953- (forward-sexp 1)
3.2954- (cons start (1- (point))))))
3.2955-
3.2956-(defun paredit-enclosing-string-start ()
3.2957- (car (paredit-string-start+end-points)))
3.2958-
3.2959-(defun paredit-enclosing-string-end ()
3.2960- (+ 1 (cdr (paredit-string-start+end-points))))
3.2961-
3.2962-(defun paredit-enclosing-list-start ()
3.2963- (save-excursion
3.2964- (backward-up-list)
3.2965- (point)))
3.2966-
3.2967-(defun paredit-enclosing-list-end ()
3.2968- (save-excursion
3.2969- (up-list)
3.2970- (point)))
3.2971-
3.2972-(defun paredit-in-comment-p (&optional state)
3.2973- "True if parse state STATE is within a comment.
3.2974-If no parse state is supplied, compute one from the beginning of the
3.2975- defun to the point."
3.2976- ;; 4. nil if outside a comment, t if inside a non-nestable comment,
3.2977- ;; else an integer (the current comment nesting)
3.2978- (and (nth 4 (or state (paredit-current-parse-state)))
3.2979- t))
3.2980-
3.2981-(defun paredit-prefix-numeric-value (argument)
3.2982- ;++ Kludgerific.
3.2983- (cond ((integerp argument) argument)
3.2984- ((eq argument '-) -1)
3.2985- ((consp argument)
3.2986- (cond ((equal argument '(4)) (paredit-count-sexps-forward)) ;C-u
3.2987- ((equal argument '(16)) (paredit-count-sexps-backward)) ;C-u C-u
3.2988- (t (error "Invalid prefix argument: %S" argument))))
3.2989- ((paredit-region-active-p)
3.2990- (save-excursion
3.2991- (save-restriction
3.2992- (narrow-to-region (region-beginning) (region-end))
3.2993- (cond ((= (point) (point-min)) (paredit-count-sexps-forward))
3.2994- ((= (point) (point-max)) (paredit-count-sexps-backward))
3.2995- (t
3.2996- (error "Point %S is not start or end of region: %S..%S"
3.2997- (point) (region-beginning) (region-end)))))))
3.2998- (t 1)))
3.2999-
3.3000-(defun paredit-count-sexps-forward ()
3.3001- (save-excursion
3.3002- (let ((n 0) (p nil)) ;hurk
3.3003- (paredit-ignore-sexp-errors
3.3004- (while (setq p (scan-sexps (point) +1))
3.3005- (goto-char p)
3.3006- (setq n (+ n 1))))
3.3007- n)))
3.3008-
3.3009-(defun paredit-count-sexps-backward ()
3.3010- (save-excursion
3.3011- (let ((n 0) (p nil)) ;hurk
3.3012- (paredit-ignore-sexp-errors
3.3013- (while (setq p (scan-sexps (point) -1))
3.3014- (goto-char p)
3.3015- (setq n (+ n 1))))
3.3016- n)))
3.3017-
3.3018-(defun paredit-point-at-sexp-boundary (n)
3.3019- (cond ((< n 0) (paredit-point-at-sexp-start))
3.3020- ((= n 0) (point))
3.3021- ((> n 0) (paredit-point-at-sexp-end))))
3.3022-
3.3023-(defun paredit-point-at-sexp-start ()
3.3024- (save-excursion
3.3025- (forward-sexp)
3.3026- (backward-sexp)
3.3027- (point)))
3.3028-
3.3029-(defun paredit-point-at-sexp-end ()
3.3030- (save-excursion
3.3031- (backward-sexp)
3.3032- (forward-sexp)
3.3033- (point)))
3.3034-
3.3035-(defun paredit-lose-if-not-in-sexp (command)
3.3036- (if (or (paredit-in-string-p)
3.3037- (paredit-in-comment-p)
3.3038- (paredit-in-char-p))
3.3039- (error "Invalid context for command `%s'." command)))
3.3040-
3.3041-(defun paredit-check-region (start end)
3.3042- "Signal an error if text between `start' and `end' is unbalanced."
3.3043- ;; `narrow-to-region' will move the point, so avoid calling it if we
3.3044- ;; don't need to. We don't want to use `save-excursion' because we
3.3045- ;; want the point to move if `check-parens' reports an error.
3.3046- (if (not (paredit-region-ok-p start end))
3.3047- (save-restriction
3.3048- (narrow-to-region start end)
3.3049- (check-parens))))
3.3050-
3.3051-(defun paredit-region-ok-p (start end)
3.3052- "Return true iff the region between `start' and `end' is balanced.
3.3053-This is independent of context -- it doesn't check what state the
3.3054- text at `start' is in."
3.3055- (save-excursion
3.3056- (paredit-handle-sexp-errors
3.3057- (progn
3.3058- (save-restriction
3.3059- (narrow-to-region start end)
3.3060- (scan-sexps (point-min) (point-max)))
3.3061- t)
3.3062- nil)))
3.3063-
3.3064-(defun paredit-current-column ()
3.3065- ;; Like current-column, but respects field boundaries in interactive
3.3066- ;; modes like ielm. For use only with paredit-restore-column, which
3.3067- ;; works relative to point-at-bol.
3.3068- (- (point) (point-at-bol)))
3.3069-
3.3070-(defun paredit-current-indentation ()
3.3071- (save-excursion
3.3072- (back-to-indentation)
3.3073- (paredit-current-column)))
3.3074-
3.3075-(defun paredit-restore-column (column indentation)
3.3076- ;; Preserve the point's position either in the indentation or in the
3.3077- ;; code: if on code, move with the code; if in indentation, leave it
3.3078- ;; in the indentation, either where it was (if still on indentation)
3.3079- ;; or at the end of the indentation (if the code moved far enough
3.3080- ;; left).
3.3081- (let ((indentation* (paredit-current-indentation)))
3.3082- (goto-char
3.3083- (+ (point-at-bol)
3.3084- (cond ((not (< column indentation))
3.3085- (+ column (- indentation* indentation)))
3.3086- ((<= indentation* column) indentation*)
3.3087- (t column))))))
3.3088-
3.3089-;;;; Initialization
3.3090-
3.3091-(paredit-define-keys)
3.3092-(paredit-annotate-mode-with-examples)
3.3093-(paredit-annotate-functions-with-examples)
3.3094-
3.3095-(provide 'paredit)
3.3096-
3.3097-;;; Local Variables:
3.3098-;;; outline-regexp: " \n;;;;+"
3.3099-;;; End:
3.3100-
3.3101-;;; paredit.el ends here
