1.1--- a/.bashrc Tue May 14 14:47:50 2024 -0400
1.2+++ b/.bashrc Sat Jun 01 23:43:29 2024 -0400
1.3@@ -5,46 +5,38 @@
1.4 export LISP='sbcl'
1.5 export ESHELL='/usr/bin/bash'
1.6 export ORGANIZATION='The Compiler Company'
1.7-export TERM='xterm-256color'
1.8 export MANPATH="/usr/local/man:$MANPATH"
1.9 export LANG=en_US.UTF-8
1.10 export ALTERNATE_EDITOR=''
1.11-export EDITOR='emacsclient -t -a='
1.12-export VISUAL='emacsclient -c'
1.13+export EDITOR='emacsclient -a='
1.14 # sudo pacman -Sy seahorse libgnome-keyring libsecret
1.15 #export SSH_ASKPASS=/usr/lib/seahorse/ssh-askpass
1.16 # git config --global credential.helper /usr/lib/git-core/git-credential-libsecret
1.17 export XDG_CONFIG_HOME=$HOME/.config
1.18 export XDG_CACHE_HOME=$HOME/.cache
1.19-export XDG_DATA_HOME=$HOME/.data
1.20-export XDG_STATE_HOME=$HOME/.state
1.21-export XDG_STATE_HOME=$HOME/.state
1.22-export XDG_DESKTOP_DIR=$HOME/Desktop
1.23-export XDG_DOCUMENTS_DIR=$HOME/stash/docs
1.24-export XDG_DOWNLOAD_DIR=$HOME/stash/dl
1.25-export XDG_MUSIC_DIR=$HOME/media/music
1.26-export XDG_PICTURES_DIR=$HOME/media/pictures
1.27-export XDG_PUBLICSHARE_DIR=$HOME/stash/public
1.28-export XDG_TEMPLATES_DIR=$HOME/stash/templates
1.29-export XDG_VIDEOS_DIR=$HOME/media/videos
1.30-# custom configs
1.31-export FREESOUND_CONFIG="~/.config/freesound.json"
1.32-export SSH_AUTH_SOCK="${XDG_RUNTIME_DIR}/ssh-agent.socket"
1.33+
1.34 # aliases
1.35 eman() {
1.36- emacsclient -c -e "(man \"$1\")"
1.37+ emacsclient -t -e "(man \"$1\")" -a=
1.38 }
1.39
1.40+eww() {
1.41+ emacsclient -t -e '(eww-browse-url "'"$1"'")' -a=
1.42+}
1.43+alias em='emacsclient -a='
1.44 alias ec='emacsclient -c -a='
1.45 alias et='emacsclient -t -a='
1.46-alias lr='rlwrap sbcl'
1.47+alias skm='skel make'
1.48+alias hmi='homer install'
1.49+alias lisp='rlwrap sbcl'
1.50 alias hgpu='hg pull -u'
1.51 alias hgc='hg ci -m'
1.52 alias hgp='hg push'
1.53-alias hgfe='hg-fast-export.sh'
1.54+
1.55 # VCS
1.56 alias hgsub='find . -name ".hg" -type d | grep -v "\./\.hg" | xargs -n1 dirname | xargs -iREPO hg -R REPO'
1.57
1.58 alias q='QHOME=~/q rlwrap -r ~/q/l64/q'
1.59 alias ..='cd ..'
1.60+
1.61 complete -c man which
2.1--- a/.config/systemd/user/default.target.wants/emacs.service Tue May 14 14:47:50 2024 -0400
2.2+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
2.3@@ -1,19 +0,0 @@
2.4-[Unit]
2.5-Description=Emacs text editor
2.6-Documentation=info:emacs man:emacs(1) https://gnu.org/software/emacs/
2.7-
2.8-[Service]
2.9-Type=notify
2.10-ExecStart=/usr/local/bin/emacs --fg-daemon
2.11-
2.12-# Emacs will exit with status 15 after having received SIGTERM, which
2.13-# is the default "KillSignal" value systemd uses to stop services.
2.14-SuccessExitStatus=15
2.15-
2.16-# The location of the SSH auth socket varies by distribution, and some
2.17-# set it from PAM, so don't override by default.
2.18-# Environment=SSH_AUTH_SOCK=%t/keyring/ssh
2.19-Restart=on-failure
2.20-
2.21-[Install]
2.22-WantedBy=default.target
3.1--- a/.emacs.d/ellis.el Tue May 14 14:47:50 2024 -0400
3.2+++ b/.emacs.d/ellis.el Sat Jun 01 23:43:29 2024 -0400
3.3@@ -25,14 +25,14 @@
3.4 ;;; Code:
3.5 (require 'inbox)
3.6 (require 'sk)
3.7-(require 'slime-cape)
3.8+;; (require 'slime-cape)
3.9 (require 'sxp)
3.10 (require 'ulang)
3.11
3.12 (defalias 'make #'compile)
3.13
3.14 (setopt default-theme 'modus-vivendi-tritanopia
3.15- user-lab-directory (join-paths user-home-directory "dev")
3.16+ user-lab-directory (join-paths user-home-directory "lab")
3.17 company-source-directory (join-paths user-lab-directory "comp"))
3.18
3.19 (unless (display-graphic-p) (setq default-theme 'wheatgrass))
3.20@@ -53,8 +53,9 @@
3.21 (keymap-set emacs-lisp-mode-map "C-c C-l" #'load-file)
3.22 (keymap-set emacs-lisp-mode-map "C-c M-k" #'elisp-byte-compile-file)
3.23
3.24-;; (add-hook 'common-lisp-mode-hook #'enable-paredit-mode)
3.25-;; (add-hook 'emacs-lisp-mode-hook #'enable-paredit-mode)
3.26+(require 'paredit)
3.27+(add-hook 'common-lisp-mode-hook #'enable-paredit-mode)
3.28+(add-hook 'emacs-lisp-mode-hook #'enable-paredit-mode)
3.29
3.30 (repeat-mode)
3.31
3.32@@ -273,14 +274,17 @@
3.33 (async-shell-command
3.34 "etags ./*.el \\
3.35 ./lib/*.el \\
3.36-~/dev/comp/org/*.el \\
3.37-~/dev/comp/core/emacs/*.el \\
3.38-~/dev/comp/core/emacs/lib/*.el \\
3.39+~/comp/org/*.el \\
3.40+~/comp/core/emacs/*.el \\
3.41+~/comp/core/emacs/lib/*.el \\
3.42 -o TAGS")))
3.43
3.44 (unless (string-equal "hyde" system-name)
3.45 (add-hook 'dired-mode-hook #'all-the-icons-dired-mode)
3.46 (add-hook 'ibuffer-mode-hook #'all-the-icons-ibuffer-mode))
3.47
3.48+;; strangerdanger
3.49+(setq slime-enable-evaluate-in-emacs t)
3.50+
3.51 (provide 'ellis)
3.52 ;;; ellis.el ends here
4.1--- /dev/null Thu Jan 01 00:00:00 1970 +0000
4.2+++ b/.emacs.d/lib/paredit.el Sat Jun 01 23:43:29 2024 -0400
4.3@@ -0,0 +1,3098 @@
4.4+;;; paredit.el --- minor mode for editing parentheses -*- Mode: Emacs-Lisp -*-
4.5+
4.6+;; Copyright (C) 2005--2023 Taylor R. Campbell
4.7+
4.8+;; Author: Taylor R. Campbell <campbell@paredit.org>
4.9+;; Version: 27beta
4.10+;; Created: 2005-07-31
4.11+;; Keywords: lisp
4.12+;; URL: https://paredit.org
4.13+
4.14+;; Paredit is free software: you can redistribute it and/or modify it
4.15+;; under the terms of the GNU General Public License as published by
4.16+;; the Free Software Foundation, either version 3 of the License, or
4.17+;; (at your option) any later version.
4.18+;;
4.19+;; Paredit is distributed in the hope that it will be useful, but
4.20+;; WITHOUT ANY WARRANTY; without even the implied warranty of
4.21+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
4.22+;; GNU General Public License for more details.
4.23+;;
4.24+;; You should have received a copy of the GNU General Public License
4.25+;; along with paredit. If not, see <http://www.gnu.org/licenses/>.
4.26+
4.27+;;; Paredit - https://paredit.org
4.28+;;;
4.29+;;; Latest release: https://paredit.org/paredit.el
4.30+;;; Current development version: https://paredit.org/paredit-beta.el
4.31+;;; Release notes: https://paredit.org/NEWS
4.32+
4.33+;;; Commentary:
4.34+
4.35+;; Paredit keeps your parentheses balanced while editing. Paredit Mode
4.36+;; binds keys like `(', `)', and `"' to insert or delete parentheses
4.37+;; and string quotes in balanced pairs as you're editing without
4.38+;; getting in your way, augments editing keys like `C-k' to handle
4.39+;; balanced expressions, and provides advanced commands for editing
4.40+;; balanced expressions like splicing and joining while judiciously
4.41+;; keeping the code you're working on indented.
4.42+
4.43+;;; Install paredit by placing `paredit.el' in `/path/to/elisp', a
4.44+;;; directory of your choice, and adding to your .emacs file:
4.45+;;;
4.46+;;; (add-to-list 'load-path "/path/to/elisp")
4.47+;;; (autoload 'enable-paredit-mode "paredit"
4.48+;;; "Turn on pseudo-structural editing of Lisp code."
4.49+;;; t)
4.50+;;;
4.51+;;; Start Paredit Mode on the fly with `M-x enable-paredit-mode RET',
4.52+;;; or always enable it in a major mode `M' (e.g., `lisp') with:
4.53+;;;
4.54+;;; (add-hook 'M-mode-hook 'enable-paredit-mode)
4.55+;;;
4.56+;;; Customize paredit using `eval-after-load':
4.57+;;;
4.58+;;; (eval-after-load 'paredit
4.59+;;; '(progn
4.60+;;; (define-key paredit-mode-map (kbd "ESC M-A-C-s-)")
4.61+;;; 'paredit-dwim)))
4.62+;;;
4.63+;;; Send questions, bug reports, comments, feature suggestions, &c.,
4.64+;;; via email to the author's surname at paredit.org.
4.65+;;;
4.66+;;; Paredit should run in GNU Emacs 21 or later and XEmacs 21.5.28 or
4.67+;;; later.
4.68+
4.69+;;; The paredit minor mode, Paredit Mode, binds common character keys,
4.70+;;; such as `(', `)', `"', and `\', to commands that carefully insert
4.71+;;; S-expression structures in the buffer:
4.72+;;;
4.73+;;; ( inserts `()', leaving the point in the middle;
4.74+;;; ) moves the point over the next closing delimiter;
4.75+;;; " inserts `""' if outside a string, or inserts an escaped
4.76+;;; double-quote if in the middle of a string, or moves over the
4.77+;;; closing double-quote if at the end of a string; and
4.78+;;; \ prompts for the character to escape, to avoid inserting lone
4.79+;;; backslashes that may break structure.
4.80+;;;
4.81+;;; In comments, these keys insert themselves. If necessary, you can
4.82+;;; insert these characters literally outside comments by pressing
4.83+;;; `C-q' before these keys, in case a mistake has broken the
4.84+;;; structure.
4.85+;;;
4.86+;;; These key bindings are designed so that when typing new code in
4.87+;;; Paredit Mode, you can generally type exactly the same sequence of
4.88+;;; keys you would have typed without Paredit Mode.
4.89+;;;
4.90+;;; Paredit Mode also binds common editing keys, such as `DEL', `C-d',
4.91+;;; and `C-k', to commands that respect S-expression structures in the
4.92+;;; buffer:
4.93+;;;
4.94+;;; DEL deletes the previous character, unless it is a delimiter: DEL
4.95+;;; will move the point backward over a closing delimiter, and
4.96+;;; will delete a delimiter pair together if between an open and
4.97+;;; closing delimiter;
4.98+;;;
4.99+;;; C-d deletes the next character in much the same manner; and
4.100+;;;
4.101+;;; C-k kills all S-expressions that begin anywhere between the point
4.102+;;; and the end of the line or the closing delimiter of the
4.103+;;; enclosing list, whichever is first.
4.104+;;;
4.105+;;; If necessary, you can delete a character, kill a line, &c.,
4.106+;;; irrespective of S-expression structure, by pressing `C-u' before
4.107+;;; these keys, in case a mistake has broken the structure.
4.108+;;;
4.109+;;; Finally, Paredit Mode binds some keys to complex S-expression
4.110+;;; editing operations. For example, `C-<right>' makes the enclosing
4.111+;;; list slurp up an S-expression to its right (here `|' denotes the
4.112+;;; point):
4.113+;;;
4.114+;;; (foo (bar | baz) quux) C-<right> (foo (bar | baz quux))
4.115+;;;
4.116+;;; Note: Paredit Mode is not compatible with Electric Indent Mode.
4.117+;;; Use one or the other, not both. If you want RET to auto-indent and
4.118+;;; C-j to just insert newline in Paredit Mode, simply rebind the keys
4.119+;;; with the following fragment in your .emacs file:
4.120+;;;
4.121+;;; (eval-after-load 'paredit
4.122+;;; '(progn
4.123+;;; (define-key paredit-mode-map (kbd "RET") 'paredit-newline)
4.124+;;; (define-key paredit-mode-map (kbd "C-j") nil)))
4.125+;;;
4.126+;;; Some paredit commands automatically reindent code. When they do,
4.127+;;; they try to indent as locally as possible, to avoid interfering
4.128+;;; with any indentation you might have manually written. Only the
4.129+;;; advanced S-expression manipulation commands automatically reindent,
4.130+;;; and only the forms that they immediately operated upon (and their
4.131+;;; subforms).
4.132+;;;
4.133+;;; This code is written for clarity, not efficiency. It frequently
4.134+;;; walks over S-expressions redundantly. If you have problems with
4.135+;;; the time it takes to execute some of the commands, let me know.
4.136+
4.137+;;; This assumes Unix-style LF line endings.
4.138+
4.139+(defconst paredit-version 27)
4.140+(defconst paredit-beta-p t)
4.141+
4.142+(eval-and-compile
4.143+
4.144+ (defun paredit-xemacs-p ()
4.145+ ;; No idea where I got this definition from. Edward O'Connor
4.146+ ;; (hober in #emacs) suggested the current definition.
4.147+ ;; (and (boundp 'running-xemacs)
4.148+ ;; running-xemacs)
4.149+ (featurep 'xemacs))
4.150+
4.151+ (defun paredit-gnu-emacs-p ()
4.152+ ;++ This could probably be improved.
4.153+ (not (paredit-xemacs-p)))
4.154+
4.155+ (defmacro xcond (&rest clauses)
4.156+ "Exhaustive COND.
4.157+Signal an error if no clause matches."
4.158+ `(cond ,@clauses
4.159+ (t (error "XCOND lost."))))
4.160+
4.161+ (defalias 'paredit-warn (if (fboundp 'warn) 'warn 'message))
4.162+
4.163+ (defvar paredit-sexp-error-type
4.164+ (with-temp-buffer
4.165+ (insert "(")
4.166+ (condition-case condition
4.167+ (backward-sexp)
4.168+ (error (if (eq (car condition) 'error)
4.169+ (paredit-warn "%s%s%s%s%s"
4.170+ "Paredit is unable to discriminate"
4.171+ " S-expression parse errors from"
4.172+ " other errors. "
4.173+ " This may cause obscure problems. "
4.174+ " Please upgrade Emacs."))
4.175+ (car condition)))))
4.176+
4.177+ (defmacro paredit-handle-sexp-errors (body &rest handler)
4.178+ `(condition-case ()
4.179+ ,body
4.180+ (,paredit-sexp-error-type ,@handler)))
4.181+
4.182+ (put 'paredit-handle-sexp-errors 'lisp-indent-function 1)
4.183+
4.184+ (defmacro paredit-ignore-sexp-errors (&rest body)
4.185+ `(paredit-handle-sexp-errors (progn ,@body)
4.186+ nil))
4.187+
4.188+ (put 'paredit-ignore-sexp-errors 'lisp-indent-function 0)
4.189+
4.190+ (defmacro paredit-preserving-column (&rest body)
4.191+ "Evaluate BODY and restore point to former column, relative to code.
4.192+Assumes BODY will change only indentation.
4.193+If point was on code, it moves with the code.
4.194+If point was on indentation, it stays in indentation."
4.195+ (let ((column (make-symbol "column"))
4.196+ (indentation (make-symbol "indentation")))
4.197+ `(let ((,column (paredit-current-column))
4.198+ (,indentation (paredit-current-indentation)))
4.199+ (let ((value (progn ,@body)))
4.200+ (paredit-restore-column ,column ,indentation)
4.201+ value))))
4.202+
4.203+ (put 'paredit-preserving-column 'lisp-indent-function 0)
4.204+
4.205+ nil)
4.206+
4.207+;;;; Minor Mode Definition
4.208+
4.209+(defvar paredit-lighter " Paredit"
4.210+ "Mode line lighter Paredit Mode.")
4.211+
4.212+(defvar paredit-mode-map (make-sparse-keymap)
4.213+ "Keymap for the paredit minor mode.")
4.214+
4.215+(defvar paredit-override-check-parens-function
4.216+ (lambda (condition) (declare ignore condition) nil)
4.217+ "Function to tell whether unbalanced text should inhibit Paredit Mode.")
4.218+
4.219+;;;###autoload
4.220+(define-minor-mode paredit-mode
4.221+ "Minor mode for pseudo-structurally editing Lisp code.
4.222+With a prefix argument, enable Paredit Mode even if there are
4.223+ unbalanced parentheses in the buffer.
4.224+Paredit behaves badly if parentheses are unbalanced, so exercise
4.225+ caution when forcing Paredit Mode to be enabled, and consider
4.226+ fixing unbalanced parentheses instead.
4.227+\\<paredit-mode-map>"
4.228+ :lighter paredit-lighter
4.229+ ;; Setting `paredit-mode' to false here aborts enabling Paredit Mode.
4.230+ (if (and paredit-mode
4.231+ (not current-prefix-arg))
4.232+ (condition-case condition
4.233+ (check-parens)
4.234+ (error
4.235+ (if (not (funcall paredit-override-check-parens-function condition))
4.236+ (progn (setq paredit-mode nil)
4.237+ (signal (car condition) (cdr condition))))))))
4.238+
4.239+(defun paredit-override-check-parens-interactively (condition)
4.240+ (y-or-n-p (format "Enable Paredit Mode despite condition %S? " condition)))
4.241+
4.242+;;;###autoload
4.243+(defun enable-paredit-mode ()
4.244+ "Turn on pseudo-structural editing of Lisp code."
4.245+ (interactive)
4.246+ (paredit-mode +1))
4.247+
4.248+(defun disable-paredit-mode ()
4.249+ "Turn off pseudo-structural editing of Lisp code."
4.250+ (interactive)
4.251+ (paredit-mode -1))
4.252+
4.253+(defvar paredit-backward-delete-key
4.254+ (xcond ((paredit-xemacs-p) "BS")
4.255+ ((paredit-gnu-emacs-p) "DEL")))
4.256+
4.257+(defvar paredit-forward-delete-keys
4.258+ (xcond ((paredit-xemacs-p) '("DEL"))
4.259+ ((paredit-gnu-emacs-p) '("<delete>" "<deletechar>"))))
4.260+
4.261+;;;; Paredit Keys
4.262+
4.263+;;; Separating the definition and initialization of this variable
4.264+;;; simplifies the development of paredit, since re-evaluating DEFVAR
4.265+;;; forms doesn't actually do anything.
4.266+
4.267+(defvar paredit-commands nil
4.268+ "List of paredit commands with their keys and examples.")
4.269+
4.270+;;; Each specifier is of the form:
4.271+;;; (key[s] function (example-input example-output) ...)
4.272+;;; where key[s] is either a single string suitable for passing to KBD
4.273+;;; or a list of such strings. Entries in this list may also just be
4.274+;;; strings, in which case they are headings for the next entries.
4.275+
4.276+(progn (setq paredit-commands
4.277+ `(
4.278+ "Basic Insertion Commands"
4.279+ ("(" paredit-open-round
4.280+ ("(a b |c d)"
4.281+ "(a b (|) c d)")
4.282+ ("(foo \"bar |baz\" quux)"
4.283+ "(foo \"bar (|baz\" quux)"))
4.284+ (")" paredit-close-round
4.285+ ("(a b |c )" "(a b c)|")
4.286+ ("; Hello,| world!"
4.287+ "; Hello,)| world!"))
4.288+ ("M-)" paredit-close-round-and-newline
4.289+ ("(defun f (x| ))"
4.290+ "(defun f (x)\n |)")
4.291+ ("; (Foo.|"
4.292+ "; (Foo.)|"))
4.293+ ("[" paredit-open-square
4.294+ ("(a b |c d)"
4.295+ "(a b [|] c d)")
4.296+ ("(foo \"bar |baz\" quux)"
4.297+ "(foo \"bar [|baz\" quux)"))
4.298+ ("]" paredit-close-square
4.299+ ("(define-key keymap [frob| ] 'frobnicate)"
4.300+ "(define-key keymap [frob]| 'frobnicate)")
4.301+ ("; [Bar.|"
4.302+ "; [Bar.]|"))
4.303+
4.304+ ("\"" paredit-doublequote
4.305+ ("(frob grovel |full lexical)"
4.306+ "(frob grovel \"|\" full lexical)"
4.307+ "(frob grovel \"\"| full lexical)")
4.308+ ("(foo \"bar |baz\" quux)"
4.309+ "(foo \"bar \\\"|baz\" quux)")
4.310+ ("(frob grovel) ; full |lexical"
4.311+ "(frob grovel) ; full \"|lexical"))
4.312+ ("M-\"" paredit-meta-doublequote
4.313+ ("(foo \"bar |baz\" quux)"
4.314+ "(foo \"bar baz\"| quux)")
4.315+ ("(foo |(bar #\\x \"baz \\\\ quux\") zot)"
4.316+ ,(concat "(foo \"|(bar #\\\\x \\\"baz \\\\"
4.317+ "\\\\ quux\\\")\" zot)")))
4.318+ ("\\" paredit-backslash
4.319+ ("(string #|)\n ; Character to escape: x"
4.320+ "(string #\\x|)")
4.321+ ("\"foo|bar\"\n ; Character to escape: \""
4.322+ "\"foo\\\"|bar\""))
4.323+ (";" paredit-semicolon
4.324+ ("|(frob grovel)"
4.325+ ";|(frob grovel)")
4.326+ ("(frob |grovel)"
4.327+ "(frob ;|grovel\n )")
4.328+ ("(frob |grovel (bloit\n zargh))"
4.329+ "(frob ;|grovel\n (bloit\n zargh))")
4.330+ ("(frob grovel) |"
4.331+ "(frob grovel) ;|"))
4.332+ ("M-;" paredit-comment-dwim
4.333+ ("(foo |bar) ; baz"
4.334+ "(foo bar) ; |baz")
4.335+ ("(frob grovel)|"
4.336+ "(frob grovel) ;|")
4.337+ ("(zot (foo bar)\n|\n (baz quux))"
4.338+ "(zot (foo bar)\n ;; |\n (baz quux))")
4.339+ ("(zot (foo bar) |(baz quux))"
4.340+ "(zot (foo bar)\n ;; |\n (baz quux))")
4.341+ ("|(defun hello-world ...)"
4.342+ ";;; |\n(defun hello-world ...)"))
4.343+
4.344+ (() paredit-newline
4.345+ ("(let ((n (frobbotz))) |(display (+ n 1)\nport))"
4.346+ ,(concat "(let ((n (frobbotz)))"
4.347+ "\n |(display (+ n 1)"
4.348+ "\n port))")))
4.349+ ("RET" paredit-RET)
4.350+ ("C-j" paredit-C-j)
4.351+
4.352+ "Deleting & Killing"
4.353+ (,paredit-forward-delete-keys
4.354+ paredit-forward-delete
4.355+ ("(quu|x \"zot\")" "(quu| \"zot\")")
4.356+ ("(quux |\"zot\")"
4.357+ "(quux \"|zot\")"
4.358+ "(quux \"|ot\")")
4.359+ ("(foo (|) bar)" "(foo | bar)")
4.360+ ("|(foo bar)" "(|foo bar)"))
4.361+ (,paredit-backward-delete-key
4.362+ paredit-backward-delete
4.363+ ("(\"zot\" q|uux)" "(\"zot\" |uux)")
4.364+ ("(\"zot\"| quux)"
4.365+ "(\"zot|\" quux)"
4.366+ "(\"zo|\" quux)")
4.367+ ("(foo (|) bar)" "(foo | bar)")
4.368+ ("(foo bar)|" "(foo bar|)"))
4.369+ ("C-d" paredit-delete-char
4.370+ ("(quu|x \"zot\")" "(quu| \"zot\")")
4.371+ ("(quux |\"zot\")"
4.372+ "(quux \"|zot\")"
4.373+ "(quux \"|ot\")")
4.374+ ("(foo (|) bar)" "(foo | bar)")
4.375+ ("|(foo bar)" "(|foo bar)"))
4.376+ ("C-k" paredit-kill
4.377+ ("(foo bar)| ; Useless comment!"
4.378+ "(foo bar)|")
4.379+ ("(|foo bar) ; Useful comment!"
4.380+ "(|) ; Useful comment!")
4.381+ ("|(foo bar) ; Useless line!"
4.382+ "|")
4.383+ ("(foo \"|bar baz\"\n quux)"
4.384+ "(foo \"|\"\n quux)"))
4.385+ ("M-d" paredit-forward-kill-word
4.386+ ("|(foo bar) ; baz"
4.387+ "(| bar) ; baz"
4.388+ "(|) ; baz"
4.389+ "() ;|")
4.390+ (";;;| Frobnicate\n(defun frobnicate ...)"
4.391+ ";;;|\n(defun frobnicate ...)"
4.392+ ";;;\n(| frobnicate ...)"))
4.393+ (,(concat "M-" paredit-backward-delete-key)
4.394+ paredit-backward-kill-word
4.395+ ("(foo bar) ; baz\n(quux)|"
4.396+ "(foo bar) ; baz\n(|)"
4.397+ "(foo bar) ; |\n()"
4.398+ "(foo |) ; \n()"
4.399+ "(|) ; \n()"))
4.400+
4.401+ "Movement & Navigation"
4.402+ ("C-M-f" paredit-forward
4.403+ ("(foo |(bar baz) quux)"
4.404+ "(foo (bar baz)| quux)")
4.405+ ("(foo (bar)|)"
4.406+ "(foo (bar))|"))
4.407+ ("C-M-b" paredit-backward
4.408+ ("(foo (bar baz)| quux)"
4.409+ "(foo |(bar baz) quux)")
4.410+ ("(|(foo) bar)"
4.411+ "|((foo) bar)"))
4.412+ ("C-M-u" paredit-backward-up)
4.413+ ("C-M-d" paredit-forward-down)
4.414+ ("C-M-p" paredit-backward-down) ; Built-in, these are FORWARD-
4.415+ ("C-M-n" paredit-forward-up) ; & BACKWARD-LIST, which have
4.416+ ; no need given C-M-f & C-M-b.
4.417+
4.418+ "Depth-Changing Commands"
4.419+ ("M-(" paredit-wrap-round
4.420+ ("(foo |bar baz)"
4.421+ "(foo (|bar) baz)"))
4.422+ ("M-s" paredit-splice-sexp
4.423+ ("(foo (bar| baz) quux)"
4.424+ "(foo bar| baz quux)"))
4.425+ (("M-<up>" "ESC <up>")
4.426+ paredit-splice-sexp-killing-backward
4.427+ ("(foo (let ((x 5)) |(sqrt n)) bar)"
4.428+ "(foo |(sqrt n) bar)"))
4.429+ (("M-<down>" "ESC <down>")
4.430+ paredit-splice-sexp-killing-forward
4.431+ ("(a (b c| d e) f)"
4.432+ "(a b c| f)"))
4.433+ ("M-r" paredit-raise-sexp
4.434+ ("(dynamic-wind in (lambda () |body) out)"
4.435+ "(dynamic-wind in |body out)"
4.436+ "|body"))
4.437+ ("M-?" paredit-convolute-sexp
4.438+ ("(let ((x 5) (y 3)) (frob |(zwonk)) (wibblethwop))"
4.439+ "(frob |(let ((x 5) (y 3)) (zwonk) (wibblethwop)))"))
4.440+
4.441+ "Barfage & Slurpage"
4.442+ (("C-)" "C-<right>")
4.443+ paredit-forward-slurp-sexp
4.444+ ("(foo (bar |baz) quux zot)"
4.445+ "(foo (bar |baz quux) zot)")
4.446+ ("(a b ((c| d)) e f)"
4.447+ "(a b ((c| d) e) f)"))
4.448+ (("C-}" "C-<left>")
4.449+ paredit-forward-barf-sexp
4.450+ ("(foo (bar |baz quux) zot)"
4.451+ "(foo (bar |baz) quux zot)"))
4.452+ (("C-(" "C-M-<left>" "ESC C-<left>")
4.453+ paredit-backward-slurp-sexp
4.454+ ("(foo bar (baz| quux) zot)"
4.455+ "(foo (bar baz| quux) zot)")
4.456+ ("(a b ((c| d)) e f)"
4.457+ "(a (b (c| d)) e f)"))
4.458+ (("C-{" "C-M-<right>" "ESC C-<right>")
4.459+ paredit-backward-barf-sexp
4.460+ ("(foo (bar baz |quux) zot)"
4.461+ "(foo bar (baz |quux) zot)"))
4.462+
4.463+ "Miscellaneous Commands"
4.464+ ("M-S" paredit-split-sexp
4.465+ ("(hello| world)"
4.466+ "(hello)| (world)")
4.467+ ("\"Hello, |world!\""
4.468+ "\"Hello, \"| \"world!\""))
4.469+ ("M-J" paredit-join-sexps
4.470+ ("(hello)| (world)"
4.471+ "(hello| world)")
4.472+ ("\"Hello, \"| \"world!\""
4.473+ "\"Hello, |world!\"")
4.474+ ("hello-\n| world"
4.475+ "hello-|world"))
4.476+ ("C-c C-M-l" paredit-recenter-on-sexp)
4.477+ ("M-q" paredit-reindent-defun)
4.478+ ))
4.479+ nil) ; end of PROGN
4.480+
4.481+;;;;; Command Examples
4.482+
4.483+(eval-and-compile
4.484+ (defmacro paredit-do-commands (vars string-case &rest body)
4.485+ (let ((spec (nth 0 vars))
4.486+ (keys (nth 1 vars))
4.487+ (fn (nth 2 vars))
4.488+ (examples (nth 3 vars)))
4.489+ `(dolist (,spec paredit-commands)
4.490+ (if (stringp ,spec)
4.491+ ,string-case
4.492+ (let ((,keys (let ((k (car ,spec)))
4.493+ (cond ((stringp k) (list k))
4.494+ ((listp k) k)
4.495+ (t (error "Invalid paredit command %s."
4.496+ ,spec)))))
4.497+ (,fn (cadr ,spec))
4.498+ (,examples (cddr ,spec)))
4.499+ ,@body)))))
4.500+
4.501+ (put 'paredit-do-commands 'lisp-indent-function 2))
4.502+
4.503+(defun paredit-define-keys ()
4.504+ (paredit-do-commands (spec keys fn examples)
4.505+ nil ; string case
4.506+ (dolist (key keys)
4.507+ (define-key paredit-mode-map (read-kbd-macro key) fn))))
4.508+
4.509+(defun paredit-function-documentation (fn)
4.510+ (let ((original-doc (get fn 'paredit-original-documentation))
4.511+ (doc (documentation fn 'function-documentation)))
4.512+ (or original-doc
4.513+ (progn (put fn 'paredit-original-documentation doc)
4.514+ doc))))
4.515+
4.516+(defun paredit-annotate-mode-with-examples ()
4.517+ (let ((contents
4.518+ (list (paredit-function-documentation 'paredit-mode))))
4.519+ (paredit-do-commands (spec keys fn examples)
4.520+ (push (concat "\n \n" spec "\n")
4.521+ contents)
4.522+ (let ((name (symbol-name fn)))
4.523+ (if (string-match (symbol-name 'paredit-) name)
4.524+ (push (concat "\n\n\\[" name "]\t" name
4.525+ (if examples
4.526+ (mapconcat (lambda (example)
4.527+ (concat
4.528+ "\n"
4.529+ (mapconcat 'identity
4.530+ example
4.531+ "\n --->\n")
4.532+ "\n"))
4.533+ examples
4.534+ "")
4.535+ "\n (no examples)\n"))
4.536+ contents))))
4.537+ (put 'paredit-mode 'function-documentation
4.538+ (apply 'concat (reverse contents))))
4.539+ ;; PUT returns the huge string we just constructed, which we don't
4.540+ ;; want it to return.
4.541+ nil)
4.542+
4.543+(defun paredit-annotate-functions-with-examples ()
4.544+ (paredit-do-commands (spec keys fn examples)
4.545+ nil ; string case
4.546+ (put fn 'function-documentation
4.547+ (concat (paredit-function-documentation fn)
4.548+ "\n\n\\<paredit-mode-map>\\[" (symbol-name fn) "]\n"
4.549+ (mapconcat (lambda (example)
4.550+ (concat "\n"
4.551+ (mapconcat 'identity
4.552+ example
4.553+ "\n ->\n")
4.554+ "\n"))
4.555+ examples
4.556+ "")))))
4.557+
4.558+;;;;; HTML Examples
4.559+
4.560+(defun paredit-insert-html-examples ()
4.561+ "Insert HTML for a paredit quick reference table."
4.562+ (interactive)
4.563+ (let ((insert-lines
4.564+ (lambda (&rest lines) (dolist (line lines) (insert line) (newline))))
4.565+ (initp nil))
4.566+ (paredit-do-commands (spec keys fn examples)
4.567+ (progn (if initp
4.568+ (funcall insert-lines "</table>")
4.569+ (setq initp t))
4.570+ (funcall insert-lines (concat "<h3>" spec "</h3>"))
4.571+ (funcall insert-lines "<table>"))
4.572+ (let ((name (symbol-name fn))
4.573+ (keys
4.574+ (mapconcat (lambda (key)
4.575+ (concat "<tt>" (paredit-html-quote key) "</tt>"))
4.576+ keys
4.577+ ", ")))
4.578+ (funcall insert-lines "<tr>")
4.579+ (funcall insert-lines (concat " <th align=\"left\">" keys "</th>"))
4.580+ (funcall insert-lines (concat " <th align=\"left\">" name "</th>"))
4.581+ (funcall insert-lines "</tr>")
4.582+ (funcall insert-lines
4.583+ "<tr><td colspan=\"2\"><table cellpadding=\"5\"><tr>")
4.584+ (dolist (example examples)
4.585+ (let ((prefix "<td><table border=\"1\"><tr><td><table><tr><td><pre>")
4.586+ (examples
4.587+ (mapconcat 'paredit-html-quote
4.588+ example
4.589+ (concat "</pre></td></tr>"
4.590+ "<tr><th>↓</th></tr>"
4.591+ "<tr><td><pre>")))
4.592+ (suffix "</pre></td></tr></table></td></tr></table></td>"))
4.593+ (funcall insert-lines (concat prefix examples suffix))))
4.594+ (funcall insert-lines "</tr></table></td></tr>")))
4.595+ (funcall insert-lines "</table>")))
4.596+
4.597+(defun paredit-html-quote (string)
4.598+ (with-temp-buffer
4.599+ (dotimes (i (length string))
4.600+ (insert (let ((c (elt string i)))
4.601+ (cond ((eq c ?\<) "<")
4.602+ ((eq c ?\>) ">")
4.603+ ((eq c ?\&) "&")
4.604+ ((eq c ?\') "'")
4.605+ ((eq c ?\") """)
4.606+ (t c)))))
4.607+ (buffer-string)))
4.608+
4.609+;;;; Delimiter Insertion
4.610+
4.611+(eval-and-compile
4.612+ (defun paredit-conc-name (&rest strings)
4.613+ (intern (apply 'concat strings)))
4.614+
4.615+ (defmacro define-paredit-pair (open close name)
4.616+ `(progn
4.617+ (defun ,(paredit-conc-name "paredit-open-" name) (&optional n)
4.618+ ,(concat "Insert a balanced " name " pair.
4.619+With a prefix argument N, put the closing " name " after N
4.620+ S-expressions forward.
4.621+If the region is active, `transient-mark-mode' is enabled, and the
4.622+ region's start and end fall in the same parenthesis depth, insert a
4.623+ " name " pair around the region.
4.624+If in a string or a comment, insert a single " name ".
4.625+If in a character literal, do nothing. This prevents changing what was
4.626+ in the character literal to a meaningful delimiter unintentionally.")
4.627+ (interactive "P")
4.628+ (cond ((or (paredit-in-string-p)
4.629+ (paredit-in-comment-p))
4.630+ (insert ,open))
4.631+ ((not (paredit-in-char-p))
4.632+ (paredit-insert-pair n ,open ,close 'goto-char)
4.633+ (save-excursion (backward-up-list) (indent-sexp)))))
4.634+ (defun ,(paredit-conc-name "paredit-close-" name) ()
4.635+ ,(concat "Move past one closing delimiter and reindent.
4.636+\(Agnostic to the specific closing delimiter.)
4.637+If in a string or comment, insert a single closing " name ".
4.638+If in a character literal, do nothing. This prevents changing what was
4.639+ in the character literal to a meaningful delimiter unintentionally.")
4.640+ (interactive)
4.641+ (paredit-move-past-close ,close))
4.642+ (defun ,(paredit-conc-name "paredit-close-" name "-and-newline") ()
4.643+ ,(concat "Move past one closing delimiter, add a newline,"
4.644+ " and reindent.
4.645+If there was a margin comment after the closing delimiter, preserve it
4.646+ on the same line.")
4.647+ (interactive)
4.648+ (paredit-move-past-close-and-newline ,close))
4.649+ (defun ,(paredit-conc-name "paredit-wrap-" name)
4.650+ (&optional argument)
4.651+ ,(concat "Wrap the following S-expression.
4.652+See `paredit-wrap-sexp' for more details.")
4.653+ (interactive "P")
4.654+ (paredit-wrap-sexp argument ,open ,close))
4.655+ (add-to-list 'paredit-wrap-commands
4.656+ ',(paredit-conc-name "paredit-wrap-" name)))))
4.657+
4.658+(defvar paredit-wrap-commands '(paredit-wrap-sexp)
4.659+ "List of paredit commands that wrap S-expressions.
4.660+Used by `paredit-yank-pop'; for internal paredit use only.")
4.661+
4.662+(define-paredit-pair ?\( ?\) "round")
4.663+(define-paredit-pair ?\[ ?\] "square")
4.664+(define-paredit-pair ?\{ ?\} "curly")
4.665+(define-paredit-pair ?\< ?\> "angled")
4.666+
4.667+;;; Aliases for the old names.
4.668+
4.669+(defalias 'paredit-open-parenthesis 'paredit-open-round)
4.670+(defalias 'paredit-close-parenthesis 'paredit-close-round)
4.671+(defalias 'paredit-close-parenthesis-and-newline
4.672+ 'paredit-close-round-and-newline)
4.673+
4.674+(defalias 'paredit-open-bracket 'paredit-open-square)
4.675+(defalias 'paredit-close-bracket 'paredit-close-square)
4.676+(defalias 'paredit-close-bracket-and-newline
4.677+ 'paredit-close-square-and-newline)
4.678+
4.679+(defun paredit-move-past-close (close)
4.680+ (paredit-move-past-close-and close
4.681+ (lambda ()
4.682+ (paredit-blink-paren-match nil))))
4.683+
4.684+(defun paredit-move-past-close-and-newline (close)
4.685+ (paredit-move-past-close-and close
4.686+ (lambda ()
4.687+ (let ((comment.point (paredit-find-comment-on-line)))
4.688+ (newline)
4.689+ (if comment.point
4.690+ (save-excursion
4.691+ (forward-line -1)
4.692+ (end-of-line)
4.693+ (indent-to (cdr comment.point))
4.694+ (insert (car comment.point)))))
4.695+ (lisp-indent-line)
4.696+ (paredit-ignore-sexp-errors (indent-sexp))
4.697+ (paredit-blink-paren-match t))))
4.698+
4.699+(defun paredit-move-past-close-and (close if-moved)
4.700+ (if (or (paredit-in-string-p)
4.701+ (paredit-in-comment-p))
4.702+ (insert close)
4.703+ (if (paredit-in-char-p) (forward-char))
4.704+ (paredit-move-past-close-and-reindent close)
4.705+ (funcall if-moved)))
4.706+
4.707+(defun paredit-find-comment-on-line ()
4.708+ "Find a margin comment on the current line.
4.709+Return nil if there is no such comment or if there is anything but
4.710+ whitespace until such a comment.
4.711+If such a comment exists, delete the comment (including all leading
4.712+ whitespace) and return a cons whose car is the comment as a string
4.713+ and whose cdr is the point of the comment's initial semicolon,
4.714+ relative to the start of the line."
4.715+ (save-excursion
4.716+ (paredit-skip-whitespace t (point-at-eol))
4.717+ (and (eq ?\; (char-after))
4.718+ (not (eq ?\; (char-after (1+ (point)))))
4.719+ (not (or (paredit-in-string-p)
4.720+ (paredit-in-char-p)))
4.721+ (let* ((start ;Move to before the semicolon.
4.722+ (progn (backward-char) (point)))
4.723+ (comment
4.724+ (buffer-substring start (point-at-eol))))
4.725+ (paredit-skip-whitespace nil (point-at-bol))
4.726+ (delete-region (point) (point-at-eol))
4.727+ (cons comment (- start (point-at-bol)))))))
4.728+
4.729+(defun paredit-insert-pair (n open close forward)
4.730+ (let* ((regionp
4.731+ (and (paredit-region-active-p)
4.732+ (paredit-region-safe-for-insert-p)))
4.733+ (end
4.734+ (and regionp
4.735+ (not n)
4.736+ (prog1 (region-end) (goto-char (region-beginning))))))
4.737+ (let ((spacep (paredit-space-for-delimiter-p nil open)))
4.738+ (if spacep (insert " "))
4.739+ (insert open)
4.740+ (save-excursion
4.741+ ;; Move past the desired region.
4.742+ (cond (n
4.743+ (funcall forward
4.744+ (paredit-scan-sexps-hack (point)
4.745+ (prefix-numeric-value n))))
4.746+ (regionp
4.747+ (funcall forward (+ end (if spacep 2 1)))))
4.748+ ;; The string case can happen if we are inserting string
4.749+ ;; delimiters. The comment case may happen by moving to the
4.750+ ;; end of a buffer that has a comment with no trailing newline.
4.751+ (if (and (not (paredit-in-string-p))
4.752+ (paredit-in-comment-p))
4.753+ (newline))
4.754+ (insert close)
4.755+ (if (paredit-space-for-delimiter-p t close)
4.756+ (insert " "))))))
4.757+
4.758+;++ This needs a better name...
4.759+
4.760+(defun paredit-scan-sexps-hack (point n)
4.761+ (save-excursion
4.762+ (goto-char point)
4.763+ (let ((direction (if (< 0 n) +1 -1))
4.764+ (magnitude (abs n))
4.765+ (count 0))
4.766+ (catch 'exit
4.767+ (while (< count magnitude)
4.768+ (let ((p
4.769+ (paredit-handle-sexp-errors (scan-sexps (point) direction)
4.770+ nil)))
4.771+ (if (not p) (throw 'exit nil))
4.772+ (goto-char p))
4.773+ (setq count (+ count 1)))))
4.774+ (point)))
4.775+
4.776+(defun paredit-region-safe-for-insert-p ()
4.777+ (save-excursion
4.778+ (let ((beginning (region-beginning))
4.779+ (end (region-end)))
4.780+ (goto-char beginning)
4.781+ (let* ((beginning-state (paredit-current-parse-state))
4.782+ (end-state
4.783+ (parse-partial-sexp beginning end nil nil beginning-state)))
4.784+ (and (= (nth 0 beginning-state) ; 0. depth in parens
4.785+ (nth 0 end-state))
4.786+ (eq (nth 3 beginning-state) ; 3. non-nil if inside a
4.787+ (nth 3 end-state)) ; string
4.788+ (eq (nth 4 beginning-state) ; 4. comment status, yada
4.789+ (nth 4 end-state))
4.790+ (eq (nth 5 beginning-state) ; 5. t if following char
4.791+ (nth 5 end-state))))))) ; quote
4.792+
4.793+(defvar paredit-space-for-delimiter-predicates nil
4.794+ "List of predicates for whether to put space by delimiter at point.
4.795+Each predicate is a function that is is applied to two arguments, ENDP
4.796+ and DELIMITER, and that returns a boolean saying whether to put a
4.797+ space next to the delimiter -- before/after the delimiter if ENDP is
4.798+ false/true, respectively.
4.799+If any predicate returns false, no space is inserted: every predicate
4.800+ has veto power.
4.801+Each predicate may assume that the point is not at the beginning/end of
4.802+ the buffer, and that the point is preceded/followed by a word
4.803+ constituent, symbol constituent, string quote, or delimiter matching
4.804+ DELIMITER, if ENDP is false/true, respectively.
4.805+Each predicate should examine only text before/after the point if ENDP is
4.806+ false/true, respectively.")
4.807+
4.808+(defun paredit-space-for-delimiter-p (endp delimiter)
4.809+ ;; If at the buffer limit, don't insert a space. If there is a word,
4.810+ ;; symbol, other quote, or non-matching parenthesis delimiter (i.e. a
4.811+ ;; close when want an open the string or an open when we want to
4.812+ ;; close the string), do insert a space.
4.813+ (and (not (if endp (eobp) (bobp)))
4.814+ (memq (char-syntax (if endp (char-after) (char-before)))
4.815+ (list ?w ?_ ?\"
4.816+ (let ((matching (matching-paren delimiter)))
4.817+ (and matching (char-syntax matching)))
4.818+ (and (not endp)
4.819+ (eq ?\" (char-syntax delimiter))
4.820+ ?\) )))
4.821+ (catch 'exit
4.822+ (dolist (predicate paredit-space-for-delimiter-predicates)
4.823+ (if (not (funcall predicate endp delimiter))
4.824+ (throw 'exit nil)))
4.825+ t)))
4.826+
4.827+(defun paredit-move-past-close-and-reindent (close)
4.828+ (let ((open (paredit-missing-close)))
4.829+ (if open
4.830+ (if (eq close (matching-paren open))
4.831+ (save-excursion
4.832+ (message "Missing closing delimiter: %c" close)
4.833+ (insert close))
4.834+ (error "Mismatched missing closing delimiter: %c ... %c"
4.835+ open close))))
4.836+ (up-list)
4.837+ (if (catch 'return ; This CATCH returns T if it
4.838+ (while t ; should delete leading spaces
4.839+ (save-excursion ; and NIL if not.
4.840+ (let ((before-paren (1- (point))))
4.841+ (back-to-indentation)
4.842+ (cond ((not (eq (point) before-paren))
4.843+ ;; Can't call PAREDIT-DELETE-LEADING-WHITESPACE
4.844+ ;; here -- we must return from SAVE-EXCURSION
4.845+ ;; first.
4.846+ (throw 'return t))
4.847+ ((save-excursion (forward-line -1)
4.848+ (end-of-line)
4.849+ (paredit-in-comment-p))
4.850+ ;; Moving the closing delimiter any further
4.851+ ;; would put it into a comment, so we just
4.852+ ;; indent the closing delimiter where it is and
4.853+ ;; abort the loop, telling its continuation that
4.854+ ;; no leading whitespace should be deleted.
4.855+ (lisp-indent-line)
4.856+ (throw 'return nil))
4.857+ (t (delete-indentation)))))))
4.858+ (paredit-delete-leading-whitespace)))
4.859+
4.860+(defun paredit-missing-close ()
4.861+ (save-excursion
4.862+ (paredit-handle-sexp-errors (backward-up-list)
4.863+ (error "Not inside a list."))
4.864+ (let ((open (char-after)))
4.865+ (paredit-handle-sexp-errors (progn (forward-sexp) nil)
4.866+ open))))
4.867+
4.868+(defun paredit-delete-leading-whitespace ()
4.869+ ;; This assumes that we're on the closing delimiter already.
4.870+ (save-excursion
4.871+ (backward-char)
4.872+ (while (let ((syn (char-syntax (char-before))))
4.873+ (and (or (eq syn ?\ ) (eq syn ?-)) ; whitespace syntax
4.874+ ;; The above line is a perfect example of why the
4.875+ ;; following test is necessary.
4.876+ (not (paredit-in-char-p (1- (point))))))
4.877+ (delete-char -1))))
4.878+
4.879+(defun paredit-blink-paren-match (another-line-p)
4.880+ (if (and blink-matching-paren
4.881+ (or (not show-paren-mode) another-line-p))
4.882+ (paredit-ignore-sexp-errors
4.883+ (save-excursion
4.884+ (backward-sexp)
4.885+ (forward-sexp)
4.886+ ;; SHOW-PAREN-MODE inhibits any blinking, so we disable it
4.887+ ;; locally here.
4.888+ (let ((show-paren-mode nil))
4.889+ (blink-matching-open))))))
4.890+
4.891+(defun paredit-doublequote (&optional n)
4.892+ "Insert a pair of double-quotes.
4.893+With a prefix argument N, wrap the following N S-expressions in
4.894+ double-quotes, escaping intermediate characters if necessary.
4.895+If the region is active, `transient-mark-mode' is enabled, and the
4.896+ region's start and end fall in the same parenthesis depth, insert a
4.897+ pair of double-quotes around the region, again escaping intermediate
4.898+ characters if necessary.
4.899+Inside a comment, insert a literal double-quote.
4.900+At the end of a string, move past the closing double-quote.
4.901+In the middle of a string, insert a backslash-escaped double-quote.
4.902+If in a character literal, do nothing. This prevents accidentally
4.903+ changing a what was in the character literal to become a meaningful
4.904+ delimiter unintentionally."
4.905+ (interactive "P")
4.906+ (cond ((paredit-in-string-p)
4.907+ (if (eq (point) (- (paredit-enclosing-string-end) 1))
4.908+ (forward-char) ; Just move past the closing quote.
4.909+ ;; Don't split a \x into an escaped backslash and a string end.
4.910+ (if (paredit-in-string-escape-p) (forward-char))
4.911+ (insert ?\\ ?\" )))
4.912+ ((paredit-in-comment-p)
4.913+ (insert ?\" ))
4.914+ ((not (paredit-in-char-p))
4.915+ (paredit-insert-pair n ?\" ?\" 'paredit-forward-for-quote))))
4.916+
4.917+(defun paredit-meta-doublequote (&optional n)
4.918+ "Move to the end of the string.
4.919+If not in a string, act as `paredit-doublequote'; if no prefix argument
4.920+ is specified and the region is not active or `transient-mark-mode' is
4.921+ disabled, the default is to wrap one S-expression, however, not zero."
4.922+ (interactive "P")
4.923+ (if (not (paredit-in-string-p))
4.924+ (paredit-doublequote (or n (and (not (paredit-region-active-p)) 1)))
4.925+ (goto-char (paredit-enclosing-string-end))))
4.926+
4.927+(defun paredit-meta-doublequote-and-newline (&optional n)
4.928+ "Move to the end of the string, insert a newline, and indent.
4.929+If not in a string, act as `paredit-doublequote'; if no prefix argument
4.930+ is specified and the region is not active or `transient-mark-mode' is
4.931+ disabled, the default is to wrap one S-expression, however, not zero."
4.932+ (interactive "P")
4.933+ (if (not (paredit-in-string-p))
4.934+ (paredit-doublequote (or n (and (not (paredit-region-active-p)) 1)))
4.935+ (progn (goto-char (paredit-enclosing-string-end))
4.936+ (newline)
4.937+ (lisp-indent-line)
4.938+ (paredit-ignore-sexp-errors (indent-sexp)))))
4.939+
4.940+(defun paredit-forward-for-quote (end)
4.941+ (let ((state (paredit-current-parse-state)))
4.942+ (while (< (point) end)
4.943+ (let ((new-state (parse-partial-sexp (point) (1+ (point))
4.944+ nil nil state)))
4.945+ (if (paredit-in-string-p new-state)
4.946+ (if (not (paredit-in-string-escape-p))
4.947+ (setq state new-state)
4.948+ ;; Escape character: turn it into an escaped escape
4.949+ ;; character by appending another backslash.
4.950+ (insert ?\\ )
4.951+ ;; Now the point is after both escapes, and we want to
4.952+ ;; rescan from before the first one to after the second
4.953+ ;; one.
4.954+ (setq state
4.955+ (parse-partial-sexp (- (point) 2) (point)
4.956+ nil nil state))
4.957+ ;; Advance the end point, since we just inserted a new
4.958+ ;; character.
4.959+ (setq end (1+ end)))
4.960+ ;; String: escape by inserting a backslash before the quote.
4.961+ (backward-char)
4.962+ (insert ?\\ )
4.963+ ;; The point is now between the escape and the quote, and we
4.964+ ;; want to rescan from before the escape to after the quote.
4.965+ (setq state
4.966+ (parse-partial-sexp (1- (point)) (1+ (point))
4.967+ nil nil state))
4.968+ ;; Advance the end point for the same reason as above.
4.969+ (setq end (1+ end)))))))
4.970+
4.971+;;;; Escape Insertion
4.972+
4.973+(defun paredit-backslash ()
4.974+ "Insert a backslash followed by a character to escape."
4.975+ (interactive)
4.976+ (cond ((paredit-in-string-p) (paredit-backslash-interactive))
4.977+ ((paredit-in-comment-p) (insert ?\\))
4.978+ ((paredit-in-char-p) (forward-char) (paredit-backslash-interactive))
4.979+ (t (paredit-backslash-interactive))))
4.980+
4.981+(defun paredit-backslash-interactive ()
4.982+ (insert ?\\ )
4.983+ ;; Read a character to insert after the backslash. If anything
4.984+ ;; goes wrong -- the user hits delete (entering the rubout
4.985+ ;; `character'), aborts with C-g, or enters non-character input
4.986+ ;; -- then delete the backslash to avoid a dangling escape.
4.987+ (let ((delete-p t))
4.988+ (unwind-protect
4.989+ (let ((char (read-char "Character to escape: " t)))
4.990+ (if (not (eq char ?\^?))
4.991+ (progn (message "Character to escape: %c" char)
4.992+ (insert char)
4.993+ (setq delete-p nil))))
4.994+ (if delete-p
4.995+ (progn (message "Deleting escape.")
4.996+ (delete-char -1))))))
4.997+
4.998+(defun paredit-newline ()
4.999+ "Insert a newline and indent it.
4.1000+This is like `newline-and-indent', but it not only indents the line
4.1001+ that the point is on but also the S-expression following the point,
4.1002+ if there is one.
4.1003+Move forward one character first if on an escaped character.
4.1004+If in a string, just insert a literal newline.
4.1005+If in a comment and if followed by invalid structure, call
4.1006+ `indent-new-comment-line' to keep the invalid structure in a
4.1007+ comment."
4.1008+ (interactive)
4.1009+ (cond ((paredit-in-string-p)
4.1010+ (newline))
4.1011+ ((paredit-in-comment-p)
4.1012+ (if (paredit-region-ok-p (point) (point-at-eol))
4.1013+ (progn (newline-and-indent)
4.1014+ (paredit-ignore-sexp-errors (indent-sexp)))
4.1015+ (indent-new-comment-line)))
4.1016+ (t
4.1017+ (if (paredit-in-char-p)
4.1018+ (forward-char))
4.1019+ (newline-and-indent)
4.1020+ ;; Indent the following S-expression, but don't signal an
4.1021+ ;; error if there's only a closing delimiter after the point.
4.1022+ (paredit-ignore-sexp-errors (indent-sexp)))))
4.1023+
4.1024+(defun paredit-electric-indent-mode-p ()
4.1025+ "True if Electric Indent Mode is on, false if not.
4.1026+Electric Indent Mode is generally not compatible with paredit and
4.1027+ users are advised to disable it, since paredit does essentially
4.1028+ everything it tries to do better.
4.1029+However, to mitigate the negative user experience of combining
4.1030+ Electric Indent Mode with paredit, the default key bindings for
4.1031+ RET and C-j in paredit are exchanged depending on whether
4.1032+ Electric Indent Mode is enabled."
4.1033+ (and (boundp 'electric-indent-mode)
4.1034+ electric-indent-mode))
4.1035+
4.1036+(defun paredit-RET ()
4.1037+ "Default key binding for RET in Paredit Mode.
4.1038+Normally, inserts a newline, like traditional Emacs RET.
4.1039+With Electric Indent Mode enabled, inserts a newline and indents
4.1040+ the new line, as well as any subexpressions of it on subsequent
4.1041+ lines; see `paredit-newline' for details and examples."
4.1042+ (interactive)
4.1043+ (if (paredit-electric-indent-mode-p)
4.1044+ (let ((electric-indent-mode nil))
4.1045+ (paredit-newline))
4.1046+ (newline)))
4.1047+
4.1048+(defun paredit-C-j ()
4.1049+ "Default key binding for C-j in Paredit Mode.
4.1050+Normally, inserts a newline and indents
4.1051+ the new line, as well as any subexpressions of it on subsequent
4.1052+ lines; see `paredit-newline' for details and examples.
4.1053+With Electric Indent Mode enabled, inserts a newline, like
4.1054+ traditional Emacs RET."
4.1055+ (interactive)
4.1056+ (if (paredit-electric-indent-mode-p)
4.1057+ (let ((electric-indent-mode nil))
4.1058+ (newline))
4.1059+ (paredit-newline)))
4.1060+
4.1061+(defun paredit-reindent-defun (&optional argument)
4.1062+ "Reindent the definition that the point is on.
4.1063+If the point is in a string or a comment, fill the paragraph instead,
4.1064+ and with a prefix argument, justify as well."
4.1065+ (interactive "P")
4.1066+ (if (or (paredit-in-string-p)
4.1067+ (paredit-in-comment-p))
4.1068+ (if (memq fill-paragraph-function '(t nil))
4.1069+ (lisp-fill-paragraph argument)
4.1070+ (funcall fill-paragraph-function argument))
4.1071+ (paredit-preserving-column
4.1072+ (save-excursion
4.1073+ (end-of-defun)
4.1074+ (beginning-of-defun)
4.1075+ (indent-sexp)))))
4.1076+
4.1077+;;;; Comment Insertion
4.1078+
4.1079+(defun paredit-semicolon (&optional n)
4.1080+ "Insert a semicolon.
4.1081+With a prefix argument N, insert N semicolons.
4.1082+If in a string, do just that and nothing else.
4.1083+If in a character literal, move to the beginning of the character
4.1084+ literal before inserting the semicolon.
4.1085+If the enclosing list ends on the line after the point, break the line
4.1086+ after the last S-expression following the point.
4.1087+If a list begins on the line after the point but ends on a different
4.1088+ line, break the line after the last S-expression following the point
4.1089+ before the list."
4.1090+ (interactive "p")
4.1091+ (if (or (paredit-in-string-p) (paredit-in-comment-p))
4.1092+ (insert (make-string (or n 1) ?\; ))
4.1093+ (if (paredit-in-char-p)
4.1094+ (backward-char 2))
4.1095+ (let ((line-break-point (paredit-semicolon-find-line-break-point)))
4.1096+ (if line-break-point
4.1097+ (paredit-semicolon-with-line-break line-break-point (or n 1))
4.1098+ (insert (make-string (or n 1) ?\; ))))))
4.1099+
4.1100+(defun paredit-semicolon-find-line-break-point ()
4.1101+ (and (not (eolp)) ;Implies (not (eobp)).
4.1102+ (let ((eol (point-at-eol)))
4.1103+ (save-excursion
4.1104+ (catch 'exit
4.1105+ (while t
4.1106+ (let ((line-break-point (point)))
4.1107+ (cond ((paredit-handle-sexp-errors (progn (forward-sexp) t)
4.1108+ nil)
4.1109+ ;; Successfully advanced by an S-expression.
4.1110+ ;; If that S-expression started on this line
4.1111+ ;; and ended on another one, break here.
4.1112+ (cond ((not (eq eol (point-at-eol)))
4.1113+ (throw 'exit
4.1114+ (and (save-excursion
4.1115+ (backward-sexp)
4.1116+ (eq eol (point-at-eol)))
4.1117+ line-break-point)))
4.1118+ ((eobp)
4.1119+ (throw 'exit nil))))
4.1120+ ((save-excursion
4.1121+ (paredit-skip-whitespace t (point-at-eol))
4.1122+ (or (eolp) (eobp) (eq (char-after) ?\;)))
4.1123+ ;; Can't move further, but there's no closing
4.1124+ ;; delimiter we're about to clobber -- either
4.1125+ ;; it's on the next line or we're at the end of
4.1126+ ;; the buffer. Don't break the line.
4.1127+ (throw 'exit nil))
4.1128+ (t
4.1129+ ;; Can't move because we hit a delimiter at the
4.1130+ ;; end of this line. Break here.
4.1131+ (throw 'exit line-break-point))))))))))
4.1132+
4.1133+(defun paredit-semicolon-with-line-break (line-break-point n)
4.1134+ (let ((line-break-marker (make-marker)))
4.1135+ (set-marker line-break-marker line-break-point)
4.1136+ (set-marker-insertion-type line-break-marker t)
4.1137+ (insert (make-string (or n 1) ?\; ))
4.1138+ (save-excursion
4.1139+ (goto-char line-break-marker)
4.1140+ (set-marker line-break-marker nil)
4.1141+ (newline)
4.1142+ (lisp-indent-line)
4.1143+ ;; This step is redundant if we are inside a list, but even if we
4.1144+ ;; are at the top level, we want at least to indent whatever we
4.1145+ ;; bumped off the line.
4.1146+ (paredit-ignore-sexp-errors (indent-sexp))
4.1147+ (paredit-indent-sexps))))
4.1148+
4.1149+;;; This is all a horrible, horrible hack, primarily for GNU Emacs 21,
4.1150+;;; in which there is no `comment-or-uncomment-region'.
4.1151+
4.1152+(autoload 'comment-forward "newcomment")
4.1153+(autoload 'comment-normalize-vars "newcomment")
4.1154+(autoload 'comment-region "newcomment")
4.1155+(autoload 'comment-search-forward "newcomment")
4.1156+(autoload 'uncomment-region "newcomment")
4.1157+
4.1158+(defun paredit-initialize-comment-dwim ()
4.1159+ (require 'newcomment)
4.1160+ (if (not (fboundp 'comment-or-uncomment-region))
4.1161+ (defalias 'comment-or-uncomment-region
4.1162+ (lambda (beginning end &optional argument)
4.1163+ (interactive "*r\nP")
4.1164+ (if (save-excursion (goto-char beginning)
4.1165+ (comment-forward (point-max))
4.1166+ (<= end (point)))
4.1167+ (uncomment-region beginning end argument)
4.1168+ (comment-region beginning end argument)))))
4.1169+ (defalias 'paredit-initialize-comment-dwim 'comment-normalize-vars)
4.1170+ (comment-normalize-vars))
4.1171+
4.1172+(defvar paredit-comment-prefix-toplevel ";;; "
4.1173+ "String of prefix for top-level comments aligned at the left margin.")
4.1174+
4.1175+(defvar paredit-comment-prefix-code ";; "
4.1176+ "String of prefix for comments indented at the same depth as code.")
4.1177+
4.1178+(defvar paredit-comment-prefix-margin ";"
4.1179+ "String of prefix for comments on the same line as code in the margin.")
4.1180+
4.1181+(defun paredit-comment-dwim (&optional argument)
4.1182+ "Call the Lisp comment command you want (Do What I Mean).
4.1183+This is like `comment-dwim', but it is specialized for Lisp editing.
4.1184+If transient mark mode is enabled and the mark is active, comment or
4.1185+ uncomment the selected region, depending on whether it was entirely
4.1186+ commented not not already.
4.1187+If there is already a comment on the current line, with no prefix
4.1188+ argument, indent to that comment; with a prefix argument, kill that
4.1189+ comment.
4.1190+Otherwise, insert a comment appropriate for the context and ensure that
4.1191+ any code following the comment is moved to the next line.
4.1192+At the top level, where indentation is calculated to be at column 0,
4.1193+ insert a triple-semicolon comment; within code, where the indentation
4.1194+ is calculated to be non-zero, and on the line there is either no code
4.1195+ at all or code after the point, insert a double-semicolon comment;
4.1196+ and if the point is after all code on the line, insert a single-
4.1197+ semicolon margin comment at `comment-column'."
4.1198+ (interactive "*P")
4.1199+ (paredit-initialize-comment-dwim)
4.1200+ (cond ((paredit-region-active-p)
4.1201+ (comment-or-uncomment-region (region-beginning)
4.1202+ (region-end)
4.1203+ argument))
4.1204+ ((paredit-comment-on-line-p)
4.1205+ (if argument
4.1206+ (comment-kill (if (integerp argument) argument nil))
4.1207+ (comment-indent)))
4.1208+ (t (paredit-insert-comment))))
4.1209+
4.1210+(defun paredit-comment-on-line-p ()
4.1211+ "True if there is a comment on the line following point.
4.1212+This is expected to be called only in `paredit-comment-dwim'; do not
4.1213+ call it elsewhere."
4.1214+ (save-excursion
4.1215+ (beginning-of-line)
4.1216+ (let ((comment-p nil))
4.1217+ ;; Search forward for a comment beginning. If there is one, set
4.1218+ ;; COMMENT-P to true; if not, it will be nil.
4.1219+ (while (progn
4.1220+ (setq comment-p ;t -> no error
4.1221+ (comment-search-forward (point-at-eol) t))
4.1222+ (and comment-p
4.1223+ (or (paredit-in-string-p)
4.1224+ (paredit-in-char-p (1- (point))))))
4.1225+ (forward-char))
4.1226+ comment-p)))
4.1227+
4.1228+(defun paredit-insert-comment ()
4.1229+ (let ((code-after-p
4.1230+ (save-excursion (paredit-skip-whitespace t (point-at-eol))
4.1231+ (not (eolp))))
4.1232+ (code-before-p
4.1233+ (save-excursion (paredit-skip-whitespace nil (point-at-bol))
4.1234+ (not (bolp)))))
4.1235+ (cond ((and (bolp)
4.1236+ (let ((indent
4.1237+ (let ((indent (calculate-lisp-indent)))
4.1238+ (if (consp indent) (car indent) indent))))
4.1239+ (and indent (zerop indent))))
4.1240+ ;; Top-level comment
4.1241+ (if code-after-p (save-excursion (newline)))
4.1242+ (insert paredit-comment-prefix-toplevel))
4.1243+ ((or code-after-p (not code-before-p))
4.1244+ ;; Code comment
4.1245+ (if code-before-p
4.1246+ (newline-and-indent)
4.1247+ (lisp-indent-line))
4.1248+ (insert paredit-comment-prefix-code)
4.1249+ (if code-after-p
4.1250+ (save-excursion
4.1251+ (newline)
4.1252+ (lisp-indent-line)
4.1253+ (paredit-indent-sexps))))
4.1254+ (t
4.1255+ ;; Margin comment
4.1256+ (indent-to comment-column 1) ; 1 -> force one leading space
4.1257+ (insert paredit-comment-prefix-margin)))))
4.1258+
4.1259+;;;; Character Deletion
4.1260+
4.1261+(defun paredit-delete-char (&optional argument)
4.1262+ "Delete a character forward or move forward over a delimiter.
4.1263+If on an opening S-expression delimiter, move forward into the
4.1264+ S-expression.
4.1265+If on a closing S-expression delimiter, refuse to delete unless the
4.1266+ S-expression is empty, in which case delete the whole S-expression.
4.1267+With a numeric prefix argument N, delete N characters forward.
4.1268+With a `C-u' prefix argument, simply delete a character forward,
4.1269+ without regard for delimiter balancing.
4.1270+
4.1271+Like `delete-char', ignores `delete-active-region'."
4.1272+ (interactive "P")
4.1273+ (let ((delete-active-region nil))
4.1274+ (paredit-forward-delete argument)))
4.1275+
4.1276+(defun paredit-delete-active-region-p ()
4.1277+ "True if the region is active and to be deleted."
4.1278+ (and (paredit-region-active-p)
4.1279+ (boundp 'delete-active-region)
4.1280+ (eq delete-active-region t)))
4.1281+
4.1282+(defun paredit-kill-active-region-p ()
4.1283+ "True if the region is active and to be killed."
4.1284+ (and (paredit-region-active-p)
4.1285+ (boundp 'delete-active-region)
4.1286+ (eq delete-active-region 'kill)))
4.1287+
4.1288+(defun paredit-forward-delete (&optional argument)
4.1289+ "Delete a character forward or move forward over a delimiter.
4.1290+If on an opening S-expression delimiter, move forward into the
4.1291+ S-expression.
4.1292+If on a closing S-expression delimiter, refuse to delete unless the
4.1293+ S-expression is empty, in which case delete the whole S-expression.
4.1294+With a numeric prefix argument N, delete N characters forward.
4.1295+With a `C-u' prefix argument, simply delete a character forward,
4.1296+ without regard for delimiter balancing.
4.1297+
4.1298+If `delete-active-region' is enabled and the mark is active and
4.1299+ no prefix argument is specified, act as `paredit-delete-region'
4.1300+ or `paredit-kill-region' as appropriate instead."
4.1301+ (interactive "P")
4.1302+ (cond ((consp argument)
4.1303+ (delete-char +1))
4.1304+ ((integerp argument)
4.1305+ (let ((delete-active-region nil))
4.1306+ (if (< argument 0)
4.1307+ (paredit-backward-delete argument)
4.1308+ (while (> argument 0)
4.1309+ (paredit-forward-delete)
4.1310+ (setq argument (- argument 1))))))
4.1311+ ((paredit-delete-active-region-p)
4.1312+ (paredit-delete-region (region-beginning) (region-end)))
4.1313+ ((paredit-kill-active-region-p)
4.1314+ (paredit-kill-region (region-beginning) (region-end)))
4.1315+ ((eobp)
4.1316+ (delete-char +1))
4.1317+ ((paredit-in-string-p)
4.1318+ (paredit-forward-delete-in-string))
4.1319+ ((paredit-in-comment-p)
4.1320+ (paredit-forward-delete-in-comment))
4.1321+ ((paredit-in-char-p) ; Escape -- delete both chars.
4.1322+ (delete-char -1)
4.1323+ (delete-char +1))
4.1324+ ((eq (char-after) ?\\ ) ; ditto
4.1325+ (delete-char +2))
4.1326+ ((let ((syn (char-syntax (char-after))))
4.1327+ (or (eq syn ?\( )
4.1328+ (eq syn ?\" )))
4.1329+ (if (save-excursion
4.1330+ (paredit-handle-sexp-errors (progn (forward-sexp) t)
4.1331+ nil))
4.1332+ (forward-char)
4.1333+ (message "Deleting spurious opening delimiter.")
4.1334+ (delete-char +1)))
4.1335+ ((and (not (paredit-in-char-p (1- (point))))
4.1336+ (eq (char-syntax (char-after)) ?\) )
4.1337+ (eq (char-before) (matching-paren (char-after))))
4.1338+ (delete-char -1) ; Empty list -- delete both
4.1339+ (delete-char +1)) ; delimiters.
4.1340+ ((eq ?\; (char-after))
4.1341+ (paredit-forward-delete-comment-start))
4.1342+ ((eq (char-syntax (char-after)) ?\) )
4.1343+ (if (paredit-handle-sexp-errors
4.1344+ (save-excursion (forward-char) (backward-sexp) t)
4.1345+ nil)
4.1346+ (message "End of list!")
4.1347+ (progn
4.1348+ (message "Deleting spurious closing delimiter.")
4.1349+ (delete-char +1))))
4.1350+ ;; Just delete a single character, if it's not a closing
4.1351+ ;; delimiter. (The character literal case is already handled
4.1352+ ;; by now.)
4.1353+ (t (delete-char +1))))
4.1354+
4.1355+(defun paredit-forward-delete-in-string ()
4.1356+ (let ((start+end (paredit-string-start+end-points)))
4.1357+ (cond ((not (eq (point) (cdr start+end)))
4.1358+ ;; If it's not the close-quote, it's safe to delete. But
4.1359+ ;; first handle the case that we're in a string escape.
4.1360+ (cond ((paredit-in-string-escape-p)
4.1361+ ;; We're right after the backslash, so backward
4.1362+ ;; delete it before deleting the escaped character.
4.1363+ (delete-char -1))
4.1364+ ((eq (char-after) ?\\ )
4.1365+ ;; If we're not in a string escape, but we are on a
4.1366+ ;; backslash, it must start the escape for the next
4.1367+ ;; character, so delete the backslash before deleting
4.1368+ ;; the next character.
4.1369+ (delete-char +1)))
4.1370+ (delete-char +1))
4.1371+ ((eq (1- (point)) (car start+end))
4.1372+ ;; If it is the close-quote, delete only if we're also right
4.1373+ ;; past the open-quote (i.e. it's empty), and then delete
4.1374+ ;; both quotes. Otherwise we refuse to delete it.
4.1375+ (delete-char -1)
4.1376+ (delete-char +1)))))
4.1377+
4.1378+(defun paredit-check-forward-delete-in-comment ()
4.1379+ ;; Point is in a comment, possibly at eol. We are about to delete
4.1380+ ;; some characters forward; if we are at eol, we are about to delete
4.1381+ ;; the line break. Refuse to do so if if moving the next line into
4.1382+ ;; the comment would break structure.
4.1383+ (if (eolp)
4.1384+ (let ((next-line-start (point-at-bol 2))
4.1385+ (next-line-end (point-at-eol 2)))
4.1386+ (paredit-check-region next-line-start next-line-end))))
4.1387+
4.1388+(defun paredit-forward-delete-in-comment ()
4.1389+ (paredit-check-forward-delete-in-comment)
4.1390+ (delete-char +1))
4.1391+
4.1392+(defun paredit-forward-delete-comment-start ()
4.1393+ ;; Point precedes a comment start (not at eol). Refuse to delete a
4.1394+ ;; comment start if the comment contains unbalanced junk.
4.1395+ (paredit-check-region (+ (point) 1) (point-at-eol))
4.1396+ (delete-char +1))
4.1397+
4.1398+(defun paredit-backward-delete (&optional argument)
4.1399+ "Delete a character backward or move backward over a delimiter.
4.1400+If on a closing S-expression delimiter, move backward into the
4.1401+ S-expression.
4.1402+If on an opening S-expression delimiter, refuse to delete unless the
4.1403+ S-expression is empty, in which case delete the whole S-expression.
4.1404+With a numeric prefix argument N, delete N characters backward.
4.1405+With a `C-u' prefix argument, simply delete a character backward,
4.1406+ without regard for delimiter balancing.
4.1407+
4.1408+If `delete-active-region' is enabled and the mark is active and
4.1409+ no prefix argument is specified, act as `paredit-delete-region'
4.1410+ or `paredit-kill-region' as appropriate instead."
4.1411+ (interactive "P")
4.1412+ (cond ((consp argument)
4.1413+ ;++ Should this untabify?
4.1414+ (delete-char -1))
4.1415+ ((integerp argument)
4.1416+ (let ((delete-active-region nil))
4.1417+ (if (< argument 0)
4.1418+ (paredit-forward-delete (- 0 argument))
4.1419+ (while (> argument 0)
4.1420+ (paredit-backward-delete)
4.1421+ (setq argument (- argument 1))))))
4.1422+ ((paredit-delete-active-region-p)
4.1423+ (paredit-delete-region (region-beginning) (region-end)))
4.1424+ ((paredit-kill-active-region-p)
4.1425+ (paredit-kill-region (region-beginning) (region-end)))
4.1426+ ((bobp)
4.1427+ (delete-char -1))
4.1428+ ((paredit-in-string-p)
4.1429+ (paredit-backward-delete-in-string))
4.1430+ ((paredit-in-comment-p)
4.1431+ (paredit-backward-delete-in-comment))
4.1432+ ((paredit-in-char-p) ; Escape -- delete both chars.
4.1433+ (delete-char -1)
4.1434+ (delete-char +1))
4.1435+ ((paredit-in-char-p (1- (point)))
4.1436+ (delete-char -2)) ; ditto
4.1437+ ((let ((syn (char-syntax (char-before))))
4.1438+ (or (eq syn ?\) )
4.1439+ (eq syn ?\" )))
4.1440+ (if (save-excursion
4.1441+ (paredit-handle-sexp-errors (progn (backward-sexp) t)
4.1442+ nil))
4.1443+ (backward-char)
4.1444+ (message "Deleting spurious closing delimiter.")
4.1445+ (delete-char -1)))
4.1446+ ((and (eq (char-syntax (char-before)) ?\( )
4.1447+ (eq (char-after) (matching-paren (char-before))))
4.1448+ (delete-char -1) ; Empty list -- delete both
4.1449+ (delete-char +1)) ; delimiters.
4.1450+ ((bolp)
4.1451+ (paredit-backward-delete-maybe-comment-end))
4.1452+ ((eq (char-syntax (char-before)) ?\( )
4.1453+ (if (paredit-handle-sexp-errors
4.1454+ (save-excursion (backward-char) (forward-sexp) t)
4.1455+ nil)
4.1456+ (message "Beginning of list!")
4.1457+ (progn
4.1458+ (message "Deleting spurious closing delimiter.")
4.1459+ (delete-char -1))))
4.1460+ ;; Delete it, unless it's an opening delimiter. The case of
4.1461+ ;; character literals is already handled by now.
4.1462+ (t
4.1463+ ;; Turn off the @#&*&!^&(%^ botch in GNU Emacs 24 that changed
4.1464+ ;; `backward-delete-char' and `backward-delete-char-untabify'
4.1465+ ;; semantically so that they delete the region in transient
4.1466+ ;; mark mode.
4.1467+ (let ((delete-active-region nil))
4.1468+ (backward-delete-char-untabify +1)))))
4.1469+
4.1470+(defun paredit-backward-delete-in-string ()
4.1471+ (let ((start+end (paredit-string-start+end-points)))
4.1472+ (cond ((not (eq (1- (point)) (car start+end)))
4.1473+ ;; If it's not the open-quote, it's safe to delete.
4.1474+ (if (paredit-in-string-escape-p)
4.1475+ ;; If we're on a string escape, since we're about to
4.1476+ ;; delete the backslash, we must first delete the
4.1477+ ;; escaped char.
4.1478+ (delete-char +1))
4.1479+ (delete-char -1)
4.1480+ (if (paredit-in-string-escape-p)
4.1481+ ;; If, after deleting a character, we find ourselves in
4.1482+ ;; a string escape, we must have deleted the escaped
4.1483+ ;; character, and the backslash is behind the point, so
4.1484+ ;; backward delete it.
4.1485+ (delete-char -1)))
4.1486+ ((eq (point) (cdr start+end))
4.1487+ ;; If it is the open-quote, delete only if we're also right
4.1488+ ;; past the close-quote (i.e. it's empty), and then delete
4.1489+ ;; both quotes. Otherwise we refuse to delete it.
4.1490+ (delete-char -1)
4.1491+ (delete-char +1)))))
4.1492+
4.1493+(defun paredit-backward-delete-in-comment ()
4.1494+ ;; Point is in a comment, possibly just after the comment start.
4.1495+ ;; Refuse to delete a comment start if the comment contains
4.1496+ ;; unbalanced junk.
4.1497+ (if (save-excursion
4.1498+ (backward-char)
4.1499+ ;; Must call `paredit-in-string-p' before
4.1500+ ;; `paredit-in-comment-p'.
4.1501+ (not (or (paredit-in-string-p) (paredit-in-comment-p))))
4.1502+ (paredit-check-region (point) (point-at-eol)))
4.1503+ (backward-delete-char-untabify +1))
4.1504+
4.1505+(defun paredit-backward-delete-maybe-comment-end ()
4.1506+ ;; Point is at bol, possibly just after a comment end (i.e., the
4.1507+ ;; previous line may have had a line comment). Refuse to delete a
4.1508+ ;; comment end if moving the current line into the previous line's
4.1509+ ;; comment would break structure.
4.1510+ (if (save-excursion
4.1511+ (backward-char)
4.1512+ (and (not (paredit-in-string-p)) (paredit-in-comment-p)))
4.1513+ (paredit-check-region (point-at-eol) (point-at-bol)))
4.1514+ (delete-char -1))
4.1515+
4.1516+;;;; Killing
4.1517+
4.1518+(defun paredit-kill (&optional argument)
4.1519+ "Kill a line as if with `kill-line', but respecting delimiters.
4.1520+In a string, act exactly as `kill-line' but do not kill past the
4.1521+ closing string delimiter.
4.1522+On a line with no S-expressions on it starting after the point or
4.1523+ within a comment, act exactly as `kill-line'.
4.1524+Otherwise, kill all S-expressions that start after the point.
4.1525+With a `C-u' prefix argument, just do the standard `kill-line'.
4.1526+With a numeric prefix argument N, do `kill-line' that many times.
4.1527+
4.1528+If `kill-whole-line' is true, kills the newline character and
4.1529+ indentation on the next line as well.
4.1530+In that case, ensure there is at least one space between the
4.1531+ preceding S-expression and whatever follows on the next line."
4.1532+ (interactive "P")
4.1533+ (cond (argument
4.1534+ (kill-line (if (integerp argument) argument 1)))
4.1535+ ((paredit-in-string-p)
4.1536+ (paredit-kill-line-in-string))
4.1537+ ((paredit-in-comment-p)
4.1538+ (paredit-kill-line-in-comment))
4.1539+ ((save-excursion (paredit-skip-whitespace t (point-at-eol))
4.1540+ (or (eolp) (eq (char-after) ?\; )))
4.1541+ ;** Be careful about trailing backslashes.
4.1542+ (if (paredit-in-char-p)
4.1543+ (backward-char))
4.1544+ (kill-line))
4.1545+ (t (paredit-kill-sexps-on-line))))
4.1546+
4.1547+(defun paredit-kill-line-in-string ()
4.1548+ (if (save-excursion (paredit-skip-whitespace t (point-at-eol))
4.1549+ (eolp))
4.1550+ (kill-line)
4.1551+ (save-excursion
4.1552+ ;; Be careful not to split an escape sequence.
4.1553+ (if (paredit-in-string-escape-p)
4.1554+ (backward-char))
4.1555+ (kill-region (point)
4.1556+ (min (point-at-eol)
4.1557+ (cdr (paredit-string-start+end-points)))))))
4.1558+
4.1559+(defun paredit-kill-line-in-comment ()
4.1560+ ;; The variable `kill-whole-line' is not relevant: the point is in a
4.1561+ ;; comment, and hence not at the beginning of the line.
4.1562+ (paredit-check-forward-delete-in-comment)
4.1563+ (kill-line))
4.1564+
4.1565+(defun paredit-kill-sexps-on-line ()
4.1566+ (if (paredit-in-char-p) ; Move past the \ and prefix.
4.1567+ (backward-char 2)) ; (# in Scheme/CL, ? in elisp)
4.1568+ (let ((beginning (point))
4.1569+ (eol (point-at-eol)))
4.1570+ (let ((end-of-list-p (paredit-forward-sexps-to-kill beginning eol)))
4.1571+ ;; If we got to the end of the list and it's on the same line,
4.1572+ ;; move backward past the closing delimiter before killing. (This
4.1573+ ;; allows something like killing the whitespace in ( ).)
4.1574+ (if end-of-list-p (progn (up-list) (backward-char)))
4.1575+ (if kill-whole-line
4.1576+ (paredit-kill-sexps-on-whole-line beginning)
4.1577+ (kill-region beginning
4.1578+ ;; If all of the S-expressions were on one line,
4.1579+ ;; i.e. we're still on that line after moving past
4.1580+ ;; the last one, kill the whole line, including
4.1581+ ;; any comments; otherwise just kill to the end of
4.1582+ ;; the last S-expression we found. Be sure,
4.1583+ ;; though, not to kill any closing parentheses.
4.1584+ (if (and (not end-of-list-p)
4.1585+ (eq (point-at-eol) eol))
4.1586+ eol
4.1587+ (point)))))))
4.1588+
4.1589+;;; Move to the end of the last S-expression that started on this line,
4.1590+;;; or to the closing delimiter if the last S-expression in this list
4.1591+;;; and the closing delimiter both lie on this line. Return true if
4.1592+;;; the closing delimiter of this list is on this line, false if not.
4.1593+;;;
4.1594+;;; beginning is (point), and eol is (point-at-eol). Handling of
4.1595+;;; `kill-whole-line' is trick, and probably kind of broken.
4.1596+
4.1597+(defun paredit-forward-sexps-to-kill (beginning eol)
4.1598+ (let ((end-of-list-p nil) ;Have we hit a closing delimiter on this line?
4.1599+ (firstp t)) ;Is this still the first line?
4.1600+ (catch 'return
4.1601+ (while t
4.1602+ ;; This and the `kill-whole-line' business below fix a bug that
4.1603+ ;; inhibited any S-expression at the very end of the buffer
4.1604+ ;; (with no trailing newline) from being deleted. It's a
4.1605+ ;; bizarre fix that I ought to document at some point, but I am
4.1606+ ;; too busy at the moment to do so.
4.1607+ (if (and kill-whole-line (eobp)) (throw 'return nil))
4.1608+ ;; See if we can move forward, and stay on an S-expression that
4.1609+ ;; started on this line.
4.1610+ (save-excursion
4.1611+ (paredit-handle-sexp-errors (forward-sexp)
4.1612+ ;; Can't move forward -- we must have hit the end of a
4.1613+ ;; list. Stop here, but record whether the closing
4.1614+ ;; delimiter occurred on the starting line.
4.1615+ (up-list)
4.1616+ (setq end-of-list-p (eq (point-at-eol) eol))
4.1617+ (throw 'return nil))
4.1618+ ;; We can move forward. Where did we move to? Stop if:
4.1619+ ;;
4.1620+ ;; (a) we hit the end of the buffer in certain circumstances
4.1621+ ;; (XXX why are these circumstances? necessary according
4.1622+ ;; to tests, need explanation), because forward-sexp
4.1623+ ;; didn't/won't make any progress and we'll get stuck in
4.1624+ ;; a loop; or
4.1625+ ;;
4.1626+ ;; (b) the S-expression we moved to the end to actually
4.1627+ ;; started on line after where we started so it's not
4.1628+ ;; under our jurisdiction.
4.1629+ (if (or (and (not firstp) ;(a)
4.1630+ (not kill-whole-line)
4.1631+ (eobp))
4.1632+ (paredit-handle-sexp-errors ;(b)
4.1633+ (progn (backward-sexp) nil)
4.1634+ t)
4.1635+ (not (eq (point-at-eol) eol)))
4.1636+ (throw 'return nil)))
4.1637+ ;; Determined we can and should move forward. Do so.
4.1638+ (forward-sexp)
4.1639+ ;; In certain other circumstances (XXX need explanation), if we
4.1640+ ;; hit the end of the buffer, stop here; otherwise the next
4.1641+ ;; forward-sexp will fail to make progress and we might get
4.1642+ ;; stuck in a loop.
4.1643+ (if (and firstp
4.1644+ (not kill-whole-line)
4.1645+ (eobp))
4.1646+ (throw 'return nil))
4.1647+ ;; We have made it past one S-expression.
4.1648+ (setq firstp nil)))
4.1649+ end-of-list-p))
4.1650+
4.1651+;;; Handle the actual kill when `kill-whole-line' is enabled.
4.1652+;;;
4.1653+;;; XXX This has various broken edge cases (see the xfails in test.el)
4.1654+;;; and it doesn't make paredit-kill/yank a noop on round-trip, in an
4.1655+;;; attempt to avoid inadvertently joining S-expressions when it
4.1656+;;; deletes the newline. It could use some input and logic from a user
4.1657+;;; who relies on `kill-whole-line' and has a better sense of
4.1658+;;; expectations.
4.1659+
4.1660+(defun paredit-kill-sexps-on-whole-line (beginning)
4.1661+ (kill-region beginning
4.1662+ (or (save-excursion ; Delete trailing indentation...
4.1663+ (paredit-skip-whitespace t)
4.1664+ (and (not (eq (char-after) ?\; ))
4.1665+ (point)))
4.1666+ ;; ...or just use the point past the newline, if
4.1667+ ;; we encounter a comment.
4.1668+ (point-at-eol)))
4.1669+ (cond ((save-excursion (paredit-skip-whitespace nil (point-at-bol))
4.1670+ (bolp))
4.1671+ ;; Nothing but indentation before the point, so indent it.
4.1672+ (lisp-indent-line))
4.1673+ ((eobp) nil) ; Protect the CHAR-SYNTAX below against NIL.
4.1674+ ;; Insert a space to avoid invalid joining if necessary.
4.1675+ ((let ((syn-before (char-syntax (char-before)))
4.1676+ (syn-after (char-syntax (char-after))))
4.1677+ (and (memq syn-before '(?\) ?\" ?_ ?w))
4.1678+ (memq syn-after '(?\( ?\" ?_ ?w))))
4.1679+ (save-excursion (insert " ")))))
4.1680+
4.1681+;;;;; Killing Words
4.1682+
4.1683+;;; This is tricky and asymmetrical because backward parsing is
4.1684+;;; extraordinarily difficult or impossible, so we have to implement
4.1685+;;; killing in both directions by parsing forward.
4.1686+
4.1687+(defun paredit-forward-kill-word (&optional argument)
4.1688+ "Kill a word forward, skipping over intervening delimiters."
4.1689+ (interactive "p")
4.1690+ (let ((argument (or argument 1)))
4.1691+ (if (< argument 0)
4.1692+ (paredit-backward-kill-word (- argument))
4.1693+ (dotimes (i argument)
4.1694+ (let ((beginning (point)))
4.1695+ (skip-syntax-forward " -")
4.1696+ (let* ((parse-state (paredit-current-parse-state))
4.1697+ (state (paredit-kill-word-state parse-state 'char-after)))
4.1698+ (while (not (or (eobp)
4.1699+ (eq ?w (char-syntax (char-after)))))
4.1700+ (setq parse-state
4.1701+ (progn (forward-char 1) (paredit-current-parse-state))
4.1702+ ;; XXX Why did I comment this out?
4.1703+ ;; (parse-partial-sexp (point) (1+ (point))
4.1704+ ;; nil nil parse-state)
4.1705+ )
4.1706+ (let* ((old-state state)
4.1707+ (new-state
4.1708+ (paredit-kill-word-state parse-state 'char-after)))
4.1709+ (cond ((not (eq old-state new-state))
4.1710+ (setq parse-state
4.1711+ (paredit-kill-word-hack old-state
4.1712+ new-state
4.1713+ parse-state))
4.1714+ (setq state
4.1715+ (paredit-kill-word-state parse-state
4.1716+ 'char-after))
4.1717+ (setq beginning (point)))))))
4.1718+ (goto-char beginning)
4.1719+ (kill-word 1))))))
4.1720+
4.1721+(defun paredit-backward-kill-word (&optional argument)
4.1722+ "Kill a word backward, skipping over any intervening delimiters."
4.1723+ (interactive "p")
4.1724+ (let ((argument (or argument 1)))
4.1725+ (if (< argument 0)
4.1726+ (paredit-forward-kill-word (- argument))
4.1727+ (dotimes (i argument)
4.1728+ (if (not (or (bobp)
4.1729+ (eq (char-syntax (char-before)) ?w)))
4.1730+ (let ((end (point)))
4.1731+ (backward-word 1)
4.1732+ (forward-word 1)
4.1733+ (goto-char (min end (point)))
4.1734+ (let* ((parse-state (paredit-current-parse-state))
4.1735+ (state
4.1736+ (paredit-kill-word-state parse-state 'char-before)))
4.1737+ (while (and (< (point) end)
4.1738+ (progn
4.1739+ (setq parse-state
4.1740+ (parse-partial-sexp (point) (1+ (point))
4.1741+ nil nil parse-state))
4.1742+ (or (eq state
4.1743+ (paredit-kill-word-state parse-state
4.1744+ 'char-before))
4.1745+ (progn (backward-char 1) nil)))))
4.1746+ (if (and (eq state 'comment)
4.1747+ (eq ?\# (char-after (point)))
4.1748+ (eq ?\| (char-before (point))))
4.1749+ (backward-char 1)))))
4.1750+ (backward-kill-word 1)))))
4.1751+
4.1752+;;;;;; Word-Killing Auxiliaries
4.1753+
4.1754+(defun paredit-kill-word-state (parse-state adjacent-char-fn)
4.1755+ (cond ((paredit-in-comment-p parse-state) 'comment)
4.1756+ ((paredit-in-string-p parse-state) 'string)
4.1757+ ((memq (char-syntax (funcall adjacent-char-fn))
4.1758+ '(?\( ?\) ))
4.1759+ 'delimiter)
4.1760+ (t 'other)))
4.1761+
4.1762+;;; This optionally advances the point past any comment delimiters that
4.1763+;;; should probably not be touched, based on the last state change and
4.1764+;;; the characters around the point. It returns a new parse state,
4.1765+;;; starting from the PARSE-STATE parameter.
4.1766+
4.1767+(defun paredit-kill-word-hack (old-state new-state parse-state)
4.1768+ (cond ((and (not (eq old-state 'comment))
4.1769+ (not (eq new-state 'comment))
4.1770+ (not (paredit-in-string-escape-p))
4.1771+ (eq ?\# (char-before))
4.1772+ (eq ?\| (char-after)))
4.1773+ (forward-char 1)
4.1774+ (paredit-current-parse-state)
4.1775+;; (parse-partial-sexp (point) (1+ (point))
4.1776+;; nil nil parse-state)
4.1777+ )
4.1778+ ((and (not (eq old-state 'comment))
4.1779+ (eq new-state 'comment)
4.1780+ (eq ?\; (char-before)))
4.1781+ (skip-chars-forward ";")
4.1782+ (paredit-current-parse-state)
4.1783+;; (parse-partial-sexp (point) (save-excursion
4.1784+;; (skip-chars-forward ";"))
4.1785+;; nil nil parse-state)
4.1786+ )
4.1787+ (t parse-state)))
4.1788+
4.1789+(defun paredit-copy-as-kill ()
4.1790+ "Save in the kill ring the region that `paredit-kill' would kill."
4.1791+ (interactive)
4.1792+ (cond ((paredit-in-string-p)
4.1793+ (paredit-copy-as-kill-in-string))
4.1794+ ((paredit-in-comment-p)
4.1795+ (copy-region-as-kill (point) (point-at-eol)))
4.1796+ ((save-excursion (paredit-skip-whitespace t (point-at-eol))
4.1797+ (or (eolp) (eq (char-after) ?\; )))
4.1798+ ;** Be careful about trailing backslashes.
4.1799+ (save-excursion
4.1800+ (if (paredit-in-char-p)
4.1801+ (backward-char))
4.1802+ (copy-region-as-kill (point) (point-at-eol))))
4.1803+ (t (paredit-copy-sexps-as-kill))))
4.1804+
4.1805+(defun paredit-copy-as-kill-in-string ()
4.1806+ (save-excursion
4.1807+ (if (paredit-in-string-escape-p)
4.1808+ (backward-char))
4.1809+ (copy-region-as-kill (point)
4.1810+ (min (point-at-eol)
4.1811+ (cdr (paredit-string-start+end-points))))))
4.1812+
4.1813+(defun paredit-copy-sexps-as-kill ()
4.1814+ (save-excursion
4.1815+ (if (paredit-in-char-p)
4.1816+ (backward-char 2))
4.1817+ (let ((beginning (point))
4.1818+ (eol (point-at-eol)))
4.1819+ (let ((end-of-list-p (paredit-forward-sexps-to-kill beginning eol)))
4.1820+ (if end-of-list-p (progn (up-list) (backward-char)))
4.1821+ (copy-region-as-kill beginning
4.1822+ (cond (kill-whole-line
4.1823+ (or (save-excursion
4.1824+ (paredit-skip-whitespace t)
4.1825+ (and (not (eq (char-after) ?\; ))
4.1826+ (point)))
4.1827+ (point-at-eol)))
4.1828+ ((and (not end-of-list-p)
4.1829+ (eq (point-at-eol) eol))
4.1830+ eol)
4.1831+ (t
4.1832+ (point))))))))
4.1833+
4.1834+;;;; Deleting Regions
4.1835+
4.1836+(defun paredit-delete-region (start end)
4.1837+ "Delete the text between point and mark, like `delete-region'.
4.1838+If that text is unbalanced, signal an error instead.
4.1839+With a prefix argument, skip the balance check."
4.1840+ (interactive "r")
4.1841+ (if (and start end (not current-prefix-arg))
4.1842+ (paredit-check-region-for-delete start end))
4.1843+ (setq this-command 'delete-region)
4.1844+ (delete-region start end))
4.1845+
4.1846+(defun paredit-kill-region (start end)
4.1847+ "Kill the text between point and mark, like `kill-region'.
4.1848+If that text is unbalanced, signal an error instead.
4.1849+With a prefix argument, skip the balance check."
4.1850+ (interactive "r")
4.1851+ (if (and start end (not current-prefix-arg))
4.1852+ (paredit-check-region-for-delete start end))
4.1853+ (setq this-command 'kill-region)
4.1854+ (kill-region start end))
4.1855+
4.1856+(defun paredit-check-region-for-delete (start end)
4.1857+ "Signal an error deleting text between START and END is unsafe."
4.1858+ (save-excursion
4.1859+ (goto-char start)
4.1860+ (let* ((start-state (paredit-current-parse-state))
4.1861+ (end-state (parse-partial-sexp start end nil nil start-state)))
4.1862+ (paredit-check-region-for-delete:depth start start-state end end-state)
4.1863+ (paredit-check-region-for-delete:string start start-state end end-state)
4.1864+ (paredit-check-region-for-delete:comment start start-state end end-state)
4.1865+ (paredit-check-region-for-delete:char-quote start start-state
4.1866+ end end-state))))
4.1867+
4.1868+(defun paredit-check-region-for-delete:depth (start start-state end end-state)
4.1869+ (let ((start-depth (nth 0 start-state))
4.1870+ (end-depth (nth 0 end-state)))
4.1871+ (if (not (= start-depth end-depth))
4.1872+ (error "Mismatched parenthesis depth: %S at start, %S at end."
4.1873+ start-depth
4.1874+ end-depth))))
4.1875+
4.1876+(defun paredit-check-region-for-delete:string (start start-state end end-state)
4.1877+ (let ((start-string-p (nth 3 start-state))
4.1878+ (end-string-p (nth 3 end-state)))
4.1879+ (if (not (eq start-string-p end-string-p))
4.1880+ (error "Mismatched string state: start %sin string, end %sin string."
4.1881+ (if start-string-p "" "not ")
4.1882+ (if end-string-p "" "not ")))))
4.1883+
4.1884+(defun paredit-check-region-for-delete:comment
4.1885+ (start start-state end end-state)
4.1886+ (let ((start-comment-state (nth 4 start-state))
4.1887+ (end-comment-state (nth 4 end-state)))
4.1888+ (if (not (or (eq start-comment-state end-comment-state)
4.1889+ ;; If we are moving text into or out of a line
4.1890+ ;; comment, make sure that the text is balanced. (The
4.1891+ ;; comment state may be a number, not t or nil at all,
4.1892+ ;; for nestable comments, which are not handled by
4.1893+ ;; this heuristic (or any of paredit, really).)
4.1894+ (and (or (and (eq start-comment-state nil)
4.1895+ (eq end-comment-state t))
4.1896+ (and (eq start-comment-state t)
4.1897+ (eq end-comment-state nil)))
4.1898+ (save-excursion
4.1899+ (goto-char end)
4.1900+ (paredit-region-ok-p (point) (point-at-eol))))))
4.1901+ (error "Mismatched comment state: %s"
4.1902+ (cond ((and (integerp start-comment-state)
4.1903+ (integerp end-comment-state))
4.1904+ (format "depth %S at start, depth %S at end."
4.1905+ start-comment-state
4.1906+ end-comment-state))
4.1907+ ((integerp start-comment-state)
4.1908+ "start in nested comment, end otherwise.")
4.1909+ ((integerp end-comment-state)
4.1910+ "end in nested comment, start otherwise.")
4.1911+ (start-comment-state
4.1912+ "start in comment, end not in comment.")
4.1913+ (end-comment-state
4.1914+ "end in comment, start not in comment.")
4.1915+ (t
4.1916+ (format "start %S, end %S."
4.1917+ start-comment-state
4.1918+ end-comment-state)))))))
4.1919+
4.1920+(defun paredit-check-region-for-delete:char-quote
4.1921+ (start start-state end end-state)
4.1922+ (let ((start-char-quote (nth 5 start-state))
4.1923+ (end-char-quote (nth 5 end-state)))
4.1924+ (if (not (eq start-char-quote end-char-quote))
4.1925+ (let ((phrase "character quotation"))
4.1926+ (error "Mismatched %s: start %sin %s, end %sin %s."
4.1927+ phrase
4.1928+ (if start-char-quote "" "not ")
4.1929+ phrase
4.1930+ (if end-char-quote "" "not ")
4.1931+ phrase)))))
4.1932+
4.1933+;;;; Point Motion
4.1934+
4.1935+(eval-and-compile
4.1936+ (defmacro defun-motion (name bvl doc &rest body)
4.1937+ `(defun ,name ,bvl
4.1938+ ,doc
4.1939+ ,(xcond ((paredit-xemacs-p)
4.1940+ '(interactive "_"))
4.1941+ ((paredit-gnu-emacs-p)
4.1942+ ;++ Not sure this is sufficient for the `^'.
4.1943+ (if (fboundp 'handle-shift-selection)
4.1944+ '(interactive "^p")
4.1945+ '(interactive "p"))))
4.1946+ ,@body)))
4.1947+
4.1948+(defun-motion paredit-forward (&optional arg)
4.1949+ "Move forward an S-expression, or up an S-expression forward.
4.1950+If there are no more S-expressions in this one before the closing
4.1951+ delimiter, move past that closing delimiter; otherwise, move forward
4.1952+ past the S-expression following the point."
4.1953+ (let ((n (or arg 1)))
4.1954+ (cond ((< 0 n) (dotimes (i n) (paredit-move-forward)))
4.1955+ ((< n 0) (dotimes (i (- n)) (paredit-move-backward))))))
4.1956+
4.1957+(defun-motion paredit-backward (&optional arg)
4.1958+ "Move backward an S-expression, or up an S-expression backward.
4.1959+If there are no more S-expressions in this one before the opening
4.1960+ delimiter, move past that opening delimiter backward; otherwise,
4.1961+ move backward past the S-expression preceding the point."
4.1962+ (let ((n (or arg 1)))
4.1963+ (cond ((< 0 n) (dotimes (i n) (paredit-move-backward)))
4.1964+ ((< n 0) (dotimes (i (- n)) (paredit-move-forward))))))
4.1965+
4.1966+(defun paredit-move-forward ()
4.1967+ (cond ((paredit-in-string-p)
4.1968+ (let ((end (paredit-enclosing-string-end)))
4.1969+ ;; `forward-sexp' and `up-list' may move into the next string
4.1970+ ;; in the buffer. Don't do that; move out of the current one.
4.1971+ (if (paredit-handle-sexp-errors
4.1972+ (progn (paredit-handle-sexp-errors (forward-sexp)
4.1973+ (up-list))
4.1974+ (<= end (point)))
4.1975+ t)
4.1976+ (goto-char end))))
4.1977+ ((paredit-in-char-p)
4.1978+ (forward-char))
4.1979+ (t
4.1980+ (paredit-handle-sexp-errors (forward-sexp)
4.1981+ (up-list)))))
4.1982+
4.1983+(defun paredit-move-backward ()
4.1984+ (cond ((paredit-in-string-p)
4.1985+ (let ((start (paredit-enclosing-string-start)))
4.1986+ (if (paredit-handle-sexp-errors
4.1987+ (progn (paredit-handle-sexp-errors (backward-sexp)
4.1988+ (backward-up-list))
4.1989+ (<= (point) start))
4.1990+ t)
4.1991+ (goto-char start))))
4.1992+ ((paredit-in-char-p)
4.1993+ ;++ Corner case: a buffer of `\|x'. What to do?
4.1994+ (backward-char 2))
4.1995+ (t
4.1996+ (paredit-handle-sexp-errors (backward-sexp)
4.1997+ (backward-up-list)))))
4.1998+
4.1999+;;;; Window Positioning
4.2000+
4.2001+(defalias 'paredit-recentre-on-sexp 'paredit-recenter-on-sexp)
4.2002+
4.2003+(defun paredit-recenter-on-sexp (&optional n)
4.2004+ "Recenter the screen on the S-expression following the point.
4.2005+With a prefix argument N, encompass all N S-expressions forward."
4.2006+ (interactive "P")
4.2007+ (let* ((p (point))
4.2008+ (end-point (progn (forward-sexp n) (point)))
4.2009+ (start-point (progn (goto-char end-point) (backward-sexp n) (point))))
4.2010+ ;; Point is at beginning of first S-expression.
4.2011+ (let ((p-visible nil) (start-visible nil))
4.2012+ (save-excursion
4.2013+ (forward-line (/ (count-lines start-point end-point) 2))
4.2014+ (recenter)
4.2015+ (setq p-visible (pos-visible-in-window-p p))
4.2016+ (setq start-visible (pos-visible-in-window-p start-point)))
4.2017+ (cond ((not start-visible)
4.2018+ ;; Implies (not p-visible). Put the start at the top of
4.2019+ ;; the screen.
4.2020+ (recenter 0))
4.2021+ (p-visible
4.2022+ ;; Go back to p if we can.
4.2023+ (goto-char p))))))
4.2024+
4.2025+(defun paredit-recenter-on-defun ()
4.2026+ "Recenter the screen on the definition at point."
4.2027+ (interactive)
4.2028+ (save-excursion
4.2029+ (beginning-of-defun)
4.2030+ (paredit-recenter-on-sexp)))
4.2031+
4.2032+(defun paredit-focus-on-defun ()
4.2033+ "Moves display to the top of the definition at point."
4.2034+ (interactive)
4.2035+ (beginning-of-defun)
4.2036+ (recenter 0))
4.2037+
4.2038+;;;; Generalized Upward/Downward Motion
4.2039+
4.2040+(defun paredit-up/down (n vertical-direction)
4.2041+ (let ((horizontal-direction (if (< 0 n) +1 -1)))
4.2042+ (while (/= n 0)
4.2043+ (goto-char
4.2044+ (paredit-next-up/down-point horizontal-direction vertical-direction))
4.2045+ (setq n (- n horizontal-direction)))))
4.2046+
4.2047+(defun paredit-next-up/down-point (horizontal-direction vertical-direction)
4.2048+ (let ((state (paredit-current-parse-state))
4.2049+ (scan-lists
4.2050+ (lambda ()
4.2051+ (scan-lists (point) horizontal-direction vertical-direction))))
4.2052+ (cond ((paredit-in-string-p state)
4.2053+ (let ((start+end (paredit-string-start+end-points state)))
4.2054+ (if (< 0 vertical-direction)
4.2055+ (if (< 0 horizontal-direction)
4.2056+ (+ 1 (cdr start+end))
4.2057+ (car start+end))
4.2058+ ;; We could let the user try to descend into lists
4.2059+ ;; within the string, but that would be asymmetric
4.2060+ ;; with the up case, which rises out of the whole
4.2061+ ;; string and not just out of a list within the
4.2062+ ;; string, so this case will just be an error.
4.2063+ (error "Can't descend further into string."))))
4.2064+ ((< 0 vertical-direction)
4.2065+ ;; When moving up, just try to rise up out of the list.
4.2066+ (or (funcall scan-lists)
4.2067+ (buffer-end horizontal-direction)))
4.2068+ ((< vertical-direction 0)
4.2069+ ;; When moving down, look for a string closer than a list,
4.2070+ ;; and use that if we find it.
4.2071+ (let* ((list-start
4.2072+ (paredit-handle-sexp-errors (funcall scan-lists) nil))
4.2073+ (string-start
4.2074+ (paredit-find-next-string-start horizontal-direction
4.2075+ list-start)))
4.2076+ (if (and string-start list-start)
4.2077+ (if (< 0 horizontal-direction)
4.2078+ (min string-start list-start)
4.2079+ (max string-start list-start))
4.2080+ (or string-start
4.2081+ ;; Scan again: this is a kludgey way to report the
4.2082+ ;; error if there really was one.
4.2083+ (funcall scan-lists)
4.2084+ (buffer-end horizontal-direction)))))
4.2085+ (t
4.2086+ (error "Vertical direction must be nonzero in `%s'."
4.2087+ 'paredit-up/down)))))
4.2088+
4.2089+(defun paredit-find-next-string-start (horizontal-direction limit)
4.2090+ (let ((buffer-limit-p (if (< 0 horizontal-direction) 'eobp 'bobp))
4.2091+ (next-char (if (< 0 horizontal-direction) 'char-after 'char-before))
4.2092+ (pastp (if (< 0 horizontal-direction) '> '<)))
4.2093+ (paredit-handle-sexp-errors
4.2094+ (save-excursion
4.2095+ (catch 'exit
4.2096+ (while t
4.2097+ (if (or (funcall buffer-limit-p)
4.2098+ (and limit (funcall pastp (point) limit)))
4.2099+ (throw 'exit nil))
4.2100+ (forward-sexp horizontal-direction)
4.2101+ (save-excursion
4.2102+ (backward-sexp horizontal-direction)
4.2103+ (if (eq ?\" (char-syntax (funcall next-char)))
4.2104+ (throw 'exit (+ (point) horizontal-direction)))))))
4.2105+ nil)))
4.2106+
4.2107+(defun-motion paredit-forward-down (&optional argument)
4.2108+ "Move forward down into a list.
4.2109+With a positive argument, move forward down that many levels.
4.2110+With a negative argument, move backward down that many levels."
4.2111+ (paredit-up/down (or argument +1) -1))
4.2112+
4.2113+(defun-motion paredit-backward-up (&optional argument)
4.2114+ "Move backward up out of the enclosing list.
4.2115+With a positive argument, move backward up that many levels.
4.2116+With a negative argument, move forward up that many levels.
4.2117+If in a string initially, that counts as one level."
4.2118+ (paredit-up/down (- 0 (or argument +1)) +1))
4.2119+
4.2120+(defun-motion paredit-forward-up (&optional argument)
4.2121+ "Move forward up out of the enclosing list.
4.2122+With a positive argument, move forward up that many levels.
4.2123+With a negative argument, move backward up that many levels.
4.2124+If in a string initially, that counts as one level."
4.2125+ (paredit-up/down (or argument +1) +1))
4.2126+
4.2127+(defun-motion paredit-backward-down (&optional argument)
4.2128+ "Move backward down into a list.
4.2129+With a positive argument, move backward down that many levels.
4.2130+With a negative argument, move forward down that many levels."
4.2131+ (paredit-up/down (- 0 (or argument +1)) -1))
4.2132+
4.2133+;;;; Depth-Changing Commands: Wrapping, Splicing, & Raising
4.2134+
4.2135+(defun paredit-wrap-sexp (&optional argument open close)
4.2136+ "Wrap the following S-expression.
4.2137+If a `C-u' prefix argument is given, wrap all S-expressions following
4.2138+ the point until the end of the buffer or of the enclosing list.
4.2139+If a numeric prefix argument N is given, wrap N S-expressions.
4.2140+Automatically indent the newly wrapped S-expression.
4.2141+As a special case, if the point is at the end of a list, simply insert
4.2142+ a parenthesis pair, rather than inserting a lone opening delimiter
4.2143+ and then signalling an error, in the interest of preserving
4.2144+ structure.
4.2145+By default OPEN and CLOSE are round delimiters."
4.2146+ (interactive "P")
4.2147+ (paredit-lose-if-not-in-sexp 'paredit-wrap-sexp)
4.2148+ (let ((open (or open ?\( ))
4.2149+ (close (or close ?\) )))
4.2150+ (paredit-handle-sexp-errors
4.2151+ ((lambda (n) (paredit-insert-pair n open close 'goto-char))
4.2152+ (cond ((integerp argument) argument)
4.2153+ ((consp argument) (paredit-count-sexps-forward))
4.2154+ ((paredit-region-active-p) nil)
4.2155+ (t 1)))
4.2156+ (insert close)
4.2157+ (backward-char)))
4.2158+ (save-excursion (backward-up-list) (indent-sexp)))
4.2159+
4.2160+(defun paredit-yank-pop (&optional argument)
4.2161+ "Replace just-yanked text with the next item in the kill ring.
4.2162+If this command follows a `yank', just run `yank-pop'.
4.2163+If this command follows a `paredit-wrap-sexp', or any other paredit
4.2164+ wrapping command (see `paredit-wrap-commands'), run `yank' and
4.2165+ reindent the enclosing S-expression.
4.2166+If this command is repeated, run `yank-pop' and reindent the enclosing
4.2167+ S-expression.
4.2168+
4.2169+The argument is passed on to `yank' or `yank-pop'; see their
4.2170+ documentation for details."
4.2171+ (interactive "*p")
4.2172+ (cond ((eq last-command 'yank)
4.2173+ (yank-pop argument))
4.2174+ ((memq last-command paredit-wrap-commands)
4.2175+ (yank argument)
4.2176+ ;; `yank' futzes with `this-command'.
4.2177+ (setq this-command 'paredit-yank-pop)
4.2178+ (save-excursion (backward-up-list) (indent-sexp)))
4.2179+ ((eq last-command 'paredit-yank-pop)
4.2180+ ;; Pretend we just did a `yank', so that we can use
4.2181+ ;; `yank-pop' without duplicating its definition.
4.2182+ (setq last-command 'yank)
4.2183+ (yank-pop argument)
4.2184+ ;; Return to our original state.
4.2185+ (setq last-command 'paredit-yank-pop)
4.2186+ (setq this-command 'paredit-yank-pop)
4.2187+ (save-excursion (backward-up-list) (indent-sexp)))
4.2188+ (t (error "Last command was not a yank or a wrap: %s" last-command))))
4.2189+
4.2190+(defun paredit-splice-sexp (&optional argument)
4.2191+ "Splice the list that the point is on by removing its delimiters.
4.2192+With a prefix argument as in `C-u', kill all S-expressions backward in
4.2193+ the current list before splicing all S-expressions forward into the
4.2194+ enclosing list.
4.2195+With two prefix arguments as in `C-u C-u', kill all S-expressions
4.2196+ forward in the current list before splicing all S-expressions
4.2197+ backward into the enclosing list.
4.2198+With a numerical prefix argument N, kill N S-expressions backward in
4.2199+ the current list before splicing the remaining S-expressions into the
4.2200+ enclosing list. If N is negative, kill forward.
4.2201+Inside a string, unescape all backslashes, or signal an error if doing
4.2202+ so would invalidate the buffer's structure."
4.2203+ (interactive "P")
4.2204+ (if (paredit-in-string-p)
4.2205+ (paredit-splice-string argument)
4.2206+ (if (paredit-in-comment-p)
4.2207+ (error "Can't splice comment."))
4.2208+ (paredit-handle-sexp-errors (paredit-enclosing-list-start)
4.2209+ (error "Can't splice top level."))
4.2210+ (paredit-kill-surrounding-sexps-for-splice argument)
4.2211+ (let ((delete-start (paredit-enclosing-list-start))
4.2212+ (delete-end
4.2213+ (let ((limit
4.2214+ (save-excursion
4.2215+ (paredit-ignore-sexp-errors (forward-sexp) (backward-sexp))
4.2216+ (point))))
4.2217+ (save-excursion
4.2218+ (backward-up-list)
4.2219+ (forward-char +1)
4.2220+ (paredit-skip-whitespace t limit)
4.2221+ (point)))))
4.2222+ (let ((end-marker (make-marker)))
4.2223+ (save-excursion
4.2224+ (up-list)
4.2225+ (delete-char -1)
4.2226+ (set-marker end-marker (point)))
4.2227+ (delete-region delete-start delete-end)
4.2228+ (paredit-splice-reindent delete-start (marker-position end-marker))))))
4.2229+
4.2230+(defun paredit-splice-reindent (start end)
4.2231+ (paredit-preserving-column
4.2232+ ;; If we changed the first subform of the enclosing list, we must
4.2233+ ;; reindent the whole enclosing list.
4.2234+ (if (paredit-handle-sexp-errors
4.2235+ (save-excursion
4.2236+ (backward-up-list)
4.2237+ (down-list)
4.2238+ (paredit-ignore-sexp-errors (forward-sexp))
4.2239+ (< start (point)))
4.2240+ nil)
4.2241+ (save-excursion (backward-up-list) (indent-sexp))
4.2242+ (paredit-indent-region start end))))
4.2243+
4.2244+(defun paredit-kill-surrounding-sexps-for-splice (argument)
4.2245+ (cond ((or (paredit-in-string-p)
4.2246+ (paredit-in-comment-p))
4.2247+ (error "Invalid context for splicing S-expressions."))
4.2248+ ((or (not argument) (eq argument 0)) nil)
4.2249+ ((or (numberp argument) (eq argument '-))
4.2250+ ;; Kill S-expressions before/after the point by saving the
4.2251+ ;; point, moving across them, and killing the region.
4.2252+ (let* ((argument (if (eq argument '-) -1 argument))
4.2253+ (saved (paredit-point-at-sexp-boundary (- argument))))
4.2254+ (goto-char saved)
4.2255+ (paredit-ignore-sexp-errors (backward-sexp argument))
4.2256+ (paredit-hack-kill-region saved (point))))
4.2257+ ((consp argument)
4.2258+ (let ((v (car argument)))
4.2259+ (if (= v 4) ;One `C-u'.
4.2260+ ;; Move backward until we hit the open paren; then
4.2261+ ;; kill that selected region.
4.2262+ (let ((end (point)))
4.2263+ (paredit-ignore-sexp-errors
4.2264+ (while (not (bobp))
4.2265+ (backward-sexp)))
4.2266+ (paredit-hack-kill-region (point) end))
4.2267+ ;; Move forward until we hit the close paren; then
4.2268+ ;; kill that selected region.
4.2269+ (let ((beginning (point)))
4.2270+ (paredit-ignore-sexp-errors
4.2271+ (while (not (eobp))
4.2272+ (forward-sexp)))
4.2273+ (paredit-hack-kill-region beginning (point))))))
4.2274+ (t (error "Bizarre prefix argument `%s'." argument))))
4.2275+
4.2276+(defun paredit-splice-sexp-killing-backward (&optional n)
4.2277+ "Splice the list the point is on by removing its delimiters, and
4.2278+ also kill all S-expressions before the point in the current list.
4.2279+With a prefix argument N, kill only the preceding N S-expressions."
4.2280+ (interactive "P")
4.2281+ (paredit-splice-sexp (if n
4.2282+ (prefix-numeric-value n)
4.2283+ '(4))))
4.2284+
4.2285+(defun paredit-splice-sexp-killing-forward (&optional n)
4.2286+ "Splice the list the point is on by removing its delimiters, and
4.2287+ also kill all S-expressions after the point in the current list.
4.2288+With a prefix argument N, kill only the following N S-expressions."
4.2289+ (interactive "P")
4.2290+ (paredit-splice-sexp (if n
4.2291+ (- (prefix-numeric-value n))
4.2292+ '(16))))
4.2293+
4.2294+(defun paredit-raise-sexp (&optional argument)
4.2295+ "Raise the following S-expression in a tree, deleting its siblings.
4.2296+With a prefix argument N, raise the following N S-expressions. If N
4.2297+ is negative, raise the preceding N S-expressions.
4.2298+If the point is on an S-expression, such as a string or a symbol, not
4.2299+ between them, that S-expression is considered to follow the point."
4.2300+ (interactive "P")
4.2301+ (save-excursion
4.2302+ ;; Select the S-expressions we want to raise in a buffer substring.
4.2303+ (let* ((bound
4.2304+ (if (and (not argument) (paredit-region-active-p))
4.2305+ (progn (if (< (mark) (point))
4.2306+ (paredit-check-region (mark) (point))
4.2307+ (paredit-check-region (point) (mark)))
4.2308+ (mark))
4.2309+ (cond ((paredit-in-string-p)
4.2310+ (goto-char (car (paredit-string-start+end-points))))
4.2311+ ((paredit-in-char-p)
4.2312+ (backward-sexp))
4.2313+ ((paredit-in-comment-p)
4.2314+ (error "No S-expression to raise in comment.")))
4.2315+ (scan-sexps (point) (prefix-numeric-value argument))))
4.2316+ (sexps
4.2317+ (if (< bound (point))
4.2318+ (buffer-substring bound (paredit-point-at-sexp-end))
4.2319+ (buffer-substring (paredit-point-at-sexp-start) bound))))
4.2320+ ;; Move up to the list we're raising those S-expressions out of and
4.2321+ ;; delete it.
4.2322+ (backward-up-list)
4.2323+ (delete-region (point) (scan-sexps (point) 1))
4.2324+ (let* ((indent-start (point))
4.2325+ (indent-end (save-excursion (insert sexps) (point))))
4.2326+ ;; If the expression spans multiple lines, its indentation is
4.2327+ ;; probably broken, so reindent it -- but don't reindent
4.2328+ ;; anything that we didn't touch outside the expression.
4.2329+ ;;
4.2330+ ;; XXX What if the *column* of the starting point was preserved
4.2331+ ;; too? Should we avoid reindenting in that case?
4.2332+ (if (not (eq (save-excursion (goto-char indent-start) (point-at-eol))
4.2333+ (save-excursion (goto-char indent-end) (point-at-eol))))
4.2334+ (indent-region indent-start indent-end nil))))))
4.2335+
4.2336+;;; The effects of convolution on the surrounding whitespace are pretty
4.2337+;;; random. If you have better suggestions, please let me know.
4.2338+
4.2339+(defun paredit-convolute-sexp (&optional n)
4.2340+ "Convolute S-expressions.
4.2341+Save the S-expressions preceding point and delete them.
4.2342+Splice the S-expressions following point.
4.2343+Wrap the enclosing list in a new list prefixed by the saved text.
4.2344+With a prefix argument N, move up N lists before wrapping."
4.2345+ (interactive "p")
4.2346+ (paredit-lose-if-not-in-sexp 'paredit-convolute-sexp)
4.2347+ ;; Make sure we can move up before destroying anything.
4.2348+ (save-excursion (backward-up-list n) (backward-up-list))
4.2349+ (let (open close) ;++ Is this a good idea?
4.2350+ (let ((prefix
4.2351+ (let ((end (point)))
4.2352+ (paredit-ignore-sexp-errors
4.2353+ (while (not (bobp)) (backward-sexp)))
4.2354+ (prog1 (buffer-substring (point) end)
4.2355+ (backward-up-list)
4.2356+ (save-excursion (forward-sexp)
4.2357+ (setq close (char-before))
4.2358+ (delete-char -1))
4.2359+ (setq open (char-after))
4.2360+ (delete-region (point) end)
4.2361+ ;; I'm not sure this makes sense...
4.2362+ (if (not (eolp)) (just-one-space))))))
4.2363+ (backward-up-list n)
4.2364+ (paredit-insert-pair 1 open close 'goto-char)
4.2365+ (insert prefix)
4.2366+ ;; I'm not sure this makes sense either...
4.2367+ (if (not (eolp)) (just-one-space))
4.2368+ (save-excursion
4.2369+ (backward-up-list)
4.2370+ (paredit-ignore-sexp-errors (indent-sexp))))))
4.2371+
4.2372+(defun paredit-splice-string (argument)
4.2373+ (let ((original-point (point))
4.2374+ (start+end (paredit-string-start+end-points)))
4.2375+ (let ((start (car start+end))
4.2376+ (end (cdr start+end)))
4.2377+ ;; START and END both lie before the respective quote
4.2378+ ;; characters, which we want to delete; thus we increment START
4.2379+ ;; by one to extract the string, and we increment END by one to
4.2380+ ;; delete the string.
4.2381+ (let* ((escaped-string
4.2382+ (cond ((not (consp argument))
4.2383+ (buffer-substring (1+ start) end))
4.2384+ ((= 4 (car argument))
4.2385+ (buffer-substring original-point end))
4.2386+ (t
4.2387+ (buffer-substring (1+ start) original-point))))
4.2388+ (unescaped-string
4.2389+ (paredit-unescape-string escaped-string)))
4.2390+ (if (not unescaped-string)
4.2391+ (error "Unspliceable string.")
4.2392+ (save-excursion
4.2393+ (goto-char start)
4.2394+ (delete-region start (1+ end))
4.2395+ (insert unescaped-string))
4.2396+ (if (not (and (consp argument)
4.2397+ (= 4 (car argument))))
4.2398+ (goto-char (- original-point 1))))))))
4.2399+
4.2400+(defun paredit-unescape-string (string)
4.2401+ (with-temp-buffer
4.2402+ (insert string)
4.2403+ (goto-char (point-min))
4.2404+ (while (and (not (eobp))
4.2405+ ;; nil -> no bound; t -> no errors.
4.2406+ (search-forward "\\" nil t))
4.2407+ (delete-char -1)
4.2408+ (forward-char))
4.2409+ (paredit-handle-sexp-errors
4.2410+ (progn (scan-sexps (point-min) (point-max))
4.2411+ (buffer-string))
4.2412+ nil)))
4.2413+
4.2414+;;;; Slurpage & Barfage
4.2415+
4.2416+(defun paredit-forward-slurp-sexp (&optional argument)
4.2417+ "Add the S-expression following the current list into that list
4.2418+ by moving the closing delimiter.
4.2419+Automatically reindent the newly slurped S-expression with respect to
4.2420+ its new enclosing form.
4.2421+If in a string, move the opening double-quote forward by one
4.2422+ S-expression and escape any intervening characters as necessary,
4.2423+ without altering any indentation or formatting."
4.2424+ (interactive "P")
4.2425+ (save-excursion
4.2426+ (cond ((paredit-in-comment-p)
4.2427+ (error "Invalid context for slurping S-expressions."))
4.2428+ ((numberp argument)
4.2429+ (if (< argument 0)
4.2430+ (paredit-forward-barf-sexp (- 0 argument))
4.2431+ (while (< 0 argument)
4.2432+ (paredit-forward-slurp-sexp)
4.2433+ (setq argument (- argument 1)))))
4.2434+ ((paredit-in-string-p)
4.2435+ ;; If there is anything to slurp into the string, take that.
4.2436+ ;; Otherwise, try to slurp into the enclosing list.
4.2437+ (if (save-excursion
4.2438+ (goto-char (paredit-enclosing-string-end))
4.2439+ (paredit-handle-sexp-errors (progn (forward-sexp) nil)
4.2440+ t))
4.2441+ (progn
4.2442+ (goto-char (paredit-enclosing-string-end))
4.2443+ (paredit-forward-slurp-into-list argument))
4.2444+ (paredit-forward-slurp-into-string argument)))
4.2445+ (t
4.2446+ (paredit-forward-slurp-into-list argument)))))
4.2447+
4.2448+(defun paredit-forward-slurp-into-list (&optional argument)
4.2449+ (let ((nestedp nil))
4.2450+ (save-excursion
4.2451+ (up-list) ; Up to the end of the list to
4.2452+ (let ((close (char-before))) ; save and delete the closing
4.2453+ (delete-char -1) ; delimiter.
4.2454+ (let ((start (point)))
4.2455+ (catch 'return ; Go to the end of the desired
4.2456+ (while t ; S-expression, going up a
4.2457+ (paredit-handle-sexp-errors ; list if it's not in this,
4.2458+ (progn (forward-sexp)
4.2459+ (if argument
4.2460+ (paredit-ignore-sexp-errors
4.2461+ (while (not (eobp))
4.2462+ (forward-sexp))))
4.2463+ (throw 'return nil))
4.2464+ (setq nestedp t)
4.2465+ (up-list)
4.2466+ (setq close ; adjusting for mixed
4.2467+ (prog1 (char-before) ; delimiters as necessary,
4.2468+ (delete-char -1)
4.2469+ (insert close))))))
4.2470+ (insert close) ; to insert that delimiter.
4.2471+ (indent-region start (point) nil))))
4.2472+ (if (and (not nestedp)
4.2473+ (eq (save-excursion (paredit-skip-whitespace nil) (point))
4.2474+ (save-excursion (backward-up-list) (forward-char) (point)))
4.2475+ (eq (save-excursion (forward-sexp) (backward-sexp) (point))
4.2476+ (save-excursion (paredit-skip-whitespace t) (point))))
4.2477+ (delete-region (save-excursion (paredit-skip-whitespace nil) (point))
4.2478+ (save-excursion (paredit-skip-whitespace t) (point))))))
4.2479+
4.2480+(defun paredit-forward-slurp-into-string (&optional argument)
4.2481+ (let ((start (paredit-enclosing-string-start))
4.2482+ (end (paredit-enclosing-string-end)))
4.2483+ (goto-char end)
4.2484+ ;; Signal any errors that we might get first, before mucking with
4.2485+ ;; the buffer's contents.
4.2486+ (save-excursion (forward-sexp))
4.2487+ (let ((close (char-before)))
4.2488+ ;; Skip intervening whitespace if we're slurping into an empty
4.2489+ ;; string. XXX What about nonempty strings?
4.2490+ (if (and (= (+ start 2) end)
4.2491+ (eq (save-excursion (paredit-skip-whitespace t) (point))
4.2492+ (save-excursion (forward-sexp) (backward-sexp) (point))))
4.2493+ (delete-region (- (point) 1)
4.2494+ (save-excursion (paredit-skip-whitespace t) (point)))
4.2495+ (delete-char -1))
4.2496+ (paredit-forward-for-quote
4.2497+ (save-excursion
4.2498+ (forward-sexp)
4.2499+ (if argument
4.2500+ (while (paredit-handle-sexp-errors (progn (forward-sexp) t) nil)))
4.2501+ (point)))
4.2502+ (insert close))))
4.2503+
4.2504+(defun paredit-forward-barf-sexp (&optional argument)
4.2505+ "Remove the last S-expression in the current list from that list
4.2506+ by moving the closing delimiter.
4.2507+Automatically reindent the newly barfed S-expression with respect to
4.2508+ its new enclosing form."
4.2509+ (interactive "P")
4.2510+ (paredit-lose-if-not-in-sexp 'paredit-forward-barf-sexp)
4.2511+ (if (and (numberp argument) (< argument 0))
4.2512+ (paredit-forward-slurp-sexp (- 0 argument))
4.2513+ (let ((start (point)) (end nil))
4.2514+ (save-excursion
4.2515+ (up-list) ; Up to the end of the list to
4.2516+ (let ((close (char-before))) ; save and delete the closing
4.2517+ (delete-char -1) ; delimiter.
4.2518+ (setq end (point))
4.2519+ (paredit-ignore-sexp-errors ; Go back to where we want to
4.2520+ (if (or (not argument) ; insert the delimiter.
4.2521+ (numberp argument))
4.2522+ (backward-sexp argument)
4.2523+ (while (paredit-handle-sexp-errors
4.2524+ (save-excursion (backward-sexp) (<= start (point)))
4.2525+ nil)
4.2526+ (backward-sexp))))
4.2527+ (paredit-skip-whitespace nil) ; Skip leading whitespace.
4.2528+ (cond ((bobp)
4.2529+ ;++ We'll have deleted the close, but there's no open.
4.2530+ ;++ Is that OK?
4.2531+ (error "Barfing all subexpressions with no open-paren?"))
4.2532+ ((paredit-in-comment-p) ; Don't put the close-paren in
4.2533+ (newline))) ; a comment.
4.2534+ (insert close))
4.2535+ ;; Reindent all of the newly barfed S-expressions. Start at the
4.2536+ ;; start of the first barfed S-expression, not at the close we
4.2537+ ;; just inserted.
4.2538+ (forward-sexp)
4.2539+ (backward-sexp)
4.2540+ (if (or (not argument) (numberp argument))
4.2541+ (paredit-forward-and-indent argument)
4.2542+ (indent-region (point) end))))))
4.2543+
4.2544+(defun paredit-backward-slurp-sexp (&optional argument)
4.2545+ "Add the S-expression preceding the current list into that list
4.2546+ by moving the closing delimiter.
4.2547+Automatically reindent the whole form into which new S-expression was
4.2548+ slurped.
4.2549+If in a string, move the opening double-quote backward by one
4.2550+ S-expression and escape any intervening characters as necessary,
4.2551+ without altering any indentation or formatting."
4.2552+ (interactive "P")
4.2553+ (save-excursion
4.2554+ (cond ((paredit-in-comment-p)
4.2555+ (error "Invalid context for slurping S-expressions."))
4.2556+ ((numberp argument)
4.2557+ (if (< argument 0)
4.2558+ (paredit-backward-barf-sexp (- 0 argument))
4.2559+ (while (< 0 argument)
4.2560+ (paredit-backward-slurp-sexp)
4.2561+ (setq argument (- argument 1)))))
4.2562+ ((paredit-in-string-p)
4.2563+ ;; If there is anything to slurp into the string, take that.
4.2564+ ;; Otherwise, try to slurp into the enclosing list.
4.2565+ (if (save-excursion
4.2566+ (goto-char (paredit-enclosing-string-start))
4.2567+ (paredit-handle-sexp-errors (progn (backward-sexp) nil)
4.2568+ t))
4.2569+ (progn
4.2570+ (goto-char (paredit-enclosing-string-start))
4.2571+ (paredit-backward-slurp-into-list argument))
4.2572+ (paredit-backward-slurp-into-string argument)))
4.2573+ (t
4.2574+ (paredit-backward-slurp-into-list argument)))))
4.2575+
4.2576+(defun paredit-backward-slurp-into-list (&optional argument)
4.2577+ (let ((nestedp nil))
4.2578+ (save-excursion
4.2579+ (backward-up-list)
4.2580+ (let ((open (char-after)))
4.2581+ (delete-char +1)
4.2582+ (catch 'return
4.2583+ (while t
4.2584+ (paredit-handle-sexp-errors
4.2585+ (progn (backward-sexp)
4.2586+ (if argument
4.2587+ (paredit-ignore-sexp-errors
4.2588+ (while (not (bobp))
4.2589+ (backward-sexp))))
4.2590+ (throw 'return nil))
4.2591+ (setq nestedp t)
4.2592+ (backward-up-list)
4.2593+ (setq open
4.2594+ (prog1 (char-after)
4.2595+ (save-excursion (insert open) (delete-char +1)))))))
4.2596+ (insert open))
4.2597+ ;; Reindent the line at the beginning of wherever we inserted the
4.2598+ ;; opening delimiter, and then indent the whole S-expression.
4.2599+ (backward-up-list)
4.2600+ (lisp-indent-line)
4.2601+ (indent-sexp))
4.2602+ ;; If we slurped into an empty list, don't leave dangling space:
4.2603+ ;; (foo |).
4.2604+ (if (and (not nestedp)
4.2605+ (eq (save-excursion (paredit-skip-whitespace nil) (point))
4.2606+ (save-excursion (backward-sexp) (forward-sexp) (point)))
4.2607+ (eq (save-excursion (up-list) (backward-char) (point))
4.2608+ (save-excursion (paredit-skip-whitespace t) (point))))
4.2609+ (delete-region (save-excursion (paredit-skip-whitespace nil) (point))
4.2610+ (save-excursion (paredit-skip-whitespace t) (point))))))
4.2611+
4.2612+(defun paredit-backward-slurp-into-string (&optional argument)
4.2613+ (let ((start (paredit-enclosing-string-start))
4.2614+ (end (paredit-enclosing-string-end)))
4.2615+ (goto-char start)
4.2616+ ;; Signal any errors that we might get first, before mucking with
4.2617+ ;; the buffer's contents.
4.2618+ (save-excursion (backward-sexp))
4.2619+ (let ((open (char-after))
4.2620+ (target (point)))
4.2621+ ;; Skip intervening whitespace if we're slurping into an empty
4.2622+ ;; string. XXX What about nonempty strings?
4.2623+ (if (and (= (+ start 2) end)
4.2624+ (eq (save-excursion (paredit-skip-whitespace nil) (point))
4.2625+ (save-excursion (backward-sexp) (forward-sexp) (point))))
4.2626+ (delete-region (save-excursion (paredit-skip-whitespace nil) (point))
4.2627+ (+ (point) 1))
4.2628+ (delete-char +1))
4.2629+ (backward-sexp)
4.2630+ (if argument
4.2631+ (paredit-ignore-sexp-errors
4.2632+ (while (not (bobp))
4.2633+ (backward-sexp))))
4.2634+ (insert open)
4.2635+ (paredit-forward-for-quote target))))
4.2636+
4.2637+(defun paredit-backward-barf-sexp (&optional argument)
4.2638+ "Remove the first S-expression in the current list from that list
4.2639+ by moving the closing delimiter.
4.2640+Automatically reindent the barfed S-expression and the form from which
4.2641+ it was barfed."
4.2642+ (interactive "P")
4.2643+ (paredit-lose-if-not-in-sexp 'paredit-backward-barf-sexp)
4.2644+ (if (and (numberp argument) (< argument 0))
4.2645+ (paredit-backward-slurp-sexp (- 0 argument))
4.2646+ (let ((end (make-marker)))
4.2647+ (set-marker end (point))
4.2648+ (save-excursion
4.2649+ (backward-up-list)
4.2650+ (let ((open (char-after)))
4.2651+ (delete-char +1)
4.2652+ (paredit-ignore-sexp-errors
4.2653+ (paredit-forward-and-indent
4.2654+ (if (or (not argument) (numberp argument))
4.2655+ argument
4.2656+ (let ((n 0))
4.2657+ (save-excursion
4.2658+ (while (paredit-handle-sexp-errors
4.2659+ (save-excursion
4.2660+ (forward-sexp)
4.2661+ (<= (point) end))
4.2662+ nil)
4.2663+ (forward-sexp)
4.2664+ (setq n (+ n 1))))
4.2665+ n))))
4.2666+ (while (progn (paredit-skip-whitespace t) (eq (char-after) ?\; ))
4.2667+ (forward-line 1))
4.2668+ (if (eobp)
4.2669+ ;++ We'll have deleted the close, but there's no open.
4.2670+ ;++ Is that OK?
4.2671+ (error "Barfing all subexpressions with no close-paren?"))
4.2672+ ;** Don't use `insert' here. Consider, e.g., barfing from
4.2673+ ;** (foo|)
4.2674+ ;** and how `save-excursion' works.
4.2675+ (insert-before-markers open))
4.2676+ (backward-up-list)
4.2677+ (lisp-indent-line)
4.2678+ (indent-sexp)))))
4.2679+
4.2680+;;;; Splitting & Joining
4.2681+
4.2682+(defun paredit-split-sexp ()
4.2683+ "Split the list or string the point is on into two."
4.2684+ (interactive)
4.2685+ (cond ((paredit-in-string-p)
4.2686+ (insert "\"")
4.2687+ (save-excursion (insert " \"")))
4.2688+ ((or (paredit-in-comment-p)
4.2689+ (paredit-in-char-p))
4.2690+ (error "Invalid context for splitting S-expression."))
4.2691+ (t
4.2692+ (let ((open (save-excursion (backward-up-list) (char-after)))
4.2693+ (close (save-excursion (up-list) (char-before))))
4.2694+ (delete-horizontal-space)
4.2695+ (insert close)
4.2696+ (save-excursion
4.2697+ (insert ?\ )
4.2698+ (insert open)
4.2699+ (backward-char)
4.2700+ (indent-sexp))))))
4.2701+
4.2702+(defun paredit-join-sexps ()
4.2703+ "Join the S-expressions adjacent on either side of the point.
4.2704+Both must be lists, strings, or atoms; error if there is a mismatch."
4.2705+ (interactive)
4.2706+ (cond ((paredit-in-comment-p) (error "Can't join S-expressions in comment."))
4.2707+ ((paredit-in-string-p) (error "Nothing to join in a string."))
4.2708+ ((paredit-in-char-p) (error "Can't join characters.")))
4.2709+ (let ((left-point (paredit-point-at-sexp-end))
4.2710+ (right-point (paredit-point-at-sexp-start)))
4.2711+ (let ((left-char (char-before left-point))
4.2712+ (right-char (char-after right-point)))
4.2713+ (let ((left-syntax (char-syntax left-char))
4.2714+ (right-syntax (char-syntax right-char)))
4.2715+ (cond ((< right-point left-point)
4.2716+ (error "Can't join a datum with itself."))
4.2717+ ((and (eq left-syntax ?\) )
4.2718+ (eq right-syntax ?\( )
4.2719+ (eq left-char (matching-paren right-char))
4.2720+ (eq right-char (matching-paren left-char)))
4.2721+ (paredit-join-lists-internal left-point right-point)
4.2722+ (paredit-preserving-column
4.2723+ (save-excursion
4.2724+ (backward-up-list)
4.2725+ (indent-sexp))))
4.2726+ ((and (eq left-syntax ?\" )
4.2727+ (eq right-syntax ?\" ))
4.2728+ ;; Delete any intermediate formatting.
4.2729+ (delete-region (1- left-point) (1+ right-point)))
4.2730+ ((and (memq left-syntax '(?w ?_)) ; Word or symbol
4.2731+ (memq right-syntax '(?w ?_)))
4.2732+ (delete-region left-point right-point))
4.2733+ (t (error "Mismatched S-expressions to join.")))))))
4.2734+
4.2735+(defun paredit-join-lists-internal (left-point right-point)
4.2736+ (save-excursion
4.2737+ ;; Leave intermediate formatting alone.
4.2738+ (goto-char right-point)
4.2739+ (delete-char +1)
4.2740+ (goto-char left-point)
4.2741+ (delete-char -1)
4.2742+ ;; Kludge: Add an extra space in several conditions.
4.2743+ (if (or
4.2744+ ;; (foo)| ;x\n(bar) => (foo | ;x\nbar), not (foo| ;x\nbar).
4.2745+ (and (not (eolp))
4.2746+ (save-excursion
4.2747+ (paredit-skip-whitespace t (point-at-eol))
4.2748+ (eq (char-after) ?\;)))
4.2749+ ;; (foo)|(bar) => (foo| bar), not (foo|bar).
4.2750+ (and (= left-point right-point)
4.2751+ (not (or (eq ?\ (char-syntax (char-before)))
4.2752+ (eq ?\ (char-syntax (char-after)))))))
4.2753+ (insert ?\ ))))
4.2754+
4.2755+;++ How ought paredit-join to handle comments intervening symbols or strings?
4.2756+;++ Idea:
4.2757+;++
4.2758+;++ "foo" | ;bar
4.2759+;++ "baz" ;quux
4.2760+;++
4.2761+;++ =>
4.2762+;++
4.2763+;++ "foo|baz" ;bar
4.2764+;++ ;quux
4.2765+;++
4.2766+;++ The point should stay where it is relative to the comments, and the
4.2767+;++ the comments' columns should all be preserved, perhaps. Hmmmm...
4.2768+;++ What about this?
4.2769+;++
4.2770+;++ "foo" ;bar
4.2771+;++ | ;baz
4.2772+;++ "quux" ;zot
4.2773+
4.2774+;++ Should rename:
4.2775+;++ paredit-point-at-sexp-start -> paredit-start-of-sexp-after-point
4.2776+;++ paredit-point-at-sexp-end -> paredit-end-of-sexp-before-point
4.2777+
4.2778+;;;; Variations on the Lurid Theme
4.2779+
4.2780+;;; I haven't the imagination to concoct clever names for these.
4.2781+
4.2782+(defun paredit-add-to-previous-list ()
4.2783+ "Add the S-expression following point to the list preceding point."
4.2784+ (interactive)
4.2785+ (paredit-lose-if-not-in-sexp 'paredit-add-to-previous-list)
4.2786+ (save-excursion
4.2787+ (down-list -1) ;++ backward-down-list...
4.2788+ (paredit-forward-slurp-sexp)))
4.2789+
4.2790+(defun paredit-add-to-next-list ()
4.2791+ "Add the S-expression preceding point to the list following point.
4.2792+If no S-expression precedes point, move up the tree until one does."
4.2793+ (interactive)
4.2794+ (paredit-lose-if-not-in-sexp 'paredit-add-to-next-list)
4.2795+ (save-excursion
4.2796+ (down-list)
4.2797+ (paredit-backward-slurp-sexp)))
4.2798+
4.2799+(defun paredit-join-with-previous-list ()
4.2800+ "Join the list the point is on with the previous list in the buffer."
4.2801+ (interactive)
4.2802+ (paredit-lose-if-not-in-sexp 'paredit-join-with-previous-list)
4.2803+ (save-excursion
4.2804+ (while (paredit-handle-sexp-errors (save-excursion (backward-sexp) nil)
4.2805+ (backward-up-list)
4.2806+ t))
4.2807+ (paredit-join-sexps)))
4.2808+
4.2809+(defun paredit-join-with-next-list ()
4.2810+ "Join the list the point is on with the next list in the buffer."
4.2811+ (interactive)
4.2812+ (paredit-lose-if-not-in-sexp 'paredit-join-with-next-list)
4.2813+ (save-excursion
4.2814+ (while (paredit-handle-sexp-errors (save-excursion (forward-sexp) nil)
4.2815+ (up-list)
4.2816+ t))
4.2817+ (paredit-join-sexps)))
4.2818+
4.2819+;;;; Utilities
4.2820+
4.2821+(defun paredit-in-string-escape-p ()
4.2822+ "True if the point is on a character escape of a string.
4.2823+This is true only if the character is preceded by an odd number of
4.2824+ backslashes.
4.2825+This assumes that `paredit-in-string-p' has already returned true."
4.2826+ (let ((oddp nil))
4.2827+ (save-excursion
4.2828+ (while (eq (char-before) ?\\ )
4.2829+ (setq oddp (not oddp))
4.2830+ (backward-char)))
4.2831+ oddp))
4.2832+
4.2833+(defun paredit-in-char-p (&optional position)
4.2834+ "True if point is on a character escape outside a string."
4.2835+ (save-excursion
4.2836+ (goto-char (or position (point)))
4.2837+ (paredit-in-string-escape-p)))
4.2838+
4.2839+(defun paredit-skip-whitespace (trailing-p &optional limit)
4.2840+ "Skip past any whitespace, or until the point LIMIT is reached.
4.2841+If TRAILING-P is nil, skip leading whitespace; otherwise, skip trailing
4.2842+ whitespace."
4.2843+ (funcall (if trailing-p 'skip-chars-forward 'skip-chars-backward)
4.2844+ " \t\n " ; This should skip using the syntax table, but LF
4.2845+ limit)) ; is a comment end, not newline, in Lisp mode.
4.2846+
4.2847+(defalias 'paredit-region-active-p
4.2848+ (xcond ((paredit-xemacs-p) 'region-active-p)
4.2849+ ((paredit-gnu-emacs-p)
4.2850+ (lambda ()
4.2851+ (and mark-active transient-mark-mode)))))
4.2852+
4.2853+(defun paredit-hack-kill-region (start end)
4.2854+ "Kill the region between START and END.
4.2855+Do not append to any current kill, and
4.2856+ do not let the next kill append to this one."
4.2857+ (interactive "r") ;Eh, why not?
4.2858+ ;; KILL-REGION sets THIS-COMMAND to tell the next kill that the last
4.2859+ ;; command was a kill. It also checks LAST-COMMAND to see whether it
4.2860+ ;; should append. If we bind these locally, any modifications to
4.2861+ ;; THIS-COMMAND will be masked, and it will not see LAST-COMMAND to
4.2862+ ;; indicate that it should append.
4.2863+ (let ((this-command nil)
4.2864+ (last-command nil))
4.2865+ (kill-region start end)))
4.2866+
4.2867+;;;;; Reindentation utilities
4.2868+
4.2869+;++ Should `paredit-indent-sexps' and `paredit-forward-and-indent' use
4.2870+;++ `paredit-indent-region' rather than `indent-region'?
4.2871+
4.2872+(defun paredit-indent-sexps ()
4.2873+ "If in a list, indent all following S-expressions in the list."
4.2874+ (let* ((start (point))
4.2875+ (end (paredit-handle-sexp-errors (progn (up-list) (point)) nil)))
4.2876+ (if end
4.2877+ (indent-region start end nil))))
4.2878+
4.2879+(defun paredit-forward-and-indent (&optional n)
4.2880+ "Move forward by N S-expressions, indenting them with `indent-region'."
4.2881+ (let ((start (point)))
4.2882+ (forward-sexp n)
4.2883+ (indent-region start (point) nil)))
4.2884+
4.2885+(defun paredit-indent-region (start end)
4.2886+ "Indent the region from START to END.
4.2887+Don't reindent the line starting at START, however."
4.2888+ (if (not (<= start end))
4.2889+ (error "Incorrectly related points: %S, %S" start end))
4.2890+ (save-excursion
4.2891+ (goto-char start)
4.2892+ (let ((bol (point-at-bol)))
4.2893+ ;; Skip all S-expressions that end on the starting line, but
4.2894+ ;; don't go past `end'.
4.2895+ (if (and (save-excursion (goto-char end) (not (eq bol (point-at-bol))))
4.2896+ (paredit-handle-sexp-errors
4.2897+ (catch 'exit
4.2898+ (while t
4.2899+ (save-excursion
4.2900+ (forward-sexp)
4.2901+ (if (not (eq bol (point-at-bol)))
4.2902+ (throw 'exit t))
4.2903+ (if (not (< (point) end))
4.2904+ (throw 'exit nil)))
4.2905+ (forward-sexp)))
4.2906+ nil))
4.2907+ (progn
4.2908+ ;; Point is still on the same line, but precedes an
4.2909+ ;; S-expression that ends on a different line.
4.2910+ (if (not (eq bol (point-at-bol)))
4.2911+ (error "Internal error -- we moved forward a line!"))
4.2912+ (goto-char (+ 1 (point-at-eol)))
4.2913+ (if (not (<= (point) end))
4.2914+ (error "Internal error -- we frobnitzed the garfnut!"))
4.2915+ (indent-region (point) end nil))))))
4.2916+
4.2917+;;;;; S-expression Parsing Utilities
4.2918+
4.2919+;++ These routines redundantly traverse S-expressions a great deal.
4.2920+;++ If performance issues arise, this whole section will probably have
4.2921+;++ to be refactored to preserve the state longer, like paredit.scm
4.2922+;++ does, rather than to traverse the definition N times for every key
4.2923+;++ stroke as it presently does.
4.2924+
4.2925+(defun paredit-current-parse-state ()
4.2926+ "Return parse state of point from beginning of defun."
4.2927+ (let ((point (point)))
4.2928+ (beginning-of-defun)
4.2929+ ;; Calling PARSE-PARTIAL-SEXP will advance the point to its second
4.2930+ ;; argument (unless parsing stops due to an error, but we assume it
4.2931+ ;; won't in paredit-mode).
4.2932+ (parse-partial-sexp (point) point)))
4.2933+
4.2934+(defun paredit-in-string-p (&optional state)
4.2935+ "True if the parse state is within a double-quote-delimited string.
4.2936+If no parse state is supplied, compute one from the beginning of the
4.2937+ defun to the point."
4.2938+ ;; 3. non-nil if inside a string (the terminator character, really)
4.2939+ (and (nth 3 (or state (paredit-current-parse-state)))
4.2940+ t))
4.2941+
4.2942+(defun paredit-string-start+end-points (&optional state)
4.2943+ "Return a cons of the points of open and close quotes of the string.
4.2944+The string is determined from the parse state STATE, or the parse state
4.2945+ from the beginning of the defun to the point.
4.2946+This assumes that `paredit-in-string-p' has already returned true, i.e.
4.2947+ that the point is already within a string."
4.2948+ (save-excursion
4.2949+ ;; 8. character address of start of comment or string; nil if not
4.2950+ ;; in one
4.2951+ (let ((start (nth 8 (or state (paredit-current-parse-state)))))
4.2952+ (goto-char start)
4.2953+ (forward-sexp 1)
4.2954+ (cons start (1- (point))))))
4.2955+
4.2956+(defun paredit-enclosing-string-start ()
4.2957+ (car (paredit-string-start+end-points)))
4.2958+
4.2959+(defun paredit-enclosing-string-end ()
4.2960+ (+ 1 (cdr (paredit-string-start+end-points))))
4.2961+
4.2962+(defun paredit-enclosing-list-start ()
4.2963+ (save-excursion
4.2964+ (backward-up-list)
4.2965+ (point)))
4.2966+
4.2967+(defun paredit-enclosing-list-end ()
4.2968+ (save-excursion
4.2969+ (up-list)
4.2970+ (point)))
4.2971+
4.2972+(defun paredit-in-comment-p (&optional state)
4.2973+ "True if parse state STATE is within a comment.
4.2974+If no parse state is supplied, compute one from the beginning of the
4.2975+ defun to the point."
4.2976+ ;; 4. nil if outside a comment, t if inside a non-nestable comment,
4.2977+ ;; else an integer (the current comment nesting)
4.2978+ (and (nth 4 (or state (paredit-current-parse-state)))
4.2979+ t))
4.2980+
4.2981+(defun paredit-prefix-numeric-value (argument)
4.2982+ ;++ Kludgerific.
4.2983+ (cond ((integerp argument) argument)
4.2984+ ((eq argument '-) -1)
4.2985+ ((consp argument)
4.2986+ (cond ((equal argument '(4)) (paredit-count-sexps-forward)) ;C-u
4.2987+ ((equal argument '(16)) (paredit-count-sexps-backward)) ;C-u C-u
4.2988+ (t (error "Invalid prefix argument: %S" argument))))
4.2989+ ((paredit-region-active-p)
4.2990+ (save-excursion
4.2991+ (save-restriction
4.2992+ (narrow-to-region (region-beginning) (region-end))
4.2993+ (cond ((= (point) (point-min)) (paredit-count-sexps-forward))
4.2994+ ((= (point) (point-max)) (paredit-count-sexps-backward))
4.2995+ (t
4.2996+ (error "Point %S is not start or end of region: %S..%S"
4.2997+ (point) (region-beginning) (region-end)))))))
4.2998+ (t 1)))
4.2999+
4.3000+(defun paredit-count-sexps-forward ()
4.3001+ (save-excursion
4.3002+ (let ((n 0) (p nil)) ;hurk
4.3003+ (paredit-ignore-sexp-errors
4.3004+ (while (setq p (scan-sexps (point) +1))
4.3005+ (goto-char p)
4.3006+ (setq n (+ n 1))))
4.3007+ n)))
4.3008+
4.3009+(defun paredit-count-sexps-backward ()
4.3010+ (save-excursion
4.3011+ (let ((n 0) (p nil)) ;hurk
4.3012+ (paredit-ignore-sexp-errors
4.3013+ (while (setq p (scan-sexps (point) -1))
4.3014+ (goto-char p)
4.3015+ (setq n (+ n 1))))
4.3016+ n)))
4.3017+
4.3018+(defun paredit-point-at-sexp-boundary (n)
4.3019+ (cond ((< n 0) (paredit-point-at-sexp-start))
4.3020+ ((= n 0) (point))
4.3021+ ((> n 0) (paredit-point-at-sexp-end))))
4.3022+
4.3023+(defun paredit-point-at-sexp-start ()
4.3024+ (save-excursion
4.3025+ (forward-sexp)
4.3026+ (backward-sexp)
4.3027+ (point)))
4.3028+
4.3029+(defun paredit-point-at-sexp-end ()
4.3030+ (save-excursion
4.3031+ (backward-sexp)
4.3032+ (forward-sexp)
4.3033+ (point)))
4.3034+
4.3035+(defun paredit-lose-if-not-in-sexp (command)
4.3036+ (if (or (paredit-in-string-p)
4.3037+ (paredit-in-comment-p)
4.3038+ (paredit-in-char-p))
4.3039+ (error "Invalid context for command `%s'." command)))
4.3040+
4.3041+(defun paredit-check-region (start end)
4.3042+ "Signal an error if text between `start' and `end' is unbalanced."
4.3043+ ;; `narrow-to-region' will move the point, so avoid calling it if we
4.3044+ ;; don't need to. We don't want to use `save-excursion' because we
4.3045+ ;; want the point to move if `check-parens' reports an error.
4.3046+ (if (not (paredit-region-ok-p start end))
4.3047+ (save-restriction
4.3048+ (narrow-to-region start end)
4.3049+ (check-parens))))
4.3050+
4.3051+(defun paredit-region-ok-p (start end)
4.3052+ "Return true iff the region between `start' and `end' is balanced.
4.3053+This is independent of context -- it doesn't check what state the
4.3054+ text at `start' is in."
4.3055+ (save-excursion
4.3056+ (paredit-handle-sexp-errors
4.3057+ (progn
4.3058+ (save-restriction
4.3059+ (narrow-to-region start end)
4.3060+ (scan-sexps (point-min) (point-max)))
4.3061+ t)
4.3062+ nil)))
4.3063+
4.3064+(defun paredit-current-column ()
4.3065+ ;; Like current-column, but respects field boundaries in interactive
4.3066+ ;; modes like ielm. For use only with paredit-restore-column, which
4.3067+ ;; works relative to point-at-bol.
4.3068+ (- (point) (point-at-bol)))
4.3069+
4.3070+(defun paredit-current-indentation ()
4.3071+ (save-excursion
4.3072+ (back-to-indentation)
4.3073+ (paredit-current-column)))
4.3074+
4.3075+(defun paredit-restore-column (column indentation)
4.3076+ ;; Preserve the point's position either in the indentation or in the
4.3077+ ;; code: if on code, move with the code; if in indentation, leave it
4.3078+ ;; in the indentation, either where it was (if still on indentation)
4.3079+ ;; or at the end of the indentation (if the code moved far enough
4.3080+ ;; left).
4.3081+ (let ((indentation* (paredit-current-indentation)))
4.3082+ (goto-char
4.3083+ (+ (point-at-bol)
4.3084+ (cond ((not (< column indentation))
4.3085+ (+ column (- indentation* indentation)))
4.3086+ ((<= indentation* column) indentation*)
4.3087+ (t column))))))
4.3088+
4.3089+;;;; Initialization
4.3090+
4.3091+(paredit-define-keys)
4.3092+(paredit-annotate-mode-with-examples)
4.3093+(paredit-annotate-functions-with-examples)
4.3094+
4.3095+(provide 'paredit)
4.3096+
4.3097+;;; Local Variables:
4.3098+;;; outline-regexp: " \n;;;;+"
4.3099+;;; End:
4.3100+
4.3101+;;; paredit.el ends here
5.1--- a/.homerc Tue May 14 14:47:50 2024 -0400
5.2+++ b/.homerc Sat Jun 01 23:43:29 2024 -0400
5.3@@ -1,8 +1,8 @@
5.4 ;;; -*- mode:skel; -*-
5.5 :user ellis
5.6-:packy "~/.packy"
5.7+:packy "~/.stash/packy"
5.8 :wm :stumpwm
5.9 :shell :bash
5.10-:browser "/usr/bin/chromium"
5.11+:browser "eww"
5.12 :editor :emacs
5.13-:src "~/dev/comp/home/"
5.14+:src "~/comp/home/"
6.1--- a/.sbclrc Tue May 14 14:47:50 2024 -0400
6.2+++ b/.sbclrc Sat Jun 01 23:43:29 2024 -0400
6.3@@ -26,8 +26,8 @@
6.4
6.5 (mapc #'include-projects-from
6.6 (mapcar (lambda (x) (merge-pathnames x (user-homedir-pathname)))
6.7- (list "dev/comp/core/lisp/"
6.8- "dev/comp/demo/"
6.9- "dev/comp/scratch/")))
6.10+ (list "comp/core/lisp/"
6.11+ "comp/demo/"
6.12+ "comp/scratch/")))
6.13
6.14 ;; (require :sb-aclrepl)
