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