paredit.el (122756B)
1 ;;; paredit.el --- minor mode for editing parentheses -*- Mode: Emacs-Lisp -*- 2 3 ;; Copyright (C) 2005--2019 Taylor R. Campbell 4 5 ;; Author: Taylor R. Campbell <campbell+paredit@mumble.net> 6 ;; Version: 25beta 7 ;; Package-Version: 20191121.2328 8 ;; Package-Commit: 8330a41e8188fe18d3fa805bb9aa529f015318e8 9 ;; Created: 2005-07-31 10 ;; Keywords: lisp 11 12 ;; NOTE: THIS IS A BETA VERSION OF PAREDIT. USE AT YOUR OWN RISK. 13 ;; THIS FILE IS SUBJECT TO CHANGE, AND NOT SUITABLE FOR DISTRIBUTION 14 ;; BY PACKAGE MANAGERS SUCH AS APT, PKGSRC, MACPORTS, &C. 15 16 ;; Paredit is free software: you can redistribute it and/or modify it 17 ;; under the terms of the GNU General Public License as published by 18 ;; the Free Software Foundation, either version 3 of the License, or 19 ;; (at your option) any later version. 20 ;; 21 ;; Paredit is distributed in the hope that it will be useful, but 22 ;; WITHOUT ANY WARRANTY; without even the implied warranty of 23 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 24 ;; GNU General Public License for more details. 25 ;; 26 ;; You should have received a copy of the GNU General Public License 27 ;; along with paredit. If not, see <http://www.gnu.org/licenses/>. 28 29 ;;; The currently released version of paredit is available at 30 ;;; <https://mumble.net/~campbell/emacs/paredit.el>. 31 ;;; 32 ;;; The latest beta version of paredit is available at 33 ;;; <https://mumble.net/~campbell/emacs/paredit-beta.el>. 34 ;;; 35 ;;; The Git repository for paredit is available at 36 ;;; <https://mumble.net/~campbell/git/paredit.git> 37 ;;; 38 ;;; Release notes are available at 39 ;;; <https://mumble.net/~campbell/emacs/paredit.release>. 40 41 ;;; Install paredit by placing `paredit.el' in `/path/to/elisp', a 42 ;;; directory of your choice, and adding to your .emacs file: 43 ;;; 44 ;;; (add-to-list 'load-path "/path/to/elisp") 45 ;;; (autoload 'enable-paredit-mode "paredit" 46 ;;; "Turn on pseudo-structural editing of Lisp code." 47 ;;; t) 48 ;;; 49 ;;; Start Paredit Mode on the fly with `M-x enable-paredit-mode RET', 50 ;;; or always enable it in a major mode `M' (e.g., `lisp') with: 51 ;;; 52 ;;; (add-hook 'M-mode-hook 'enable-paredit-mode) 53 ;;; 54 ;;; Customize paredit using `eval-after-load': 55 ;;; 56 ;;; (eval-after-load 'paredit 57 ;;; '(progn 58 ;;; (define-key paredit-mode-map (kbd "ESC M-A-C-s-)") 59 ;;; 'paredit-dwim))) 60 ;;; 61 ;;; Send questions, bug reports, comments, feature suggestions, &c., 62 ;;; via email to the author's surname at mumble.net. 63 ;;; 64 ;;; Paredit should run in GNU Emacs 21 or later and XEmacs 21.5.28 or 65 ;;; later. 66 67 ;;; The paredit minor mode, Paredit Mode, binds common character keys, 68 ;;; such as `(', `)', `"', and `\', to commands that carefully insert 69 ;;; S-expression structures in the buffer: 70 ;;; 71 ;;; ( inserts `()', leaving the point in the middle; 72 ;;; ) moves the point over the next closing delimiter; 73 ;;; " inserts `""' if outside a string, or inserts an escaped 74 ;;; double-quote if in the middle of a string, or moves over the 75 ;;; closing double-quote if at the end of a string; and 76 ;;; \ prompts for the character to escape, to avoid inserting lone 77 ;;; backslashes that may break structure. 78 ;;; 79 ;;; In comments, these keys insert themselves. If necessary, you can 80 ;;; insert these characters literally outside comments by pressing 81 ;;; `C-q' before these keys, in case a mistake has broken the 82 ;;; structure. 83 ;;; 84 ;;; These key bindings are designed so that when typing new code in 85 ;;; Paredit Mode, you can generally type exactly the same sequence of 86 ;;; keys you would have typed without Paredit Mode. 87 ;;; 88 ;;; Paredit Mode also binds common editing keys, such as `DEL', `C-d', 89 ;;; and `C-k', to commands that respect S-expression structures in the 90 ;;; buffer: 91 ;;; 92 ;;; DEL deletes the previous character, unless it is a delimiter: DEL 93 ;;; will move the point backward over a closing delimiter, and 94 ;;; will delete a delimiter pair together if between an open and 95 ;;; closing delimiter; 96 ;;; 97 ;;; C-d deletes the next character in much the same manner; and 98 ;;; 99 ;;; C-k kills all S-expressions that begin anywhere between the point 100 ;;; and the end of the line or the closing delimiter of the 101 ;;; enclosing list, whichever is first. 102 ;;; 103 ;;; If necessary, you can delete a character, kill a line, &c., 104 ;;; irrespective of S-expression structure, by pressing `C-u' before 105 ;;; these keys, in case a mistake has broken the structure. 106 ;;; 107 ;;; Finally, Paredit Mode binds some keys to complex S-expression 108 ;;; editing operations. For example, `C-<right>' makes the enclosing 109 ;;; list slurp up an S-expression to its right (here `|' denotes the 110 ;;; point): 111 ;;; 112 ;;; (foo (bar | baz) quux) C-<right> (foo (bar | baz quux)) 113 ;;; 114 ;;; Some paredit commands automatically reindent code. When they do, 115 ;;; they try to indent as locally as possible, to avoid interfering 116 ;;; with any indentation you might have manually written. Only the 117 ;;; advanced S-expression manipulation commands automatically reindent, 118 ;;; and only the forms that they immediately operated upon (and their 119 ;;; subforms). 120 ;;; 121 ;;; This code is written for clarity, not efficiency. It frequently 122 ;;; walks over S-expressions redundantly. If you have problems with 123 ;;; the time it takes to execute some of the commands, let me know. 124 125 ;;; This assumes Unix-style LF line endings. 126 127 (defconst paredit-version 25) 128 (defconst paredit-beta-p t) 129 130 (eval-and-compile 131 132 (defun paredit-xemacs-p () 133 ;; No idea where I got this definition from. Edward O'Connor 134 ;; (hober in #emacs) suggested the current definition. 135 ;; (and (boundp 'running-xemacs) 136 ;; running-xemacs) 137 (featurep 'xemacs)) 138 139 (defun paredit-gnu-emacs-p () 140 ;++ This could probably be improved. 141 (not (paredit-xemacs-p))) 142 143 (defmacro xcond (&rest clauses) 144 "Exhaustive COND. 145 Signal an error if no clause matches." 146 `(cond ,@clauses 147 (t (error "XCOND lost.")))) 148 149 (defalias 'paredit-warn (if (fboundp 'warn) 'warn 'message)) 150 151 (defvar paredit-sexp-error-type 152 (with-temp-buffer 153 (insert "(") 154 (condition-case condition 155 (backward-sexp) 156 (error (if (eq (car condition) 'error) 157 (paredit-warn "%s%s%s%s%s" 158 "Paredit is unable to discriminate" 159 " S-expression parse errors from" 160 " other errors. " 161 " This may cause obscure problems. " 162 " Please upgrade Emacs.")) 163 (car condition))))) 164 165 (defmacro paredit-handle-sexp-errors (body &rest handler) 166 `(condition-case () 167 ,body 168 (,paredit-sexp-error-type ,@handler))) 169 170 (put 'paredit-handle-sexp-errors 'lisp-indent-function 1) 171 172 (defmacro paredit-ignore-sexp-errors (&rest body) 173 `(paredit-handle-sexp-errors (progn ,@body) 174 nil)) 175 176 (put 'paredit-ignore-sexp-errors 'lisp-indent-function 0) 177 178 (defmacro paredit-preserving-column (&rest body) 179 "Evaluate BODY and restore point to former column, relative to code. 180 Assumes BODY will change only indentation. 181 If point was on code, it moves with the code. 182 If point was on indentation, it stays in indentation." 183 (let ((column (make-symbol "column")) 184 (indentation (make-symbol "indentation"))) 185 `(let ((,column (current-column)) 186 (,indentation (paredit-current-indentation))) 187 (let ((value (progn ,@body))) 188 (paredit-restore-column ,column ,indentation) 189 value)))) 190 191 (put 'paredit-preserving-column 'lisp-indent-function 0) 192 193 nil) 194 195 ;;;; Minor Mode Definition 196 197 (defvar paredit-lighter " Paredit" 198 "Mode line lighter Paredit Mode.") 199 200 (defvar paredit-mode-map (make-sparse-keymap) 201 "Keymap for the paredit minor mode.") 202 203 (defvar paredit-override-check-parens-function 204 (lambda (condition) (declare ignore condition) nil) 205 "Function to tell whether unbalanced text should inhibit Paredit Mode.") 206 207 ;;;###autoload 208 (define-minor-mode paredit-mode 209 "Minor mode for pseudo-structurally editing Lisp code. 210 With a prefix argument, enable Paredit Mode even if there are 211 unbalanced parentheses in the buffer. 212 Paredit behaves badly if parentheses are unbalanced, so exercise 213 caution when forcing Paredit Mode to be enabled, and consider 214 fixing unbalanced parentheses instead. 215 \\<paredit-mode-map>" 216 :lighter paredit-lighter 217 ;; Setting `paredit-mode' to false here aborts enabling Paredit Mode. 218 (if (and paredit-mode 219 (not current-prefix-arg)) 220 (condition-case condition 221 (check-parens) 222 (error 223 (if (not (funcall paredit-override-check-parens-function condition)) 224 (progn (setq paredit-mode nil) 225 (signal (car condition) (cdr condition)))))))) 226 227 (defun paredit-override-check-parens-interactively (condition) 228 (y-or-n-p (format "Enable Paredit Mode despite condition %S? " condition))) 229 230 ;;;###autoload 231 (defun enable-paredit-mode () 232 "Turn on pseudo-structural editing of Lisp code." 233 (interactive) 234 (paredit-mode +1)) 235 236 (defun disable-paredit-mode () 237 "Turn off pseudo-structural editing of Lisp code." 238 (interactive) 239 (paredit-mode -1)) 240 241 (defvar paredit-backward-delete-key 242 (xcond ((paredit-xemacs-p) "BS") 243 ((paredit-gnu-emacs-p) "DEL"))) 244 245 (defvar paredit-forward-delete-keys 246 (xcond ((paredit-xemacs-p) '("DEL")) 247 ((paredit-gnu-emacs-p) '("<delete>" "<deletechar>")))) 248 249 ;;;; Paredit Keys 250 251 ;;; Separating the definition and initialization of this variable 252 ;;; simplifies the development of paredit, since re-evaluating DEFVAR 253 ;;; forms doesn't actually do anything. 254 255 (defvar paredit-commands nil 256 "List of paredit commands with their keys and examples.") 257 258 ;;; Each specifier is of the form: 259 ;;; (key[s] function (example-input example-output) ...) 260 ;;; where key[s] is either a single string suitable for passing to KBD 261 ;;; or a list of such strings. Entries in this list may also just be 262 ;;; strings, in which case they are headings for the next entries. 263 264 (progn (setq paredit-commands 265 `( 266 "Basic Insertion Commands" 267 ("(" paredit-open-round 268 ("(a b |c d)" 269 "(a b (|) c d)") 270 ("(foo \"bar |baz\" quux)" 271 "(foo \"bar (|baz\" quux)")) 272 (")" paredit-close-round 273 ("(a b |c )" "(a b c)|") 274 ("; Hello,| world!" 275 "; Hello,)| world!")) 276 ("M-)" paredit-close-round-and-newline 277 ("(defun f (x| ))" 278 "(defun f (x)\n |)") 279 ("; (Foo.|" 280 "; (Foo.)|")) 281 ("[" paredit-open-square 282 ("(a b |c d)" 283 "(a b [|] c d)") 284 ("(foo \"bar |baz\" quux)" 285 "(foo \"bar [|baz\" quux)")) 286 ("]" paredit-close-square 287 ("(define-key keymap [frob| ] 'frobnicate)" 288 "(define-key keymap [frob]| 'frobnicate)") 289 ("; [Bar.|" 290 "; [Bar.]|")) 291 292 ("\"" paredit-doublequote 293 ("(frob grovel |full lexical)" 294 "(frob grovel \"|\" full lexical)" 295 "(frob grovel \"\"| full lexical)") 296 ("(foo \"bar |baz\" quux)" 297 "(foo \"bar \\\"|baz\" quux)") 298 ("(frob grovel) ; full |lexical" 299 "(frob grovel) ; full \"|lexical")) 300 ("M-\"" paredit-meta-doublequote 301 ("(foo \"bar |baz\" quux)" 302 "(foo \"bar baz\"| quux)") 303 ("(foo |(bar #\\x \"baz \\\\ quux\") zot)" 304 ,(concat "(foo \"|(bar #\\\\x \\\"baz \\\\" 305 "\\\\ quux\\\")\" zot)"))) 306 ("\\" paredit-backslash 307 ("(string #|)\n ; Character to escape: x" 308 "(string #\\x|)") 309 ("\"foo|bar\"\n ; Character to escape: \"" 310 "\"foo\\\"|bar\"")) 311 (";" paredit-semicolon 312 ("|(frob grovel)" 313 ";|(frob grovel)") 314 ("(frob |grovel)" 315 "(frob ;|grovel\n )") 316 ("(frob |grovel (bloit\n zargh))" 317 "(frob ;|grovel\n (bloit\n zargh))") 318 ("(frob grovel) |" 319 "(frob grovel) ;|")) 320 ("M-;" paredit-comment-dwim 321 ("(foo |bar) ; baz" 322 "(foo bar) ; |baz") 323 ("(frob grovel)|" 324 "(frob grovel) ;|") 325 ("(zot (foo bar)\n|\n (baz quux))" 326 "(zot (foo bar)\n ;; |\n (baz quux))") 327 ("(zot (foo bar) |(baz quux))" 328 "(zot (foo bar)\n ;; |\n (baz quux))") 329 ("|(defun hello-world ...)" 330 ";;; |\n(defun hello-world ...)")) 331 332 ("C-j" paredit-newline 333 ("(let ((n (frobbotz))) |(display (+ n 1)\nport))" 334 ,(concat "(let ((n (frobbotz)))" 335 "\n |(display (+ n 1)" 336 "\n port))"))) 337 338 "Deleting & Killing" 339 (("C-d" ,@paredit-forward-delete-keys) 340 paredit-forward-delete 341 ("(quu|x \"zot\")" "(quu| \"zot\")") 342 ("(quux |\"zot\")" 343 "(quux \"|zot\")" 344 "(quux \"|ot\")") 345 ("(foo (|) bar)" "(foo | bar)") 346 ("|(foo bar)" "(|foo bar)")) 347 (,paredit-backward-delete-key 348 paredit-backward-delete 349 ("(\"zot\" q|uux)" "(\"zot\" |uux)") 350 ("(\"zot\"| quux)" 351 "(\"zot|\" quux)" 352 "(\"zo|\" quux)") 353 ("(foo (|) bar)" "(foo | bar)") 354 ("(foo bar)|" "(foo bar|)")) 355 ("C-k" paredit-kill 356 ("(foo bar)| ; Useless comment!" 357 "(foo bar)|") 358 ("(|foo bar) ; Useful comment!" 359 "(|) ; Useful comment!") 360 ("|(foo bar) ; Useless line!" 361 "|") 362 ("(foo \"|bar baz\"\n quux)" 363 "(foo \"|\"\n quux)")) 364 ("M-d" paredit-forward-kill-word 365 ("|(foo bar) ; baz" 366 "(| bar) ; baz" 367 "(|) ; baz" 368 "() ;|") 369 (";;;| Frobnicate\n(defun frobnicate ...)" 370 ";;;|\n(defun frobnicate ...)" 371 ";;;\n(| frobnicate ...)")) 372 (,(concat "M-" paredit-backward-delete-key) 373 paredit-backward-kill-word 374 ("(foo bar) ; baz\n(quux)|" 375 "(foo bar) ; baz\n(|)" 376 "(foo bar) ; |\n()" 377 "(foo |) ; \n()" 378 "(|) ; \n()")) 379 380 "Movement & Navigation" 381 ("C-M-f" paredit-forward 382 ("(foo |(bar baz) quux)" 383 "(foo (bar baz)| quux)") 384 ("(foo (bar)|)" 385 "(foo (bar))|")) 386 ("C-M-b" paredit-backward 387 ("(foo (bar baz)| quux)" 388 "(foo |(bar baz) quux)") 389 ("(|(foo) bar)" 390 "|((foo) bar)")) 391 ("C-M-u" paredit-backward-up) 392 ("C-M-d" paredit-forward-down) 393 ("C-M-p" paredit-backward-down) ; Built-in, these are FORWARD- 394 ("C-M-n" paredit-forward-up) ; & BACKWARD-LIST, which have 395 ; no need given C-M-f & C-M-b. 396 397 "Depth-Changing Commands" 398 ("M-(" paredit-wrap-round 399 ("(foo |bar baz)" 400 "(foo (|bar) baz)")) 401 ("M-s" paredit-splice-sexp 402 ("(foo (bar| baz) quux)" 403 "(foo bar| baz quux)")) 404 (("M-<up>" "ESC <up>") 405 paredit-splice-sexp-killing-backward 406 ("(foo (let ((x 5)) |(sqrt n)) bar)" 407 "(foo |(sqrt n) bar)")) 408 (("M-<down>" "ESC <down>") 409 paredit-splice-sexp-killing-forward 410 ("(a (b c| d e) f)" 411 "(a b c| f)")) 412 ("M-r" paredit-raise-sexp 413 ("(dynamic-wind in (lambda () |body) out)" 414 "(dynamic-wind in |body out)" 415 "|body")) 416 ("M-?" paredit-convolute-sexp 417 ("(let ((x 5) (y 3)) (frob |(zwonk)) (wibblethwop))" 418 "(frob |(let ((x 5) (y 3)) (zwonk) (wibblethwop)))")) 419 420 "Barfage & Slurpage" 421 (("C-)" "C-<right>") 422 paredit-forward-slurp-sexp 423 ("(foo (bar |baz) quux zot)" 424 "(foo (bar |baz quux) zot)") 425 ("(a b ((c| d)) e f)" 426 "(a b ((c| d) e) f)")) 427 (("C-}" "C-<left>") 428 paredit-forward-barf-sexp 429 ("(foo (bar |baz quux) zot)" 430 "(foo (bar |baz) quux zot)")) 431 (("C-(" "C-M-<left>" "ESC C-<left>") 432 paredit-backward-slurp-sexp 433 ("(foo bar (baz| quux) zot)" 434 "(foo (bar baz| quux) zot)") 435 ("(a b ((c| d)) e f)" 436 "(a (b (c| d)) e f)")) 437 (("C-{" "C-M-<right>" "ESC C-<right>") 438 paredit-backward-barf-sexp 439 ("(foo (bar baz |quux) zot)" 440 "(foo bar (baz |quux) zot)")) 441 442 "Miscellaneous Commands" 443 ("M-S" paredit-split-sexp 444 ("(hello| world)" 445 "(hello)| (world)") 446 ("\"Hello, |world!\"" 447 "\"Hello, \"| \"world!\"")) 448 ("M-J" paredit-join-sexps 449 ("(hello)| (world)" 450 "(hello| world)") 451 ("\"Hello, \"| \"world!\"" 452 "\"Hello, |world!\"") 453 ("hello-\n| world" 454 "hello-|world")) 455 ("C-c C-M-l" paredit-recenter-on-sexp) 456 ("M-q" paredit-reindent-defun) 457 )) 458 nil) ; end of PROGN 459 460 ;;;;; Command Examples 461 462 (eval-and-compile 463 (defmacro paredit-do-commands (vars string-case &rest body) 464 (let ((spec (nth 0 vars)) 465 (keys (nth 1 vars)) 466 (fn (nth 2 vars)) 467 (examples (nth 3 vars))) 468 `(dolist (,spec paredit-commands) 469 (if (stringp ,spec) 470 ,string-case 471 (let ((,keys (let ((k (car ,spec))) 472 (cond ((stringp k) (list k)) 473 ((listp k) k) 474 (t (error "Invalid paredit command %s." 475 ,spec))))) 476 (,fn (cadr ,spec)) 477 (,examples (cddr ,spec))) 478 ,@body))))) 479 480 (put 'paredit-do-commands 'lisp-indent-function 2)) 481 482 (defun paredit-define-keys () 483 (paredit-do-commands (spec keys fn examples) 484 nil ; string case 485 (dolist (key keys) 486 (define-key paredit-mode-map (read-kbd-macro key) fn)))) 487 488 (defun paredit-function-documentation (fn) 489 (let ((original-doc (get fn 'paredit-original-documentation)) 490 (doc (documentation fn 'function-documentation))) 491 (or original-doc 492 (progn (put fn 'paredit-original-documentation doc) 493 doc)))) 494 495 (defun paredit-annotate-mode-with-examples () 496 (let ((contents 497 (list (paredit-function-documentation 'paredit-mode)))) 498 (paredit-do-commands (spec keys fn examples) 499 (push (concat "\n\n" spec "\n") 500 contents) 501 (let ((name (symbol-name fn))) 502 (if (string-match (symbol-name 'paredit-) name) 503 (push (concat "\n\n\\[" name "]\t" name 504 (if examples 505 (mapconcat (lambda (example) 506 (concat 507 "\n" 508 (mapconcat 'identity 509 example 510 "\n --->\n") 511 "\n")) 512 examples 513 "") 514 "\n (no examples)\n")) 515 contents)))) 516 (put 'paredit-mode 'function-documentation 517 (apply 'concat (reverse contents)))) 518 ;; PUT returns the huge string we just constructed, which we don't 519 ;; want it to return. 520 nil) 521 522 (defun paredit-annotate-functions-with-examples () 523 (paredit-do-commands (spec keys fn examples) 524 nil ; string case 525 (put fn 'function-documentation 526 (concat (paredit-function-documentation fn) 527 "\n\n\\<paredit-mode-map>\\[" (symbol-name fn) "]\n" 528 (mapconcat (lambda (example) 529 (concat "\n" 530 (mapconcat 'identity 531 example 532 "\n ->\n") 533 "\n")) 534 examples 535 ""))))) 536 537 ;;;;; HTML Examples 538 539 (defun paredit-insert-html-examples () 540 "Insert HTML for a paredit quick reference table." 541 (interactive) 542 (let ((insert-lines 543 (lambda (&rest lines) (dolist (line lines) (insert line) (newline)))) 544 (initp nil)) 545 (paredit-do-commands (spec keys fn examples) 546 (progn (if initp 547 (funcall insert-lines "</table>") 548 (setq initp t)) 549 (funcall insert-lines (concat "<h3>" spec "</h3>")) 550 (funcall insert-lines "<table>")) 551 (let ((name (symbol-name fn)) 552 (keys 553 (mapconcat (lambda (key) 554 (concat "<tt>" (paredit-html-quote key) "</tt>")) 555 keys 556 ", "))) 557 (funcall insert-lines "<tr>") 558 (funcall insert-lines (concat " <th align=\"left\">" keys "</th>")) 559 (funcall insert-lines (concat " <th align=\"left\">" name "</th>")) 560 (funcall insert-lines "</tr>") 561 (funcall insert-lines 562 "<tr><td colspan=\"2\"><table cellpadding=\"5\"><tr>") 563 (dolist (example examples) 564 (let ((prefix "<td><table border=\"1\"><tr><td><table><tr><td><pre>") 565 (examples 566 (mapconcat 'paredit-html-quote 567 example 568 (concat "</pre></td></tr>" 569 "<tr><th>↓</th></tr>" 570 "<tr><td><pre>"))) 571 (suffix "</pre></td></tr></table></td></tr></table></td>")) 572 (funcall insert-lines (concat prefix examples suffix)))) 573 (funcall insert-lines "</tr></table></td></tr>"))) 574 (funcall insert-lines "</table>"))) 575 576 (defun paredit-html-quote (string) 577 (with-temp-buffer 578 (dotimes (i (length string)) 579 (insert (let ((c (elt string i))) 580 (cond ((eq c ?\<) "<") 581 ((eq c ?\>) ">") 582 ((eq c ?\&) "&") 583 ((eq c ?\') "'") 584 ((eq c ?\") """) 585 (t c))))) 586 (buffer-string))) 587 588 ;;;; Delimiter Insertion 589 590 (eval-and-compile 591 (defun paredit-conc-name (&rest strings) 592 (intern (apply 'concat strings))) 593 594 (defmacro define-paredit-pair (open close name) 595 `(progn 596 (defun ,(paredit-conc-name "paredit-open-" name) (&optional n) 597 ,(concat "Insert a balanced " name " pair. 598 With a prefix argument N, put the closing " name " after N 599 S-expressions forward. 600 If the region is active, `transient-mark-mode' is enabled, and the 601 region's start and end fall in the same parenthesis depth, insert a 602 " name " pair around the region. 603 If in a string or a comment, insert a single " name ". 604 If in a character literal, do nothing. This prevents changing what was 605 in the character literal to a meaningful delimiter unintentionally.") 606 (interactive "P") 607 (cond ((or (paredit-in-string-p) 608 (paredit-in-comment-p)) 609 (insert ,open)) 610 ((not (paredit-in-char-p)) 611 (paredit-insert-pair n ,open ,close 'goto-char) 612 (save-excursion (backward-up-list) (indent-sexp))))) 613 (defun ,(paredit-conc-name "paredit-close-" name) () 614 ,(concat "Move past one closing delimiter and reindent. 615 \(Agnostic to the specific closing delimiter.) 616 If in a string or comment, insert a single closing " name ". 617 If in a character literal, do nothing. This prevents changing what was 618 in the character literal to a meaningful delimiter unintentionally.") 619 (interactive) 620 (paredit-move-past-close ,close)) 621 (defun ,(paredit-conc-name "paredit-close-" name "-and-newline") () 622 ,(concat "Move past one closing delimiter, add a newline," 623 " and reindent. 624 If there was a margin comment after the closing delimiter, preserve it 625 on the same line.") 626 (interactive) 627 (paredit-move-past-close-and-newline ,close)) 628 (defun ,(paredit-conc-name "paredit-wrap-" name) 629 (&optional argument) 630 ,(concat "Wrap the following S-expression. 631 See `paredit-wrap-sexp' for more details.") 632 (interactive "P") 633 (paredit-wrap-sexp argument ,open ,close)) 634 (add-to-list 'paredit-wrap-commands 635 ',(paredit-conc-name "paredit-wrap-" name))))) 636 637 (defvar paredit-wrap-commands '(paredit-wrap-sexp) 638 "List of paredit commands that wrap S-expressions. 639 Used by `paredit-yank-pop'; for internal paredit use only.") 640 641 (define-paredit-pair ?\( ?\) "round") 642 (define-paredit-pair ?\[ ?\] "square") 643 (define-paredit-pair ?\{ ?\} "curly") 644 (define-paredit-pair ?\< ?\> "angled") 645 646 ;;; Aliases for the old names. 647 648 (defalias 'paredit-open-parenthesis 'paredit-open-round) 649 (defalias 'paredit-close-parenthesis 'paredit-close-round) 650 (defalias 'paredit-close-parenthesis-and-newline 651 'paredit-close-round-and-newline) 652 653 (defalias 'paredit-open-bracket 'paredit-open-square) 654 (defalias 'paredit-close-bracket 'paredit-close-square) 655 (defalias 'paredit-close-bracket-and-newline 656 'paredit-close-square-and-newline) 657 658 (defun paredit-move-past-close (close) 659 (paredit-move-past-close-and close 660 (lambda () 661 (paredit-blink-paren-match nil)))) 662 663 (defun paredit-move-past-close-and-newline (close) 664 (paredit-move-past-close-and close 665 (lambda () 666 (let ((comment.point (paredit-find-comment-on-line))) 667 (newline) 668 (if comment.point 669 (save-excursion 670 (forward-line -1) 671 (end-of-line) 672 (indent-to (cdr comment.point)) 673 (insert (car comment.point))))) 674 (lisp-indent-line) 675 (paredit-ignore-sexp-errors (indent-sexp)) 676 (paredit-blink-paren-match t)))) 677 678 (defun paredit-move-past-close-and (close if-moved) 679 (if (or (paredit-in-string-p) 680 (paredit-in-comment-p)) 681 (insert close) 682 (if (paredit-in-char-p) (forward-char)) 683 (paredit-move-past-close-and-reindent close) 684 (funcall if-moved))) 685 686 (defun paredit-find-comment-on-line () 687 "Find a margin comment on the current line. 688 Return nil if there is no such comment or if there is anything but 689 whitespace until such a comment. 690 If such a comment exists, delete the comment (including all leading 691 whitespace) and return a cons whose car is the comment as a string 692 and whose cdr is the point of the comment's initial semicolon, 693 relative to the start of the line." 694 (save-excursion 695 (paredit-skip-whitespace t (point-at-eol)) 696 (and (eq ?\; (char-after)) 697 (not (eq ?\; (char-after (1+ (point))))) 698 (not (or (paredit-in-string-p) 699 (paredit-in-char-p))) 700 (let* ((start ;Move to before the semicolon. 701 (progn (backward-char) (point))) 702 (comment 703 (buffer-substring start (point-at-eol)))) 704 (paredit-skip-whitespace nil (point-at-bol)) 705 (delete-region (point) (point-at-eol)) 706 (cons comment (- start (point-at-bol))))))) 707 708 (defun paredit-insert-pair (n open close forward) 709 (let* ((regionp 710 (and (paredit-region-active-p) 711 (paredit-region-safe-for-insert-p))) 712 (end 713 (and regionp 714 (not n) 715 (prog1 (region-end) (goto-char (region-beginning)))))) 716 (let ((spacep (paredit-space-for-delimiter-p nil open))) 717 (if spacep (insert " ")) 718 (insert open) 719 (save-excursion 720 ;; Move past the desired region. 721 (cond (n 722 (funcall forward 723 (paredit-scan-sexps-hack (point) 724 (prefix-numeric-value n)))) 725 (regionp 726 (funcall forward (+ end (if spacep 2 1))))) 727 ;; The string case can happen if we are inserting string 728 ;; delimiters. The comment case may happen by moving to the 729 ;; end of a buffer that has a comment with no trailing newline. 730 (if (and (not (paredit-in-string-p)) 731 (paredit-in-comment-p)) 732 (newline)) 733 (insert close) 734 (if (paredit-space-for-delimiter-p t close) 735 (insert " ")))))) 736 737 ;++ This needs a better name... 738 739 (defun paredit-scan-sexps-hack (point n) 740 (save-excursion 741 (goto-char point) 742 (let ((direction (if (< 0 n) +1 -1)) 743 (magnitude (abs n)) 744 (count 0)) 745 (catch 'exit 746 (while (< count magnitude) 747 (let ((p 748 (paredit-handle-sexp-errors (scan-sexps (point) direction) 749 nil))) 750 (if (not p) (throw 'exit nil)) 751 (goto-char p)) 752 (setq count (+ count 1))))) 753 (point))) 754 755 (defun paredit-region-safe-for-insert-p () 756 (save-excursion 757 (let ((beginning (region-beginning)) 758 (end (region-end))) 759 (goto-char beginning) 760 (let* ((beginning-state (paredit-current-parse-state)) 761 (end-state 762 (parse-partial-sexp beginning end nil nil beginning-state))) 763 (and (= (nth 0 beginning-state) ; 0. depth in parens 764 (nth 0 end-state)) 765 (eq (nth 3 beginning-state) ; 3. non-nil if inside a 766 (nth 3 end-state)) ; string 767 (eq (nth 4 beginning-state) ; 4. comment status, yada 768 (nth 4 end-state)) 769 (eq (nth 5 beginning-state) ; 5. t if following char 770 (nth 5 end-state))))))) ; quote 771 772 (defvar paredit-space-for-delimiter-predicates nil 773 "List of predicates for whether to put space by delimiter at point. 774 Each predicate is a function that is is applied to two arguments, ENDP 775 and DELIMITER, and that returns a boolean saying whether to put a 776 space next to the delimiter -- before/after the delimiter if ENDP is 777 false/true, respectively. 778 If any predicate returns false, no space is inserted: every predicate 779 has veto power. 780 Each predicate may assume that the point is not at the beginning/end of 781 the buffer, and that the point is preceded/followed by a word 782 constituent, symbol constituent, string quote, or delimiter matching 783 DELIMITER, if ENDP is false/true, respectively. 784 Each predicate should examine only text before/after the point if ENDP is 785 false/true, respectively.") 786 787 (defun paredit-space-for-delimiter-p (endp delimiter) 788 ;; If at the buffer limit, don't insert a space. If there is a word, 789 ;; symbol, other quote, or non-matching parenthesis delimiter (i.e. a 790 ;; close when want an open the string or an open when we want to 791 ;; close the string), do insert a space. 792 (and (not (if endp (eobp) (bobp))) 793 (memq (char-syntax (if endp (char-after) (char-before))) 794 (list ?w ?_ ?\" 795 (let ((matching (matching-paren delimiter))) 796 (and matching (char-syntax matching))) 797 (and (not endp) 798 (eq ?\" (char-syntax delimiter)) 799 ?\) ))) 800 (catch 'exit 801 (dolist (predicate paredit-space-for-delimiter-predicates) 802 (if (not (funcall predicate endp delimiter)) 803 (throw 'exit nil))) 804 t))) 805 806 (defun paredit-move-past-close-and-reindent (close) 807 (let ((open (paredit-missing-close))) 808 (if open 809 (if (eq close (matching-paren open)) 810 (save-excursion 811 (message "Missing closing delimiter: %c" close) 812 (insert close)) 813 (error "Mismatched missing closing delimiter: %c ... %c" 814 open close)))) 815 (up-list) 816 (if (catch 'return ; This CATCH returns T if it 817 (while t ; should delete leading spaces 818 (save-excursion ; and NIL if not. 819 (let ((before-paren (1- (point)))) 820 (back-to-indentation) 821 (cond ((not (eq (point) before-paren)) 822 ;; Can't call PAREDIT-DELETE-LEADING-WHITESPACE 823 ;; here -- we must return from SAVE-EXCURSION 824 ;; first. 825 (throw 'return t)) 826 ((save-excursion (forward-line -1) 827 (end-of-line) 828 (paredit-in-comment-p)) 829 ;; Moving the closing delimiter any further 830 ;; would put it into a comment, so we just 831 ;; indent the closing delimiter where it is and 832 ;; abort the loop, telling its continuation that 833 ;; no leading whitespace should be deleted. 834 (lisp-indent-line) 835 (throw 'return nil)) 836 (t (delete-indentation))))))) 837 (paredit-delete-leading-whitespace))) 838 839 (defun paredit-missing-close () 840 (save-excursion 841 (paredit-handle-sexp-errors (backward-up-list) 842 (error "Not inside a list.")) 843 (let ((open (char-after))) 844 (paredit-handle-sexp-errors (progn (forward-sexp) nil) 845 open)))) 846 847 (defun paredit-delete-leading-whitespace () 848 ;; This assumes that we're on the closing delimiter already. 849 (save-excursion 850 (backward-char) 851 (while (let ((syn (char-syntax (char-before)))) 852 (and (or (eq syn ?\ ) (eq syn ?-)) ; whitespace syntax 853 ;; The above line is a perfect example of why the 854 ;; following test is necessary. 855 (not (paredit-in-char-p (1- (point)))))) 856 (delete-char -1)))) 857 858 (defun paredit-blink-paren-match (another-line-p) 859 (if (and blink-matching-paren 860 (or (not show-paren-mode) another-line-p)) 861 (paredit-ignore-sexp-errors 862 (save-excursion 863 (backward-sexp) 864 (forward-sexp) 865 ;; SHOW-PAREN-MODE inhibits any blinking, so we disable it 866 ;; locally here. 867 (let ((show-paren-mode nil)) 868 (blink-matching-open)))))) 869 870 (defun paredit-doublequote (&optional n) 871 "Insert a pair of double-quotes. 872 With a prefix argument N, wrap the following N S-expressions in 873 double-quotes, escaping intermediate characters if necessary. 874 If the region is active, `transient-mark-mode' is enabled, and the 875 region's start and end fall in the same parenthesis depth, insert a 876 pair of double-quotes around the region, again escaping intermediate 877 characters if necessary. 878 Inside a comment, insert a literal double-quote. 879 At the end of a string, move past the closing double-quote. 880 In the middle of a string, insert a backslash-escaped double-quote. 881 If in a character literal, do nothing. This prevents accidentally 882 changing a what was in the character literal to become a meaningful 883 delimiter unintentionally." 884 (interactive "P") 885 (cond ((paredit-in-string-p) 886 (if (eq (point) (- (paredit-enclosing-string-end) 1)) 887 (forward-char) ; Just move past the closing quote. 888 ;; Don't split a \x into an escaped backslash and a string end. 889 (if (paredit-in-string-escape-p) (forward-char)) 890 (insert ?\\ ?\" ))) 891 ((paredit-in-comment-p) 892 (insert ?\" )) 893 ((not (paredit-in-char-p)) 894 (paredit-insert-pair n ?\" ?\" 'paredit-forward-for-quote)))) 895 896 (defun paredit-meta-doublequote (&optional n) 897 "Move to the end of the string. 898 If not in a string, act as `paredit-doublequote'; if not prefix argument 899 is specified and the region is not active or `transient-mark-mode' is 900 disabled, the default is to wrap one S-expression, however, not zero." 901 (interactive "P") 902 (if (not (paredit-in-string-p)) 903 (paredit-doublequote (or n (and (not (paredit-region-active-p)) 1))) 904 (goto-char (paredit-enclosing-string-end)))) 905 906 (defun paredit-meta-doublequote-and-newline (&optional n) 907 "Move to the end of the string, insert a newline, and indent. 908 If not in a string, act as `paredit-doublequote'; if not prefix argument 909 is specified and the region is not active or `transient-mark-mode' is 910 disabled, the default is to wrap one S-expression, however, not zero." 911 (interactive "P") 912 (if (not (paredit-in-string-p)) 913 (paredit-doublequote (or n (and (not (paredit-region-active-p)) 1))) 914 (progn (goto-char (paredit-enclosing-string-end)) 915 (newline) 916 (lisp-indent-line) 917 (paredit-ignore-sexp-errors (indent-sexp))))) 918 919 (defun paredit-forward-for-quote (end) 920 (let ((state (paredit-current-parse-state))) 921 (while (< (point) end) 922 (let ((new-state (parse-partial-sexp (point) (1+ (point)) 923 nil nil state))) 924 (if (paredit-in-string-p new-state) 925 (if (not (paredit-in-string-escape-p)) 926 (setq state new-state) 927 ;; Escape character: turn it into an escaped escape 928 ;; character by appending another backslash. 929 (insert ?\\ ) 930 ;; Now the point is after both escapes, and we want to 931 ;; rescan from before the first one to after the second 932 ;; one. 933 (setq state 934 (parse-partial-sexp (- (point) 2) (point) 935 nil nil state)) 936 ;; Advance the end point, since we just inserted a new 937 ;; character. 938 (setq end (1+ end))) 939 ;; String: escape by inserting a backslash before the quote. 940 (backward-char) 941 (insert ?\\ ) 942 ;; The point is now between the escape and the quote, and we 943 ;; want to rescan from before the escape to after the quote. 944 (setq state 945 (parse-partial-sexp (1- (point)) (1+ (point)) 946 nil nil state)) 947 ;; Advance the end point for the same reason as above. 948 (setq end (1+ end))))))) 949 950 ;;;; Escape Insertion 951 952 (defun paredit-backslash () 953 "Insert a backslash followed by a character to escape." 954 (interactive) 955 (cond ((paredit-in-string-p) (paredit-backslash-interactive)) 956 ((paredit-in-comment-p) (insert ?\\)) 957 ((paredit-in-char-p) (forward-char) (paredit-backslash-interactive)) 958 (t (paredit-backslash-interactive)))) 959 960 (defun paredit-backslash-interactive () 961 (insert ?\\ ) 962 ;; Read a character to insert after the backslash. If anything 963 ;; goes wrong -- the user hits delete (entering the rubout 964 ;; `character'), aborts with C-g, or enters non-character input 965 ;; -- then delete the backslash to avoid a dangling escape. 966 (let ((delete-p t)) 967 (unwind-protect 968 (let ((char (read-char "Character to escape: " t))) 969 (if (not (eq char ?\^?)) 970 (progn (message "Character to escape: %c" char) 971 (insert char) 972 (setq delete-p nil)))) 973 (if delete-p 974 (progn (message "Deleting escape.") 975 (delete-char -1)))))) 976 977 (defun paredit-newline () 978 "Insert a newline and indent it. 979 This is like `newline-and-indent', but it not only indents the line 980 that the point is on but also the S-expression following the point, 981 if there is one. 982 Move forward one character first if on an escaped character. 983 If in a string, just insert a literal newline. 984 If in a comment and if followed by invalid structure, call 985 `indent-new-comment-line' to keep the invalid structure in a 986 comment." 987 (interactive) 988 (cond ((paredit-in-string-p) 989 (newline)) 990 ((paredit-in-comment-p) 991 (if (paredit-region-ok-p (point) (point-at-eol)) 992 (progn (newline-and-indent) 993 (paredit-ignore-sexp-errors (indent-sexp))) 994 (indent-new-comment-line))) 995 (t 996 (if (paredit-in-char-p) 997 (forward-char)) 998 (newline-and-indent) 999 ;; Indent the following S-expression, but don't signal an 1000 ;; error if there's only a closing delimiter after the point. 1001 (paredit-ignore-sexp-errors (indent-sexp))))) 1002 1003 (defun paredit-reindent-defun (&optional argument) 1004 "Reindent the definition that the point is on. 1005 If the point is in a string or a comment, fill the paragraph instead, 1006 and with a prefix argument, justify as well." 1007 (interactive "P") 1008 (if (or (paredit-in-string-p) 1009 (paredit-in-comment-p)) 1010 (lisp-fill-paragraph argument) 1011 (paredit-preserving-column 1012 (save-excursion 1013 (end-of-defun) 1014 (beginning-of-defun) 1015 (indent-sexp))))) 1016 1017 ;;;; Comment Insertion 1018 1019 (defun paredit-semicolon (&optional n) 1020 "Insert a semicolon. 1021 With a prefix argument N, insert N semicolons. 1022 If in a string, do just that and nothing else. 1023 If in a character literal, move to the beginning of the character 1024 literal before inserting the semicolon. 1025 If the enclosing list ends on the line after the point, break the line 1026 after the last S-expression following the point. 1027 If a list begins on the line after the point but ends on a different 1028 line, break the line after the last S-expression following the point 1029 before the list." 1030 (interactive "p") 1031 (if (or (paredit-in-string-p) (paredit-in-comment-p)) 1032 (insert (make-string (or n 1) ?\; )) 1033 (if (paredit-in-char-p) 1034 (backward-char 2)) 1035 (let ((line-break-point (paredit-semicolon-find-line-break-point))) 1036 (if line-break-point 1037 (paredit-semicolon-with-line-break line-break-point (or n 1)) 1038 (insert (make-string (or n 1) ?\; )))))) 1039 1040 (defun paredit-semicolon-find-line-break-point () 1041 (and (not (eolp)) ;Implies (not (eobp)). 1042 (let ((eol (point-at-eol))) 1043 (save-excursion 1044 (catch 'exit 1045 (while t 1046 (let ((line-break-point (point))) 1047 (cond ((paredit-handle-sexp-errors (progn (forward-sexp) t) 1048 nil) 1049 ;; Successfully advanced by an S-expression. 1050 ;; If that S-expression started on this line 1051 ;; and ended on another one, break here. 1052 (cond ((not (eq eol (point-at-eol))) 1053 (throw 'exit 1054 (and (save-excursion 1055 (backward-sexp) 1056 (eq eol (point-at-eol))) 1057 line-break-point))) 1058 ((eobp) 1059 (throw 'exit nil)))) 1060 ((save-excursion 1061 (paredit-skip-whitespace t (point-at-eol)) 1062 (or (eolp) (eobp) (eq (char-after) ?\;))) 1063 ;; Can't move further, but there's no closing 1064 ;; delimiter we're about to clobber -- either 1065 ;; it's on the next line or we're at the end of 1066 ;; the buffer. Don't break the line. 1067 (throw 'exit nil)) 1068 (t 1069 ;; Can't move because we hit a delimiter at the 1070 ;; end of this line. Break here. 1071 (throw 'exit line-break-point)))))))))) 1072 1073 (defun paredit-semicolon-with-line-break (line-break-point n) 1074 (let ((line-break-marker (make-marker))) 1075 (set-marker line-break-marker line-break-point) 1076 (set-marker-insertion-type line-break-marker t) 1077 (insert (make-string (or n 1) ?\; )) 1078 (save-excursion 1079 (goto-char line-break-marker) 1080 (set-marker line-break-marker nil) 1081 (newline) 1082 (lisp-indent-line) 1083 ;; This step is redundant if we are inside a list, but even if we 1084 ;; are at the top level, we want at least to indent whatever we 1085 ;; bumped off the line. 1086 (paredit-ignore-sexp-errors (indent-sexp)) 1087 (paredit-indent-sexps)))) 1088 1089 ;;; This is all a horrible, horrible hack, primarily for GNU Emacs 21, 1090 ;;; in which there is no `comment-or-uncomment-region'. 1091 1092 (autoload 'comment-forward "newcomment") 1093 (autoload 'comment-normalize-vars "newcomment") 1094 (autoload 'comment-region "newcomment") 1095 (autoload 'comment-search-forward "newcomment") 1096 (autoload 'uncomment-region "newcomment") 1097 1098 (defun paredit-initialize-comment-dwim () 1099 (require 'newcomment) 1100 (if (not (fboundp 'comment-or-uncomment-region)) 1101 (defalias 'comment-or-uncomment-region 1102 (lambda (beginning end &optional argument) 1103 (interactive "*r\nP") 1104 (if (save-excursion (goto-char beginning) 1105 (comment-forward (point-max)) 1106 (<= end (point))) 1107 (uncomment-region beginning end argument) 1108 (comment-region beginning end argument))))) 1109 (defalias 'paredit-initialize-comment-dwim 'comment-normalize-vars) 1110 (comment-normalize-vars)) 1111 1112 (defvar paredit-comment-prefix-toplevel ";;; " 1113 "String of prefix for top-level comments aligned at the left margin.") 1114 1115 (defvar paredit-comment-prefix-code ";; " 1116 "String of prefix for comments indented at the same depth as code.") 1117 1118 (defvar paredit-comment-prefix-margin ";" 1119 "String of prefix for comments on the same line as code in the margin.") 1120 1121 (defun paredit-comment-dwim (&optional argument) 1122 "Call the Lisp comment command you want (Do What I Mean). 1123 This is like `comment-dwim', but it is specialized for Lisp editing. 1124 If transient mark mode is enabled and the mark is active, comment or 1125 uncomment the selected region, depending on whether it was entirely 1126 commented not not already. 1127 If there is already a comment on the current line, with no prefix 1128 argument, indent to that comment; with a prefix argument, kill that 1129 comment. 1130 Otherwise, insert a comment appropriate for the context and ensure that 1131 any code following the comment is moved to the next line. 1132 At the top level, where indentation is calculated to be at column 0, 1133 insert a triple-semicolon comment; within code, where the indentation 1134 is calculated to be non-zero, and on the line there is either no code 1135 at all or code after the point, insert a double-semicolon comment; 1136 and if the point is after all code on the line, insert a single- 1137 semicolon margin comment at `comment-column'." 1138 (interactive "*P") 1139 (paredit-initialize-comment-dwim) 1140 (cond ((paredit-region-active-p) 1141 (comment-or-uncomment-region (region-beginning) 1142 (region-end) 1143 argument)) 1144 ((paredit-comment-on-line-p) 1145 (if argument 1146 (comment-kill (if (integerp argument) argument nil)) 1147 (comment-indent))) 1148 (t (paredit-insert-comment)))) 1149 1150 (defun paredit-comment-on-line-p () 1151 "True if there is a comment on the line following point. 1152 This is expected to be called only in `paredit-comment-dwim'; do not 1153 call it elsewhere." 1154 (save-excursion 1155 (beginning-of-line) 1156 (let ((comment-p nil)) 1157 ;; Search forward for a comment beginning. If there is one, set 1158 ;; COMMENT-P to true; if not, it will be nil. 1159 (while (progn 1160 (setq comment-p ;t -> no error 1161 (comment-search-forward (point-at-eol) t)) 1162 (and comment-p 1163 (or (paredit-in-string-p) 1164 (paredit-in-char-p (1- (point)))))) 1165 (forward-char)) 1166 comment-p))) 1167 1168 (defun paredit-insert-comment () 1169 (let ((code-after-p 1170 (save-excursion (paredit-skip-whitespace t (point-at-eol)) 1171 (not (eolp)))) 1172 (code-before-p 1173 (save-excursion (paredit-skip-whitespace nil (point-at-bol)) 1174 (not (bolp))))) 1175 (cond ((and (bolp) 1176 (let ((indent 1177 (let ((indent (calculate-lisp-indent))) 1178 (if (consp indent) (car indent) indent)))) 1179 (and indent (zerop indent)))) 1180 ;; Top-level comment 1181 (if code-after-p (save-excursion (newline))) 1182 (insert paredit-comment-prefix-toplevel)) 1183 ((or code-after-p (not code-before-p)) 1184 ;; Code comment 1185 (if code-before-p 1186 (newline-and-indent) 1187 (lisp-indent-line)) 1188 (insert paredit-comment-prefix-code) 1189 (if code-after-p 1190 (save-excursion 1191 (newline) 1192 (lisp-indent-line) 1193 (paredit-indent-sexps)))) 1194 (t 1195 ;; Margin comment 1196 (indent-to comment-column 1) ; 1 -> force one leading space 1197 (insert paredit-comment-prefix-margin))))) 1198 1199 ;;;; Character Deletion 1200 1201 (defun paredit-forward-delete (&optional argument) 1202 "Delete a character forward or move forward over a delimiter. 1203 If on an opening S-expression delimiter, move forward into the 1204 S-expression. 1205 If on a closing S-expression delimiter, refuse to delete unless the 1206 S-expression is empty, in which case delete the whole S-expression. 1207 With a numeric prefix argument N, delete N characters forward. 1208 With a `C-u' prefix argument, simply delete a character forward, 1209 without regard for delimiter balancing." 1210 (interactive "P") 1211 (cond ((or (consp argument) (eobp)) 1212 (delete-char +1)) 1213 ((integerp argument) 1214 (if (< argument 0) 1215 (paredit-backward-delete argument) 1216 (while (> argument 0) 1217 (paredit-forward-delete) 1218 (setq argument (- argument 1))))) 1219 ((paredit-in-string-p) 1220 (paredit-forward-delete-in-string)) 1221 ((paredit-in-comment-p) 1222 (paredit-forward-delete-in-comment)) 1223 ((paredit-in-char-p) ; Escape -- delete both chars. 1224 (delete-char -1) 1225 (delete-char +1)) 1226 ((eq (char-after) ?\\ ) ; ditto 1227 (delete-char +2)) 1228 ((let ((syn (char-syntax (char-after)))) 1229 (or (eq syn ?\( ) 1230 (eq syn ?\" ))) 1231 (if (save-excursion 1232 (paredit-handle-sexp-errors (progn (forward-sexp) t) 1233 nil)) 1234 (forward-char) 1235 (message "Deleting spurious opening delimiter.") 1236 (delete-char +1))) 1237 ((and (not (paredit-in-char-p (1- (point)))) 1238 (eq (char-syntax (char-after)) ?\) ) 1239 (eq (char-before) (matching-paren (char-after)))) 1240 (delete-char -1) ; Empty list -- delete both 1241 (delete-char +1)) ; delimiters. 1242 ((eq ?\; (char-after)) 1243 (paredit-forward-delete-comment-start)) 1244 ((eq (char-syntax (char-after)) ?\) ) 1245 (if (paredit-handle-sexp-errors 1246 (save-excursion (forward-char) (backward-sexp) t) 1247 nil) 1248 (message "End of list!") 1249 (progn 1250 (message "Deleting spurious closing delimiter.") 1251 (delete-char +1)))) 1252 ;; Just delete a single character, if it's not a closing 1253 ;; delimiter. (The character literal case is already handled 1254 ;; by now.) 1255 (t (delete-char +1)))) 1256 1257 (defun paredit-forward-delete-in-string () 1258 (let ((start+end (paredit-string-start+end-points))) 1259 (cond ((not (eq (point) (cdr start+end))) 1260 ;; If it's not the close-quote, it's safe to delete. But 1261 ;; first handle the case that we're in a string escape. 1262 (cond ((paredit-in-string-escape-p) 1263 ;; We're right after the backslash, so backward 1264 ;; delete it before deleting the escaped character. 1265 (delete-char -1)) 1266 ((eq (char-after) ?\\ ) 1267 ;; If we're not in a string escape, but we are on a 1268 ;; backslash, it must start the escape for the next 1269 ;; character, so delete the backslash before deleting 1270 ;; the next character. 1271 (delete-char +1))) 1272 (delete-char +1)) 1273 ((eq (1- (point)) (car start+end)) 1274 ;; If it is the close-quote, delete only if we're also right 1275 ;; past the open-quote (i.e. it's empty), and then delete 1276 ;; both quotes. Otherwise we refuse to delete it. 1277 (delete-char -1) 1278 (delete-char +1))))) 1279 1280 (defun paredit-check-forward-delete-in-comment () 1281 ;; Point is in a comment, possibly at eol. We are about to delete 1282 ;; some characters forward; if we are at eol, we are about to delete 1283 ;; the line break. Refuse to do so if if moving the next line into 1284 ;; the comment would break structure. 1285 (if (eolp) 1286 (let ((next-line-start (point-at-bol 2)) 1287 (next-line-end (point-at-eol 2))) 1288 (paredit-check-region next-line-start next-line-end)))) 1289 1290 (defun paredit-forward-delete-in-comment () 1291 (paredit-check-forward-delete-in-comment) 1292 (delete-char +1)) 1293 1294 (defun paredit-forward-delete-comment-start () 1295 ;; Point precedes a comment start (not at eol). Refuse to delete a 1296 ;; comment start if the comment contains unbalanced junk. 1297 (paredit-check-region (+ (point) 1) (point-at-eol)) 1298 (delete-char +1)) 1299 1300 (defun paredit-backward-delete (&optional argument) 1301 "Delete a character backward or move backward over a delimiter. 1302 If on a closing S-expression delimiter, move backward into the 1303 S-expression. 1304 If on an opening S-expression delimiter, refuse to delete unless the 1305 S-expression is empty, in which case delete the whole S-expression. 1306 With a numeric prefix argument N, delete N characters backward. 1307 With a `C-u' prefix argument, simply delete a character backward, 1308 without regard for delimiter balancing." 1309 (interactive "P") 1310 (cond ((or (consp argument) (bobp)) 1311 ;++ Should this untabify? 1312 (delete-char -1)) 1313 ((integerp argument) 1314 (if (< argument 0) 1315 (paredit-forward-delete (- 0 argument)) 1316 (while (> argument 0) 1317 (paredit-backward-delete) 1318 (setq argument (- argument 1))))) 1319 ((paredit-in-string-p) 1320 (paredit-backward-delete-in-string)) 1321 ((paredit-in-comment-p) 1322 (paredit-backward-delete-in-comment)) 1323 ((paredit-in-char-p) ; Escape -- delete both chars. 1324 (delete-char -1) 1325 (delete-char +1)) 1326 ((paredit-in-char-p (1- (point))) 1327 (delete-char -2)) ; ditto 1328 ((let ((syn (char-syntax (char-before)))) 1329 (or (eq syn ?\) ) 1330 (eq syn ?\" ))) 1331 (if (save-excursion 1332 (paredit-handle-sexp-errors (progn (backward-sexp) t) 1333 nil)) 1334 (backward-char) 1335 (message "Deleting spurious closing delimiter.") 1336 (delete-char -1))) 1337 ((and (eq (char-syntax (char-before)) ?\( ) 1338 (eq (char-after) (matching-paren (char-before)))) 1339 (delete-char -1) ; Empty list -- delete both 1340 (delete-char +1)) ; delimiters. 1341 ((bolp) 1342 (paredit-backward-delete-maybe-comment-end)) 1343 ((eq (char-syntax (char-before)) ?\( ) 1344 (if (paredit-handle-sexp-errors 1345 (save-excursion (backward-char) (forward-sexp) t) 1346 nil) 1347 (message "Beginning of list!") 1348 (progn 1349 (message "Deleting spurious closing delimiter.") 1350 (delete-char -1)))) 1351 ;; Delete it, unless it's an opening delimiter. The case of 1352 ;; character literals is already handled by now. 1353 (t 1354 ;; Turn off the @#&*&!^&(%^ botch in GNU Emacs 24 that changed 1355 ;; `backward-delete-char' and `backward-delete-char-untabify' 1356 ;; semantically so that they delete the region in transient 1357 ;; mark mode. 1358 (let ((delete-active-region nil)) 1359 (backward-delete-char-untabify +1))))) 1360 1361 (defun paredit-backward-delete-in-string () 1362 (let ((start+end (paredit-string-start+end-points))) 1363 (cond ((not (eq (1- (point)) (car start+end))) 1364 ;; If it's not the open-quote, it's safe to delete. 1365 (if (paredit-in-string-escape-p) 1366 ;; If we're on a string escape, since we're about to 1367 ;; delete the backslash, we must first delete the 1368 ;; escaped char. 1369 (delete-char +1)) 1370 (delete-char -1) 1371 (if (paredit-in-string-escape-p) 1372 ;; If, after deleting a character, we find ourselves in 1373 ;; a string escape, we must have deleted the escaped 1374 ;; character, and the backslash is behind the point, so 1375 ;; backward delete it. 1376 (delete-char -1))) 1377 ((eq (point) (cdr start+end)) 1378 ;; If it is the open-quote, delete only if we're also right 1379 ;; past the close-quote (i.e. it's empty), and then delete 1380 ;; both quotes. Otherwise we refuse to delete it. 1381 (delete-char -1) 1382 (delete-char +1))))) 1383 1384 (defun paredit-backward-delete-in-comment () 1385 ;; Point is in a comment, possibly just after the comment start. 1386 ;; Refuse to delete a comment start if the comment contains 1387 ;; unbalanced junk. 1388 (if (save-excursion 1389 (backward-char) 1390 ;; Must call `paredit-in-string-p' before 1391 ;; `paredit-in-comment-p'. 1392 (not (or (paredit-in-string-p) (paredit-in-comment-p)))) 1393 (paredit-check-region (point) (point-at-eol))) 1394 (backward-delete-char-untabify +1)) 1395 1396 (defun paredit-backward-delete-maybe-comment-end () 1397 ;; Point is at bol, possibly just after a comment end (i.e., the 1398 ;; previous line may have had a line comment). Refuse to delete a 1399 ;; comment end if moving the current line into the previous line's 1400 ;; comment would break structure. 1401 (if (save-excursion 1402 (backward-char) 1403 (and (not (paredit-in-string-p)) (paredit-in-comment-p))) 1404 (paredit-check-region (point-at-eol) (point-at-bol))) 1405 (delete-char -1)) 1406 1407 ;;;; Killing 1408 1409 (defun paredit-kill (&optional argument) 1410 "Kill a line as if with `kill-line', but respecting delimiters. 1411 In a string, act exactly as `kill-line' but do not kill past the 1412 closing string delimiter. 1413 On a line with no S-expressions on it starting after the point or 1414 within a comment, act exactly as `kill-line'. 1415 Otherwise, kill all S-expressions that start after the point. 1416 With a `C-u' prefix argument, just do the standard `kill-line'. 1417 With a numeric prefix argument N, do `kill-line' that many times." 1418 (interactive "P") 1419 (cond (argument 1420 (kill-line (if (integerp argument) argument 1))) 1421 ((paredit-in-string-p) 1422 (paredit-kill-line-in-string)) 1423 ((paredit-in-comment-p) 1424 (paredit-kill-line-in-comment)) 1425 ((save-excursion (paredit-skip-whitespace t (point-at-eol)) 1426 (or (eolp) (eq (char-after) ?\; ))) 1427 ;** Be careful about trailing backslashes. 1428 (if (paredit-in-char-p) 1429 (backward-char)) 1430 (kill-line)) 1431 (t (paredit-kill-sexps-on-line)))) 1432 1433 (defun paredit-kill-line-in-string () 1434 (if (save-excursion (paredit-skip-whitespace t (point-at-eol)) 1435 (eolp)) 1436 (kill-line) 1437 (save-excursion 1438 ;; Be careful not to split an escape sequence. 1439 (if (paredit-in-string-escape-p) 1440 (backward-char)) 1441 (kill-region (point) 1442 (min (point-at-eol) 1443 (cdr (paredit-string-start+end-points))))))) 1444 1445 (defun paredit-kill-line-in-comment () 1446 ;; The variable `kill-whole-line' is not relevant: the point is in a 1447 ;; comment, and hence not at the beginning of the line. 1448 (paredit-check-forward-delete-in-comment) 1449 (kill-line)) 1450 1451 (defun paredit-kill-sexps-on-line () 1452 (if (paredit-in-char-p) ; Move past the \ and prefix. 1453 (backward-char 2)) ; (# in Scheme/CL, ? in elisp) 1454 (let ((beginning (point)) 1455 (eol (point-at-eol))) 1456 (let ((end-of-list-p (paredit-forward-sexps-to-kill beginning eol))) 1457 ;; If we got to the end of the list and it's on the same line, 1458 ;; move backward past the closing delimiter before killing. (This 1459 ;; allows something like killing the whitespace in ( ).) 1460 (if end-of-list-p (progn (up-list) (backward-char))) 1461 (if kill-whole-line 1462 (paredit-kill-sexps-on-whole-line beginning) 1463 (kill-region beginning 1464 ;; If all of the S-expressions were on one line, 1465 ;; i.e. we're still on that line after moving past 1466 ;; the last one, kill the whole line, including 1467 ;; any comments; otherwise just kill to the end of 1468 ;; the last S-expression we found. Be sure, 1469 ;; though, not to kill any closing parentheses. 1470 (if (and (not end-of-list-p) 1471 (eq (point-at-eol) eol)) 1472 eol 1473 (point))))))) 1474 1475 ;;; Please do not try to understand this code unless you have a VERY 1476 ;;; good reason to do so. I gave up trying to figure it out well 1477 ;;; enough to explain it, long ago. 1478 1479 (defun paredit-forward-sexps-to-kill (beginning eol) 1480 (let ((end-of-list-p nil) 1481 (firstp t)) 1482 ;; Move to the end of the last S-expression that started on this 1483 ;; line, or to the closing delimiter if the last S-expression in 1484 ;; this list is on the line. 1485 (catch 'return 1486 (while t 1487 ;; This and the `kill-whole-line' business below fix a bug that 1488 ;; inhibited any S-expression at the very end of the buffer 1489 ;; (with no trailing newline) from being deleted. It's a 1490 ;; bizarre fix that I ought to document at some point, but I am 1491 ;; too busy at the moment to do so. 1492 (if (and kill-whole-line (eobp)) (throw 'return nil)) 1493 (save-excursion 1494 (paredit-handle-sexp-errors (forward-sexp) 1495 (up-list) 1496 (setq end-of-list-p (eq (point-at-eol) eol)) 1497 (throw 'return nil)) 1498 (if (or (and (not firstp) 1499 (not kill-whole-line) 1500 (eobp)) 1501 (paredit-handle-sexp-errors 1502 (progn (backward-sexp) nil) 1503 t) 1504 (not (eq (point-at-eol) eol))) 1505 (throw 'return nil))) 1506 (forward-sexp) 1507 (if (and firstp 1508 (not kill-whole-line) 1509 (eobp)) 1510 (throw 'return nil)) 1511 (setq firstp nil))) 1512 end-of-list-p)) 1513 1514 (defun paredit-kill-sexps-on-whole-line (beginning) 1515 (kill-region beginning 1516 (or (save-excursion ; Delete trailing indentation... 1517 (paredit-skip-whitespace t) 1518 (and (not (eq (char-after) ?\; )) 1519 (point))) 1520 ;; ...or just use the point past the newline, if 1521 ;; we encounter a comment. 1522 (point-at-eol))) 1523 (cond ((save-excursion (paredit-skip-whitespace nil (point-at-bol)) 1524 (bolp)) 1525 ;; Nothing but indentation before the point, so indent it. 1526 (lisp-indent-line)) 1527 ((eobp) nil) ; Protect the CHAR-SYNTAX below against NIL. 1528 ;; Insert a space to avoid invalid joining if necessary. 1529 ((let ((syn-before (char-syntax (char-before))) 1530 (syn-after (char-syntax (char-after)))) 1531 (or (and (eq syn-before ?\) ) ; Separate opposing 1532 (eq syn-after ?\( )) ; parentheses, 1533 (and (eq syn-before ?\" ) ; string delimiter 1534 (eq syn-after ?\" )) ; pairs, 1535 (and (memq syn-before '(?_ ?w)) ; or word or symbol 1536 (memq syn-after '(?_ ?w))))) ; constituents. 1537 (insert " ")))) 1538 1539 ;;;;; Killing Words 1540 1541 ;;; This is tricky and asymmetrical because backward parsing is 1542 ;;; extraordinarily difficult or impossible, so we have to implement 1543 ;;; killing in both directions by parsing forward. 1544 1545 (defun paredit-forward-kill-word () 1546 "Kill a word forward, skipping over intervening delimiters." 1547 (interactive) 1548 (let ((beginning (point))) 1549 (skip-syntax-forward " -") 1550 (let* ((parse-state (paredit-current-parse-state)) 1551 (state (paredit-kill-word-state parse-state 'char-after))) 1552 (while (not (or (eobp) 1553 (eq ?w (char-syntax (char-after))))) 1554 (setq parse-state 1555 (progn (forward-char 1) (paredit-current-parse-state)) 1556 ;; (parse-partial-sexp (point) (1+ (point)) 1557 ;; nil nil parse-state) 1558 ) 1559 (let* ((old-state state) 1560 (new-state 1561 (paredit-kill-word-state parse-state 'char-after))) 1562 (cond ((not (eq old-state new-state)) 1563 (setq parse-state 1564 (paredit-kill-word-hack old-state 1565 new-state 1566 parse-state)) 1567 (setq state 1568 (paredit-kill-word-state parse-state 1569 'char-after)) 1570 (setq beginning (point))))))) 1571 (goto-char beginning) 1572 (kill-word 1))) 1573 1574 (defun paredit-backward-kill-word () 1575 "Kill a word backward, skipping over any intervening delimiters." 1576 (interactive) 1577 (if (not (or (bobp) 1578 (eq (char-syntax (char-before)) ?w))) 1579 (let ((end (point))) 1580 (backward-word 1) 1581 (forward-word 1) 1582 (goto-char (min end (point))) 1583 (let* ((parse-state (paredit-current-parse-state)) 1584 (state 1585 (paredit-kill-word-state parse-state 'char-before))) 1586 (while (and (< (point) end) 1587 (progn 1588 (setq parse-state 1589 (parse-partial-sexp (point) (1+ (point)) 1590 nil nil parse-state)) 1591 (or (eq state 1592 (paredit-kill-word-state parse-state 1593 'char-before)) 1594 (progn (backward-char 1) nil))))) 1595 (if (and (eq state 'comment) 1596 (eq ?\# (char-after (point))) 1597 (eq ?\| (char-before (point)))) 1598 (backward-char 1))))) 1599 (backward-kill-word 1)) 1600 1601 ;;;;;; Word-Killing Auxiliaries 1602 1603 (defun paredit-kill-word-state (parse-state adjacent-char-fn) 1604 (cond ((paredit-in-comment-p parse-state) 'comment) 1605 ((paredit-in-string-p parse-state) 'string) 1606 ((memq (char-syntax (funcall adjacent-char-fn)) 1607 '(?\( ?\) )) 1608 'delimiter) 1609 (t 'other))) 1610 1611 ;;; This optionally advances the point past any comment delimiters that 1612 ;;; should probably not be touched, based on the last state change and 1613 ;;; the characters around the point. It returns a new parse state, 1614 ;;; starting from the PARSE-STATE parameter. 1615 1616 (defun paredit-kill-word-hack (old-state new-state parse-state) 1617 (cond ((and (not (eq old-state 'comment)) 1618 (not (eq new-state 'comment)) 1619 (not (paredit-in-string-escape-p)) 1620 (eq ?\# (char-before)) 1621 (eq ?\| (char-after))) 1622 (forward-char 1) 1623 (paredit-current-parse-state) 1624 ;; (parse-partial-sexp (point) (1+ (point)) 1625 ;; nil nil parse-state) 1626 ) 1627 ((and (not (eq old-state 'comment)) 1628 (eq new-state 'comment) 1629 (eq ?\; (char-before))) 1630 (skip-chars-forward ";") 1631 (paredit-current-parse-state) 1632 ;; (parse-partial-sexp (point) (save-excursion 1633 ;; (skip-chars-forward ";")) 1634 ;; nil nil parse-state) 1635 ) 1636 (t parse-state))) 1637 1638 (defun paredit-copy-as-kill () 1639 "Save in the kill ring the region that `paredit-kill' would kill." 1640 (interactive) 1641 (cond ((paredit-in-string-p) 1642 (paredit-copy-as-kill-in-string)) 1643 ((paredit-in-comment-p) 1644 (copy-region-as-kill (point) (point-at-eol))) 1645 ((save-excursion (paredit-skip-whitespace t (point-at-eol)) 1646 (or (eolp) (eq (char-after) ?\; ))) 1647 ;** Be careful about trailing backslashes. 1648 (save-excursion 1649 (if (paredit-in-char-p) 1650 (backward-char)) 1651 (copy-region-as-kill (point) (point-at-eol)))) 1652 (t (paredit-copy-sexps-as-kill)))) 1653 1654 (defun paredit-copy-as-kill-in-string () 1655 (save-excursion 1656 (if (paredit-in-string-escape-p) 1657 (backward-char)) 1658 (copy-region-as-kill (point) 1659 (min (point-at-eol) 1660 (cdr (paredit-string-start+end-points)))))) 1661 1662 (defun paredit-copy-sexps-as-kill () 1663 (save-excursion 1664 (if (paredit-in-char-p) 1665 (backward-char 2)) 1666 (let ((beginning (point)) 1667 (eol (point-at-eol))) 1668 (let ((end-of-list-p (paredit-forward-sexps-to-kill beginning eol))) 1669 (if end-of-list-p (progn (up-list) (backward-char))) 1670 (copy-region-as-kill beginning 1671 (cond (kill-whole-line 1672 (or (save-excursion 1673 (paredit-skip-whitespace t) 1674 (and (not (eq (char-after) ?\; )) 1675 (point))) 1676 (point-at-eol))) 1677 ((and (not end-of-list-p) 1678 (eq (point-at-eol) eol)) 1679 eol) 1680 (t 1681 (point)))))))) 1682 1683 ;;;; Deleting Regions 1684 1685 (defun paredit-delete-region (start end) 1686 "Delete the text between point and mark, like `delete-region'. 1687 If that text is unbalanced, signal an error instead. 1688 With a prefix argument, skip the balance check." 1689 (interactive "r") 1690 (if (and start end (not current-prefix-arg)) 1691 (paredit-check-region-for-delete start end)) 1692 (setq this-command 'delete-region) 1693 (delete-region start end)) 1694 1695 (defun paredit-kill-region (start end) 1696 "Kill the text between point and mark, like `kill-region'. 1697 If that text is unbalanced, signal an error instead. 1698 With a prefix argument, skip the balance check." 1699 (interactive "r") 1700 (if (and start end (not current-prefix-arg)) 1701 (paredit-check-region-for-delete start end)) 1702 (setq this-command 'kill-region) 1703 (kill-region start end)) 1704 1705 (defun paredit-check-region-for-delete (start end) 1706 "Signal an error deleting text between START and END is unsafe." 1707 (save-excursion 1708 (goto-char start) 1709 (let* ((start-state (paredit-current-parse-state)) 1710 (end-state (parse-partial-sexp start end nil nil start-state))) 1711 (paredit-check-region-for-delete:depth start start-state end end-state) 1712 (paredit-check-region-for-delete:string start start-state end end-state) 1713 (paredit-check-region-for-delete:comment start start-state end end-state) 1714 (paredit-check-region-for-delete:char-quote start start-state 1715 end end-state)))) 1716 1717 (defun paredit-check-region-for-delete:depth (start start-state end end-state) 1718 (let ((start-depth (nth 0 start-state)) 1719 (end-depth (nth 0 end-state))) 1720 (if (not (= start-depth end-depth)) 1721 (error "Mismatched parenthesis depth: %S at start, %S at end." 1722 start-depth 1723 end-depth)))) 1724 1725 (defun paredit-check-region-for-delete:string (start start-state end end-state) 1726 (let ((start-string-p (nth 3 start-state)) 1727 (end-string-p (nth 3 end-state))) 1728 (if (not (eq start-string-p end-string-p)) 1729 (error "Mismatched string state: start %sin string, end %sin string." 1730 (if start-string-p "" "not ") 1731 (if end-string-p "" "not "))))) 1732 1733 (defun paredit-check-region-for-delete:comment 1734 (start start-state end end-state) 1735 (let ((start-comment-state (nth 4 start-state)) 1736 (end-comment-state (nth 4 end-state))) 1737 (if (not (or (eq start-comment-state end-comment-state) 1738 ;; If we are moving text into or out of a line 1739 ;; comment, make sure that the text is balanced. (The 1740 ;; comment state may be a number, not t or nil at all, 1741 ;; for nestable comments, which are not handled by 1742 ;; this heuristic (or any of paredit, really).) 1743 (and (or (and (eq start-comment-state nil) 1744 (eq end-comment-state t)) 1745 (and (eq start-comment-state t) 1746 (eq end-comment-state nil))) 1747 (save-excursion 1748 (goto-char end) 1749 (paredit-region-ok-p (point) (point-at-eol)))))) 1750 (error "Mismatched comment state: %s" 1751 (cond ((and (integerp start-comment-state) 1752 (integerp end-comment-state)) 1753 (format "depth %S at start, depth %S at end." 1754 start-comment-state 1755 end-comment-state)) 1756 ((integerp start-comment-state) 1757 "start in nested comment, end otherwise.") 1758 ((integerp end-comment-state) 1759 "end in nested comment, start otherwise.") 1760 (start-comment-state 1761 "start in comment, end not in comment.") 1762 (end-comment-state 1763 "end in comment, start not in comment.") 1764 (t 1765 (format "start %S, end %S." 1766 start-comment-state 1767 end-comment-state))))))) 1768 1769 (defun paredit-check-region-for-delete:char-quote 1770 (start start-state end end-state) 1771 (let ((start-char-quote (nth 5 start-state)) 1772 (end-char-quote (nth 5 end-state))) 1773 (if (not (eq start-char-quote end-char-quote)) 1774 (let ((phrase "character quotation")) 1775 (error "Mismatched %s: start %sin %s, end %sin %s." 1776 phrase 1777 (if start-char-quote "" "not ") 1778 phrase 1779 (if end-char-quote "" "not ") 1780 phrase))))) 1781 1782 ;;;; Point Motion 1783 1784 (eval-and-compile 1785 (defmacro defun-motion (name bvl doc &rest body) 1786 `(defun ,name ,bvl 1787 ,doc 1788 ,(xcond ((paredit-xemacs-p) 1789 '(interactive "_")) 1790 ((paredit-gnu-emacs-p) 1791 ;++ Not sure this is sufficient for the `^'. 1792 (if (fboundp 'handle-shift-selection) 1793 '(interactive "^p") 1794 '(interactive "p")))) 1795 ,@body))) 1796 1797 (defun-motion paredit-forward (&optional arg) 1798 "Move forward an S-expression, or up an S-expression forward. 1799 If there are no more S-expressions in this one before the closing 1800 delimiter, move past that closing delimiter; otherwise, move forward 1801 past the S-expression following the point." 1802 (let ((n (or arg 1))) 1803 (cond ((< 0 n) (dotimes (i n) (paredit-move-forward))) 1804 ((< n 0) (dotimes (i (- n)) (paredit-move-backward)))))) 1805 1806 (defun-motion paredit-backward (&optional arg) 1807 "Move backward an S-expression, or up an S-expression backward. 1808 If there are no more S-expressions in this one before the opening 1809 delimiter, move past that opening delimiter backward; otherwise, move 1810 move backward past the S-expression preceding the point." 1811 (let ((n (or arg 1))) 1812 (cond ((< 0 n) (dotimes (i n) (paredit-move-backward))) 1813 ((< n 0) (dotimes (i (- n)) (paredit-move-forward)))))) 1814 1815 (defun paredit-move-forward () 1816 (cond ((paredit-in-string-p) 1817 (let ((end (paredit-enclosing-string-end))) 1818 ;; `forward-sexp' and `up-list' may move into the next string 1819 ;; in the buffer. Don't do that; move out of the current one. 1820 (if (paredit-handle-sexp-errors 1821 (progn (paredit-handle-sexp-errors (forward-sexp) 1822 (up-list)) 1823 (<= end (point))) 1824 t) 1825 (goto-char end)))) 1826 ((paredit-in-char-p) 1827 (forward-char)) 1828 (t 1829 (paredit-handle-sexp-errors (forward-sexp) 1830 (up-list))))) 1831 1832 (defun paredit-move-backward () 1833 (cond ((paredit-in-string-p) 1834 (let ((start (paredit-enclosing-string-start))) 1835 (if (paredit-handle-sexp-errors 1836 (progn (paredit-handle-sexp-errors (backward-sexp) 1837 (backward-up-list)) 1838 (<= (point) start)) 1839 t) 1840 (goto-char start)))) 1841 ((paredit-in-char-p) 1842 ;++ Corner case: a buffer of `\|x'. What to do? 1843 (backward-char 2)) 1844 (t 1845 (paredit-handle-sexp-errors (backward-sexp) 1846 (backward-up-list))))) 1847 1848 ;;;; Window Positioning 1849 1850 (defalias 'paredit-recentre-on-sexp 'paredit-recenter-on-sexp) 1851 1852 (defun paredit-recenter-on-sexp (&optional n) 1853 "Recenter the screen on the S-expression following the point. 1854 With a prefix argument N, encompass all N S-expressions forward." 1855 (interactive "P") 1856 (let* ((p (point)) 1857 (end-point (progn (forward-sexp n) (point))) 1858 (start-point (progn (goto-char end-point) (backward-sexp n) (point)))) 1859 ;; Point is at beginning of first S-expression. 1860 (let ((p-visible nil) (start-visible nil)) 1861 (save-excursion 1862 (forward-line (/ (count-lines start-point end-point) 2)) 1863 (recenter) 1864 (setq p-visible (pos-visible-in-window-p p)) 1865 (setq start-visible (pos-visible-in-window-p start-point))) 1866 (cond ((not start-visible) 1867 ;; Implies (not p-visible). Put the start at the top of 1868 ;; the screen. 1869 (recenter 0)) 1870 (p-visible 1871 ;; Go back to p if we can. 1872 (goto-char p)))))) 1873 1874 (defun paredit-recenter-on-defun () 1875 "Recenter the screen on the definition at point." 1876 (interactive) 1877 (save-excursion 1878 (beginning-of-defun) 1879 (paredit-recenter-on-sexp))) 1880 1881 (defun paredit-focus-on-defun () 1882 "Moves display to the top of the definition at point." 1883 (interactive) 1884 (beginning-of-defun) 1885 (recenter 0)) 1886 1887 ;;;; Generalized Upward/Downward Motion 1888 1889 (defun paredit-up/down (n vertical-direction) 1890 (let ((horizontal-direction (if (< 0 n) +1 -1))) 1891 (while (/= n 0) 1892 (goto-char 1893 (paredit-next-up/down-point horizontal-direction vertical-direction)) 1894 (setq n (- n horizontal-direction))))) 1895 1896 (defun paredit-next-up/down-point (horizontal-direction vertical-direction) 1897 (let ((state (paredit-current-parse-state)) 1898 (scan-lists 1899 (lambda () 1900 (scan-lists (point) horizontal-direction vertical-direction)))) 1901 (cond ((paredit-in-string-p state) 1902 (let ((start+end (paredit-string-start+end-points state))) 1903 (if (< 0 vertical-direction) 1904 (if (< 0 horizontal-direction) 1905 (+ 1 (cdr start+end)) 1906 (car start+end)) 1907 ;; We could let the user try to descend into lists 1908 ;; within the string, but that would be asymmetric 1909 ;; with the up case, which rises out of the whole 1910 ;; string and not just out of a list within the 1911 ;; string, so this case will just be an error. 1912 (error "Can't descend further into string.")))) 1913 ((< 0 vertical-direction) 1914 ;; When moving up, just try to rise up out of the list. 1915 (or (funcall scan-lists) 1916 (buffer-end horizontal-direction))) 1917 ((< vertical-direction 0) 1918 ;; When moving down, look for a string closer than a list, 1919 ;; and use that if we find it. 1920 (let* ((list-start 1921 (paredit-handle-sexp-errors (funcall scan-lists) nil)) 1922 (string-start 1923 (paredit-find-next-string-start horizontal-direction 1924 list-start))) 1925 (if (and string-start list-start) 1926 (if (< 0 horizontal-direction) 1927 (min string-start list-start) 1928 (max string-start list-start)) 1929 (or string-start 1930 ;; Scan again: this is a kludgey way to report the 1931 ;; error if there really was one. 1932 (funcall scan-lists) 1933 (buffer-end horizontal-direction))))) 1934 (t 1935 (error "Vertical direction must be nonzero in `%s'." 1936 'paredit-up/down))))) 1937 1938 (defun paredit-find-next-string-start (horizontal-direction limit) 1939 (let ((buffer-limit-p (if (< 0 horizontal-direction) 'eobp 'bobp)) 1940 (next-char (if (< 0 horizontal-direction) 'char-after 'char-before)) 1941 (pastp (if (< 0 horizontal-direction) '> '<))) 1942 (paredit-handle-sexp-errors 1943 (save-excursion 1944 (catch 'exit 1945 (while t 1946 (if (or (funcall buffer-limit-p) 1947 (and limit (funcall pastp (point) limit))) 1948 (throw 'exit nil)) 1949 (forward-sexp horizontal-direction) 1950 (save-excursion 1951 (backward-sexp horizontal-direction) 1952 (if (eq ?\" (char-syntax (funcall next-char))) 1953 (throw 'exit (+ (point) horizontal-direction))))))) 1954 nil))) 1955 1956 (defun-motion paredit-forward-down (&optional argument) 1957 "Move forward down into a list. 1958 With a positive argument, move forward down that many levels. 1959 With a negative argument, move backward down that many levels." 1960 (paredit-up/down (or argument +1) -1)) 1961 1962 (defun-motion paredit-backward-up (&optional argument) 1963 "Move backward up out of the enclosing list. 1964 With a positive argument, move backward up that many levels. 1965 With a negative argument, move forward up that many levels. 1966 If in a string initially, that counts as one level." 1967 (paredit-up/down (- 0 (or argument +1)) +1)) 1968 1969 (defun-motion paredit-forward-up (&optional argument) 1970 "Move forward up out of the enclosing list. 1971 With a positive argument, move forward up that many levels. 1972 With a negative argument, move backward up that many levels. 1973 If in a string initially, that counts as one level." 1974 (paredit-up/down (or argument +1) +1)) 1975 1976 (defun-motion paredit-backward-down (&optional argument) 1977 "Move backward down into a list. 1978 With a positive argument, move backward down that many levels. 1979 With a negative argument, move forward down that many levels." 1980 (paredit-up/down (- 0 (or argument +1)) -1)) 1981 1982 ;;;; Depth-Changing Commands: Wrapping, Splicing, & Raising 1983 1984 (defun paredit-wrap-sexp (&optional argument open close) 1985 "Wrap the following S-expression. 1986 If a `C-u' prefix argument is given, wrap all S-expressions following 1987 the point until the end of the buffer or of the enclosing list. 1988 If a numeric prefix argument N is given, wrap N S-expressions. 1989 Automatically indent the newly wrapped S-expression. 1990 As a special case, if the point is at the end of a list, simply insert 1991 a parenthesis pair, rather than inserting a lone opening delimiter 1992 and then signalling an error, in the interest of preserving 1993 structure. 1994 By default OPEN and CLOSE are round delimiters." 1995 (interactive "P") 1996 (paredit-lose-if-not-in-sexp 'paredit-wrap-sexp) 1997 (let ((open (or open ?\( )) 1998 (close (or close ?\) ))) 1999 (paredit-handle-sexp-errors 2000 ((lambda (n) (paredit-insert-pair n open close 'goto-char)) 2001 (cond ((integerp argument) argument) 2002 ((consp argument) (paredit-count-sexps-forward)) 2003 ((paredit-region-active-p) nil) 2004 (t 1))) 2005 (insert close) 2006 (backward-char))) 2007 (save-excursion (backward-up-list) (indent-sexp))) 2008 2009 (defun paredit-yank-pop (&optional argument) 2010 "Replace just-yanked text with the next item in the kill ring. 2011 If this command follows a `yank', just run `yank-pop'. 2012 If this command follows a `paredit-wrap-sexp', or any other paredit 2013 wrapping command (see `paredit-wrap-commands'), run `yank' and 2014 reindent the enclosing S-expression. 2015 If this command is repeated, run `yank-pop' and reindent the enclosing 2016 S-expression. 2017 2018 The argument is passed on to `yank' or `yank-pop'; see their 2019 documentation for details." 2020 (interactive "*p") 2021 (cond ((eq last-command 'yank) 2022 (yank-pop argument)) 2023 ((memq last-command paredit-wrap-commands) 2024 (yank argument) 2025 ;; `yank' futzes with `this-command'. 2026 (setq this-command 'paredit-yank-pop) 2027 (save-excursion (backward-up-list) (indent-sexp))) 2028 ((eq last-command 'paredit-yank-pop) 2029 ;; Pretend we just did a `yank', so that we can use 2030 ;; `yank-pop' without duplicating its definition. 2031 (setq last-command 'yank) 2032 (yank-pop argument) 2033 ;; Return to our original state. 2034 (setq last-command 'paredit-yank-pop) 2035 (setq this-command 'paredit-yank-pop) 2036 (save-excursion (backward-up-list) (indent-sexp))) 2037 (t (error "Last command was not a yank or a wrap: %s" last-command)))) 2038 2039 (defun paredit-splice-sexp (&optional argument) 2040 "Splice the list that the point is on by removing its delimiters. 2041 With a prefix argument as in `C-u', kill all S-expressions backward in 2042 the current list before splicing all S-expressions forward into the 2043 enclosing list. 2044 With two prefix arguments as in `C-u C-u', kill all S-expressions 2045 forward in the current list before splicing all S-expressions 2046 backward into the enclosing list. 2047 With a numerical prefix argument N, kill N S-expressions backward in 2048 the current list before splicing the remaining S-expressions into the 2049 enclosing list. If N is negative, kill forward. 2050 Inside a string, unescape all backslashes, or signal an error if doing 2051 so would invalidate the buffer's structure." 2052 (interactive "P") 2053 (if (paredit-in-string-p) 2054 (paredit-splice-string argument) 2055 (if (paredit-in-comment-p) 2056 (error "Can't splice comment.")) 2057 (paredit-handle-sexp-errors (paredit-enclosing-list-start) 2058 (error "Can't splice top level.")) 2059 (paredit-kill-surrounding-sexps-for-splice argument) 2060 (let ((delete-start (paredit-enclosing-list-start)) 2061 (delete-end 2062 (let ((limit 2063 (save-excursion 2064 (paredit-ignore-sexp-errors (forward-sexp) (backward-sexp)) 2065 (point)))) 2066 (save-excursion 2067 (backward-up-list) 2068 (forward-char +1) 2069 (paredit-skip-whitespace t limit) 2070 (point))))) 2071 (let ((end-marker (make-marker))) 2072 (save-excursion 2073 (up-list) 2074 (delete-char -1) 2075 (set-marker end-marker (point))) 2076 (delete-region delete-start delete-end) 2077 (paredit-splice-reindent delete-start (marker-position end-marker)))))) 2078 2079 (defun paredit-splice-reindent (start end) 2080 (paredit-preserving-column 2081 ;; If we changed the first subform of the enclosing list, we must 2082 ;; reindent the whole enclosing list. 2083 (if (paredit-handle-sexp-errors 2084 (save-excursion 2085 (backward-up-list) 2086 (down-list) 2087 (paredit-ignore-sexp-errors (forward-sexp)) 2088 (< start (point))) 2089 nil) 2090 (save-excursion (backward-up-list) (indent-sexp)) 2091 (paredit-indent-region start end)))) 2092 2093 (defun paredit-kill-surrounding-sexps-for-splice (argument) 2094 (cond ((or (paredit-in-string-p) 2095 (paredit-in-comment-p)) 2096 (error "Invalid context for splicing S-expressions.")) 2097 ((or (not argument) (eq argument 0)) nil) 2098 ((or (numberp argument) (eq argument '-)) 2099 ;; Kill S-expressions before/after the point by saving the 2100 ;; point, moving across them, and killing the region. 2101 (let* ((argument (if (eq argument '-) -1 argument)) 2102 (saved (paredit-point-at-sexp-boundary (- argument)))) 2103 (goto-char saved) 2104 (paredit-ignore-sexp-errors (backward-sexp argument)) 2105 (paredit-hack-kill-region saved (point)))) 2106 ((consp argument) 2107 (let ((v (car argument))) 2108 (if (= v 4) ;One `C-u'. 2109 ;; Move backward until we hit the open paren; then 2110 ;; kill that selected region. 2111 (let ((end (point))) 2112 (paredit-ignore-sexp-errors 2113 (while (not (bobp)) 2114 (backward-sexp))) 2115 (paredit-hack-kill-region (point) end)) 2116 ;; Move forward until we hit the close paren; then 2117 ;; kill that selected region. 2118 (let ((beginning (point))) 2119 (paredit-ignore-sexp-errors 2120 (while (not (eobp)) 2121 (forward-sexp))) 2122 (paredit-hack-kill-region beginning (point)))))) 2123 (t (error "Bizarre prefix argument `%s'." argument)))) 2124 2125 (defun paredit-splice-sexp-killing-backward (&optional n) 2126 "Splice the list the point is on by removing its delimiters, and 2127 also kill all S-expressions before the point in the current list. 2128 With a prefix argument N, kill only the preceding N S-expressions." 2129 (interactive "P") 2130 (paredit-splice-sexp (if n 2131 (prefix-numeric-value n) 2132 '(4)))) 2133 2134 (defun paredit-splice-sexp-killing-forward (&optional n) 2135 "Splice the list the point is on by removing its delimiters, and 2136 also kill all S-expressions after the point in the current list. 2137 With a prefix argument N, kill only the following N S-expressions." 2138 (interactive "P") 2139 (paredit-splice-sexp (if n 2140 (- (prefix-numeric-value n)) 2141 '(16)))) 2142 2143 (defun paredit-raise-sexp (&optional argument) 2144 "Raise the following S-expression in a tree, deleting its siblings. 2145 With a prefix argument N, raise the following N S-expressions. If N 2146 is negative, raise the preceding N S-expressions. 2147 If the point is on an S-expression, such as a string or a symbol, not 2148 between them, that S-expression is considered to follow the point." 2149 (interactive "P") 2150 (save-excursion 2151 (cond ((paredit-in-string-p) 2152 (goto-char (car (paredit-string-start+end-points)))) 2153 ((paredit-in-char-p) 2154 (backward-sexp)) 2155 ((paredit-in-comment-p) 2156 (error "No S-expression to raise in comment."))) 2157 ;; Select the S-expressions we want to raise in a buffer substring. 2158 (let* ((n (prefix-numeric-value argument)) 2159 (bound (scan-sexps (point) n)) 2160 (sexps 2161 (if (< n 0) 2162 (buffer-substring bound (paredit-point-at-sexp-end)) 2163 (buffer-substring (paredit-point-at-sexp-start) bound)))) 2164 ;; Move up to the list we're raising those S-expressions out of and 2165 ;; delete it. 2166 (backward-up-list) 2167 (delete-region (point) (scan-sexps (point) 1)) 2168 (let* ((indent-start (point)) 2169 (indent-end (save-excursion (insert sexps) (point)))) 2170 ;; If the expression spans multiple lines, its indentation is 2171 ;; probably broken, so reindent it -- but don't reindent 2172 ;; anything that we didn't touch outside the expression. 2173 ;; 2174 ;; XXX What if the *column* of the starting point was preserved 2175 ;; too? Should we avoid reindenting in that case? 2176 (if (not (eq (save-excursion (goto-char indent-start) (point-at-eol)) 2177 (save-excursion (goto-char indent-end) (point-at-eol)))) 2178 (indent-region indent-start indent-end nil)))))) 2179 2180 ;;; The effects of convolution on the surrounding whitespace are pretty 2181 ;;; random. If you have better suggestions, please let me know. 2182 2183 (defun paredit-convolute-sexp (&optional n) 2184 "Convolute S-expressions. 2185 Save the S-expressions preceding point and delete them. 2186 Splice the S-expressions following point. 2187 Wrap the enclosing list in a new list prefixed by the saved text. 2188 With a prefix argument N, move up N lists before wrapping." 2189 (interactive "p") 2190 (paredit-lose-if-not-in-sexp 'paredit-convolute-sexp) 2191 ;; Make sure we can move up before destroying anything. 2192 (save-excursion (backward-up-list n) (backward-up-list)) 2193 (let (open close) ;++ Is this a good idea? 2194 (let ((prefix 2195 (let ((end (point))) 2196 (paredit-ignore-sexp-errors 2197 (while (not (bobp)) (backward-sexp))) 2198 (prog1 (buffer-substring (point) end) 2199 (backward-up-list) 2200 (save-excursion (forward-sexp) 2201 (setq close (char-before)) 2202 (delete-char -1)) 2203 (setq open (char-after)) 2204 (delete-region (point) end) 2205 ;; I'm not sure this makes sense... 2206 (if (not (eolp)) (just-one-space)))))) 2207 (backward-up-list n) 2208 (paredit-insert-pair 1 open close 'goto-char) 2209 (insert prefix) 2210 ;; I'm not sure this makes sense either... 2211 (if (not (eolp)) (just-one-space)) 2212 (save-excursion 2213 (backward-up-list) 2214 (paredit-ignore-sexp-errors (indent-sexp)))))) 2215 2216 (defun paredit-splice-string (argument) 2217 (let ((original-point (point)) 2218 (start+end (paredit-string-start+end-points))) 2219 (let ((start (car start+end)) 2220 (end (cdr start+end))) 2221 ;; START and END both lie before the respective quote 2222 ;; characters, which we want to delete; thus we increment START 2223 ;; by one to extract the string, and we increment END by one to 2224 ;; delete the string. 2225 (let* ((escaped-string 2226 (cond ((not (consp argument)) 2227 (buffer-substring (1+ start) end)) 2228 ((= 4 (car argument)) 2229 (buffer-substring original-point end)) 2230 (t 2231 (buffer-substring (1+ start) original-point)))) 2232 (unescaped-string 2233 (paredit-unescape-string escaped-string))) 2234 (if (not unescaped-string) 2235 (error "Unspliceable string.") 2236 (save-excursion 2237 (goto-char start) 2238 (delete-region start (1+ end)) 2239 (insert unescaped-string)) 2240 (if (not (and (consp argument) 2241 (= 4 (car argument)))) 2242 (goto-char (- original-point 1)))))))) 2243 2244 (defun paredit-unescape-string (string) 2245 (with-temp-buffer 2246 (insert string) 2247 (goto-char (point-min)) 2248 (while (and (not (eobp)) 2249 ;; nil -> no bound; t -> no errors. 2250 (search-forward "\\" nil t)) 2251 (delete-char -1) 2252 (forward-char)) 2253 (paredit-handle-sexp-errors 2254 (progn (scan-sexps (point-min) (point-max)) 2255 (buffer-string)) 2256 nil))) 2257 2258 ;;;; Slurpage & Barfage 2259 2260 (defun paredit-forward-slurp-sexp (&optional argument) 2261 "Add the S-expression following the current list into that list 2262 by moving the closing delimiter. 2263 Automatically reindent the newly slurped S-expression with respect to 2264 its new enclosing form. 2265 If in a string, move the opening double-quote forward by one 2266 S-expression and escape any intervening characters as necessary, 2267 without altering any indentation or formatting." 2268 (interactive "P") 2269 (save-excursion 2270 (cond ((paredit-in-comment-p) 2271 (error "Invalid context for slurping S-expressions.")) 2272 ((numberp argument) 2273 (if (< argument 0) 2274 (paredit-forward-barf-sexp (- 0 argument)) 2275 (while (< 0 argument) 2276 (paredit-forward-slurp-sexp) 2277 (setq argument (- argument 1))))) 2278 ((paredit-in-string-p) 2279 ;; If there is anything to slurp into the string, take that. 2280 ;; Otherwise, try to slurp into the enclosing list. 2281 (if (save-excursion 2282 (goto-char (paredit-enclosing-string-end)) 2283 (paredit-handle-sexp-errors (progn (forward-sexp) nil) 2284 t)) 2285 (progn 2286 (goto-char (paredit-enclosing-string-end)) 2287 (paredit-forward-slurp-into-list argument)) 2288 (paredit-forward-slurp-into-string argument))) 2289 (t 2290 (paredit-forward-slurp-into-list argument))))) 2291 2292 (defun paredit-forward-slurp-into-list (&optional argument) 2293 (let ((nestedp nil)) 2294 (save-excursion 2295 (up-list) ; Up to the end of the list to 2296 (let ((close (char-before))) ; save and delete the closing 2297 (delete-char -1) ; delimiter. 2298 (let ((start (point))) 2299 (catch 'return ; Go to the end of the desired 2300 (while t ; S-expression, going up a 2301 (paredit-handle-sexp-errors ; list if it's not in this, 2302 (progn (forward-sexp) 2303 (if argument 2304 (paredit-ignore-sexp-errors 2305 (while (not (eobp)) 2306 (forward-sexp)))) 2307 (throw 'return nil)) 2308 (setq nestedp t) 2309 (up-list) 2310 (setq close ; adjusting for mixed 2311 (prog1 (char-before) ; delimiters as necessary, 2312 (delete-char -1) 2313 (insert close)))))) 2314 (insert close) ; to insert that delimiter. 2315 (indent-region start (point) nil)))) 2316 (if (and (not nestedp) 2317 (eq (save-excursion (paredit-skip-whitespace nil) (point)) 2318 (save-excursion (backward-up-list) (forward-char) (point))) 2319 (eq (save-excursion (forward-sexp) (backward-sexp) (point)) 2320 (save-excursion (paredit-skip-whitespace t) (point)))) 2321 (delete-region (save-excursion (paredit-skip-whitespace nil) (point)) 2322 (save-excursion (paredit-skip-whitespace t) (point)))))) 2323 2324 (defun paredit-forward-slurp-into-string (&optional argument) 2325 (let ((start (paredit-enclosing-string-start)) 2326 (end (paredit-enclosing-string-end))) 2327 (goto-char end) 2328 ;; Signal any errors that we might get first, before mucking with 2329 ;; the buffer's contents. 2330 (save-excursion (forward-sexp)) 2331 (let ((close (char-before))) 2332 ;; Skip intervening whitespace if we're slurping into an empty 2333 ;; string. XXX What about nonempty strings? 2334 (if (and (= (+ start 2) end) 2335 (eq (save-excursion (paredit-skip-whitespace t) (point)) 2336 (save-excursion (forward-sexp) (backward-sexp) (point)))) 2337 (delete-region (- (point) 1) 2338 (save-excursion (paredit-skip-whitespace t) (point))) 2339 (delete-char -1)) 2340 (paredit-forward-for-quote 2341 (save-excursion 2342 (forward-sexp) 2343 (if argument 2344 (while (paredit-handle-sexp-errors (progn (forward-sexp) t) nil))) 2345 (point))) 2346 (insert close)))) 2347 2348 (defun paredit-forward-barf-sexp (&optional argument) 2349 "Remove the last S-expression in the current list from that list 2350 by moving the closing delimiter. 2351 Automatically reindent the newly barfed S-expression with respect to 2352 its new enclosing form." 2353 (interactive "P") 2354 (paredit-lose-if-not-in-sexp 'paredit-forward-barf-sexp) 2355 (if (and (numberp argument) (< argument 0)) 2356 (paredit-forward-slurp-sexp (- 0 argument)) 2357 (let ((start (point)) (end nil)) 2358 (save-excursion 2359 (up-list) ; Up to the end of the list to 2360 (let ((close (char-before))) ; save and delete the closing 2361 (delete-char -1) ; delimiter. 2362 (setq end (point)) 2363 (paredit-ignore-sexp-errors ; Go back to where we want to 2364 (if (or (not argument) ; insert the delimiter. 2365 (numberp argument)) 2366 (backward-sexp argument) 2367 (while (paredit-handle-sexp-errors 2368 (save-excursion (backward-sexp) (<= start (point))) 2369 nil) 2370 (backward-sexp)))) 2371 (paredit-skip-whitespace nil) ; Skip leading whitespace. 2372 (cond ((bobp) 2373 ;++ We'll have deleted the close, but there's no open. 2374 ;++ Is that OK? 2375 (error "Barfing all subexpressions with no open-paren?")) 2376 ((paredit-in-comment-p) ; Don't put the close-paren in 2377 (newline))) ; a comment. 2378 (insert close)) 2379 ;; Reindent all of the newly barfed S-expressions. Start at the 2380 ;; start of the first barfed S-expression, not at the close we 2381 ;; just inserted. 2382 (forward-sexp) 2383 (backward-sexp) 2384 (if (or (not argument) (numberp argument)) 2385 (paredit-forward-and-indent argument) 2386 (indent-region (point) end)))))) 2387 2388 (defun paredit-backward-slurp-sexp (&optional argument) 2389 "Add the S-expression preceding the current list into that list 2390 by moving the closing delimiter. 2391 Automatically reindent the whole form into which new S-expression was 2392 slurped. 2393 If in a string, move the opening double-quote backward by one 2394 S-expression and escape any intervening characters as necessary, 2395 without altering any indentation or formatting." 2396 (interactive "P") 2397 (save-excursion 2398 (cond ((paredit-in-comment-p) 2399 (error "Invalid context for slurping S-expressions.")) 2400 ((numberp argument) 2401 (if (< argument 0) 2402 (paredit-backward-barf-sexp (- 0 argument)) 2403 (while (< 0 argument) 2404 (paredit-backward-slurp-sexp) 2405 (setq argument (- argument 1))))) 2406 ((paredit-in-string-p) 2407 ;; If there is anything to slurp into the string, take that. 2408 ;; Otherwise, try to slurp into the enclosing list. 2409 (if (save-excursion 2410 (goto-char (paredit-enclosing-string-start)) 2411 (paredit-handle-sexp-errors (progn (backward-sexp) nil) 2412 t)) 2413 (progn 2414 (goto-char (paredit-enclosing-string-start)) 2415 (paredit-backward-slurp-into-list argument)) 2416 (paredit-backward-slurp-into-string argument))) 2417 (t 2418 (paredit-backward-slurp-into-list argument))))) 2419 2420 (defun paredit-backward-slurp-into-list (&optional argument) 2421 (let ((nestedp nil)) 2422 (save-excursion 2423 (backward-up-list) 2424 (let ((open (char-after))) 2425 (delete-char +1) 2426 (catch 'return 2427 (while t 2428 (paredit-handle-sexp-errors 2429 (progn (backward-sexp) 2430 (if argument 2431 (paredit-ignore-sexp-errors 2432 (while (not (bobp)) 2433 (backward-sexp)))) 2434 (throw 'return nil)) 2435 (setq nestedp t) 2436 (backward-up-list) 2437 (setq open 2438 (prog1 (char-after) 2439 (save-excursion (insert open) (delete-char +1))))))) 2440 (insert open)) 2441 ;; Reindent the line at the beginning of wherever we inserted the 2442 ;; opening delimiter, and then indent the whole S-expression. 2443 (backward-up-list) 2444 (lisp-indent-line) 2445 (indent-sexp)) 2446 ;; If we slurped into an empty list, don't leave dangling space: 2447 ;; (foo |). 2448 (if (and (not nestedp) 2449 (eq (save-excursion (paredit-skip-whitespace nil) (point)) 2450 (save-excursion (backward-sexp) (forward-sexp) (point))) 2451 (eq (save-excursion (up-list) (backward-char) (point)) 2452 (save-excursion (paredit-skip-whitespace t) (point)))) 2453 (delete-region (save-excursion (paredit-skip-whitespace nil) (point)) 2454 (save-excursion (paredit-skip-whitespace t) (point)))))) 2455 2456 (defun paredit-backward-slurp-into-string (&optional argument) 2457 (let ((start (paredit-enclosing-string-start)) 2458 (end (paredit-enclosing-string-end))) 2459 (goto-char start) 2460 ;; Signal any errors that we might get first, before mucking with 2461 ;; the buffer's contents. 2462 (save-excursion (backward-sexp)) 2463 (let ((open (char-after)) 2464 (target (point))) 2465 ;; Skip intervening whitespace if we're slurping into an empty 2466 ;; string. XXX What about nonempty strings? 2467 (if (and (= (+ start 2) end) 2468 (eq (save-excursion (paredit-skip-whitespace nil) (point)) 2469 (save-excursion (backward-sexp) (forward-sexp) (point)))) 2470 (delete-region (save-excursion (paredit-skip-whitespace nil) (point)) 2471 (+ (point) 1)) 2472 (delete-char +1)) 2473 (backward-sexp) 2474 (if argument 2475 (paredit-ignore-sexp-errors 2476 (while (not (bobp)) 2477 (backward-sexp)))) 2478 (insert open) 2479 (paredit-forward-for-quote target)))) 2480 2481 (defun paredit-backward-barf-sexp (&optional argument) 2482 "Remove the first S-expression in the current list from that list 2483 by moving the closing delimiter. 2484 Automatically reindent the barfed S-expression and the form from which 2485 it was barfed." 2486 (interactive "P") 2487 (paredit-lose-if-not-in-sexp 'paredit-backward-barf-sexp) 2488 (if (and (numberp argument) (< argument 0)) 2489 (paredit-backward-slurp-sexp (- 0 argument)) 2490 (let ((end (make-marker))) 2491 (set-marker end (point)) 2492 (save-excursion 2493 (backward-up-list) 2494 (let ((open (char-after))) 2495 (delete-char +1) 2496 (paredit-ignore-sexp-errors 2497 (paredit-forward-and-indent 2498 (if (or (not argument) (numberp argument)) 2499 argument 2500 (let ((n 0)) 2501 (save-excursion 2502 (while (paredit-handle-sexp-errors 2503 (save-excursion 2504 (forward-sexp) 2505 (<= (point) end)) 2506 nil) 2507 (forward-sexp) 2508 (setq n (+ n 1)))) 2509 n)))) 2510 (while (progn (paredit-skip-whitespace t) (eq (char-after) ?\; )) 2511 (forward-line 1)) 2512 (if (eobp) 2513 ;++ We'll have deleted the close, but there's no open. 2514 ;++ Is that OK? 2515 (error "Barfing all subexpressions with no close-paren?")) 2516 ;** Don't use `insert' here. Consider, e.g., barfing from 2517 ;** (foo|) 2518 ;** and how `save-excursion' works. 2519 (insert-before-markers open)) 2520 (backward-up-list) 2521 (lisp-indent-line) 2522 (indent-sexp))))) 2523 2524 ;;;; Splitting & Joining 2525 2526 (defun paredit-split-sexp () 2527 "Split the list or string the point is on into two." 2528 (interactive) 2529 (cond ((paredit-in-string-p) 2530 (insert "\"") 2531 (save-excursion (insert " \""))) 2532 ((or (paredit-in-comment-p) 2533 (paredit-in-char-p)) 2534 (error "Invalid context for splitting S-expression.")) 2535 (t 2536 (let ((open (save-excursion (backward-up-list) (char-after))) 2537 (close (save-excursion (up-list) (char-before)))) 2538 (delete-horizontal-space) 2539 (insert close) 2540 (save-excursion 2541 (insert ?\ ) 2542 (insert open) 2543 (backward-char) 2544 (indent-sexp)))))) 2545 2546 (defun paredit-join-sexps () 2547 "Join the S-expressions adjacent on either side of the point. 2548 Both must be lists, strings, or atoms; error if there is a mismatch." 2549 (interactive) 2550 (cond ((paredit-in-comment-p) (error "Can't join S-expressions in comment.")) 2551 ((paredit-in-string-p) (error "Nothing to join in a string.")) 2552 ((paredit-in-char-p) (error "Can't join characters."))) 2553 (let ((left-point (paredit-point-at-sexp-end)) 2554 (right-point (paredit-point-at-sexp-start))) 2555 (let ((left-char (char-before left-point)) 2556 (right-char (char-after right-point))) 2557 (let ((left-syntax (char-syntax left-char)) 2558 (right-syntax (char-syntax right-char))) 2559 (cond ((< right-point left-point) 2560 (error "Can't join a datum with itself.")) 2561 ((and (eq left-syntax ?\) ) 2562 (eq right-syntax ?\( ) 2563 (eq left-char (matching-paren right-char)) 2564 (eq right-char (matching-paren left-char))) 2565 (paredit-join-lists-internal left-point right-point) 2566 (paredit-preserving-column 2567 (save-excursion 2568 (backward-up-list) 2569 (indent-sexp)))) 2570 ((and (eq left-syntax ?\" ) 2571 (eq right-syntax ?\" )) 2572 ;; Delete any intermediate formatting. 2573 (delete-region (1- left-point) (1+ right-point))) 2574 ((and (memq left-syntax '(?w ?_)) ; Word or symbol 2575 (memq right-syntax '(?w ?_))) 2576 (delete-region left-point right-point)) 2577 (t (error "Mismatched S-expressions to join."))))))) 2578 2579 (defun paredit-join-lists-internal (left-point right-point) 2580 (save-excursion 2581 ;; Leave intermediate formatting alone. 2582 (goto-char right-point) 2583 (delete-char +1) 2584 (goto-char left-point) 2585 (delete-char -1) 2586 ;; Kludge: Add an extra space in several conditions. 2587 (if (or 2588 ;; (foo)| ;x\n(bar) => (foo | ;x\nbar), not (foo| ;x\nbar). 2589 (and (not (eolp)) 2590 (save-excursion 2591 (paredit-skip-whitespace t (point-at-eol)) 2592 (eq (char-after) ?\;))) 2593 ;; (foo)|(bar) => (foo| bar), not (foo|bar). 2594 (and (= left-point right-point) 2595 (not (or (eq ?\ (char-syntax (char-before))) 2596 (eq ?\ (char-syntax (char-after))))))) 2597 (insert ?\ )))) 2598 2599 ;++ How ought paredit-join to handle comments intervening symbols or strings? 2600 ;++ Idea: 2601 ;++ 2602 ;++ "foo" | ;bar 2603 ;++ "baz" ;quux 2604 ;++ 2605 ;++ => 2606 ;++ 2607 ;++ "foo|baz" ;bar 2608 ;++ ;quux 2609 ;++ 2610 ;++ The point should stay where it is relative to the comments, and the 2611 ;++ the comments' columns should all be preserved, perhaps. Hmmmm... 2612 ;++ What about this? 2613 ;++ 2614 ;++ "foo" ;bar 2615 ;++ | ;baz 2616 ;++ "quux" ;zot 2617 2618 ;++ Should rename: 2619 ;++ paredit-point-at-sexp-start -> paredit-start-of-sexp-after-point 2620 ;++ paredit-point-at-sexp-end -> paredit-end-of-sexp-before-point 2621 2622 ;;;; Variations on the Lurid Theme 2623 2624 ;;; I haven't the imagination to concoct clever names for these. 2625 2626 (defun paredit-add-to-previous-list () 2627 "Add the S-expression following point to the list preceding point." 2628 (interactive) 2629 (paredit-lose-if-not-in-sexp 'paredit-add-to-previous-list) 2630 (save-excursion 2631 (down-list -1) ;++ backward-down-list... 2632 (paredit-forward-slurp-sexp))) 2633 2634 (defun paredit-add-to-next-list () 2635 "Add the S-expression preceding point to the list following point. 2636 If no S-expression precedes point, move up the tree until one does." 2637 (interactive) 2638 (paredit-lose-if-not-in-sexp 'paredit-add-to-next-list) 2639 (save-excursion 2640 (down-list) 2641 (paredit-backward-slurp-sexp))) 2642 2643 (defun paredit-join-with-previous-list () 2644 "Join the list the point is on with the previous list in the buffer." 2645 (interactive) 2646 (paredit-lose-if-not-in-sexp 'paredit-join-with-previous-list) 2647 (save-excursion 2648 (while (paredit-handle-sexp-errors (save-excursion (backward-sexp) nil) 2649 (backward-up-list) 2650 t)) 2651 (paredit-join-sexps))) 2652 2653 (defun paredit-join-with-next-list () 2654 "Join the list the point is on with the next list in the buffer." 2655 (interactive) 2656 (paredit-lose-if-not-in-sexp 'paredit-join-with-next-list) 2657 (save-excursion 2658 (while (paredit-handle-sexp-errors (save-excursion (forward-sexp) nil) 2659 (up-list) 2660 t)) 2661 (paredit-join-sexps))) 2662 2663 ;;;; Utilities 2664 2665 (defun paredit-in-string-escape-p () 2666 "True if the point is on a character escape of a string. 2667 This is true only if the character is preceded by an odd number of 2668 backslashes. 2669 This assumes that `paredit-in-string-p' has already returned true." 2670 (let ((oddp nil)) 2671 (save-excursion 2672 (while (eq (char-before) ?\\ ) 2673 (setq oddp (not oddp)) 2674 (backward-char))) 2675 oddp)) 2676 2677 (defun paredit-in-char-p (&optional position) 2678 "True if point is on a character escape outside a string." 2679 (save-excursion 2680 (goto-char (or position (point))) 2681 (paredit-in-string-escape-p))) 2682 2683 (defun paredit-skip-whitespace (trailing-p &optional limit) 2684 "Skip past any whitespace, or until the point LIMIT is reached. 2685 If TRAILING-P is nil, skip leading whitespace; otherwise, skip trailing 2686 whitespace." 2687 (funcall (if trailing-p 'skip-chars-forward 'skip-chars-backward) 2688 " \t\n" ; This should skip using the syntax table, but LF 2689 limit)) ; is a comment end, not newline, in Lisp mode. 2690 2691 (defalias 'paredit-region-active-p 2692 (xcond ((paredit-xemacs-p) 'region-active-p) 2693 ((paredit-gnu-emacs-p) 2694 (lambda () 2695 (and mark-active transient-mark-mode))))) 2696 2697 (defun paredit-hack-kill-region (start end) 2698 "Kill the region between START and END. 2699 Do not append to any current kill, and 2700 do not let the next kill append to this one." 2701 (interactive "r") ;Eh, why not? 2702 ;; KILL-REGION sets THIS-COMMAND to tell the next kill that the last 2703 ;; command was a kill. It also checks LAST-COMMAND to see whether it 2704 ;; should append. If we bind these locally, any modifications to 2705 ;; THIS-COMMAND will be masked, and it will not see LAST-COMMAND to 2706 ;; indicate that it should append. 2707 (let ((this-command nil) 2708 (last-command nil)) 2709 (kill-region start end))) 2710 2711 ;;;;; Reindentation utilities 2712 2713 ;++ Should `paredit-indent-sexps' and `paredit-forward-and-indent' use 2714 ;++ `paredit-indent-region' rather than `indent-region'? 2715 2716 (defun paredit-indent-sexps () 2717 "If in a list, indent all following S-expressions in the list." 2718 (let* ((start (point)) 2719 (end (paredit-handle-sexp-errors (progn (up-list) (point)) nil))) 2720 (if end 2721 (indent-region start end nil)))) 2722 2723 (defun paredit-forward-and-indent (&optional n) 2724 "Move forward by N S-expressions, indenting them with `indent-region'." 2725 (let ((start (point))) 2726 (forward-sexp n) 2727 (indent-region start (point) nil))) 2728 2729 (defun paredit-indent-region (start end) 2730 "Indent the region from START to END. 2731 Don't reindent the line starting at START, however." 2732 (if (not (<= start end)) 2733 (error "Incorrectly related points: %S, %S" start end)) 2734 (save-excursion 2735 (goto-char start) 2736 (let ((bol (point-at-bol))) 2737 ;; Skip all S-expressions that end on the starting line, but 2738 ;; don't go past `end'. 2739 (if (and (save-excursion (goto-char end) (not (eq bol (point-at-bol)))) 2740 (paredit-handle-sexp-errors 2741 (catch 'exit 2742 (while t 2743 (save-excursion 2744 (forward-sexp) 2745 (if (not (eq bol (point-at-bol))) 2746 (throw 'exit t)) 2747 (if (not (< (point) end)) 2748 (throw 'exit nil))) 2749 (forward-sexp))) 2750 nil)) 2751 (progn 2752 ;; Point is still on the same line, but precedes an 2753 ;; S-expression that ends on a different line. 2754 (if (not (eq bol (point-at-bol))) 2755 (error "Internal error -- we moved forward a line!")) 2756 (goto-char (+ 1 (point-at-eol))) 2757 (if (not (<= (point) end)) 2758 (error "Internal error -- we frobnitzed the garfnut!")) 2759 (indent-region (point) end nil)))))) 2760 2761 ;;;;; S-expression Parsing Utilities 2762 2763 ;++ These routines redundantly traverse S-expressions a great deal. 2764 ;++ If performance issues arise, this whole section will probably have 2765 ;++ to be refactored to preserve the state longer, like paredit.scm 2766 ;++ does, rather than to traverse the definition N times for every key 2767 ;++ stroke as it presently does. 2768 2769 (defun paredit-current-parse-state () 2770 "Return parse state of point from beginning of defun." 2771 (let ((point (point))) 2772 (beginning-of-defun) 2773 ;; Calling PARSE-PARTIAL-SEXP will advance the point to its second 2774 ;; argument (unless parsing stops due to an error, but we assume it 2775 ;; won't in paredit-mode). 2776 (parse-partial-sexp (point) point))) 2777 2778 (defun paredit-in-string-p (&optional state) 2779 "True if the parse state is within a double-quote-delimited string. 2780 If no parse state is supplied, compute one from the beginning of the 2781 defun to the point." 2782 ;; 3. non-nil if inside a string (the terminator character, really) 2783 (and (nth 3 (or state (paredit-current-parse-state))) 2784 t)) 2785 2786 (defun paredit-string-start+end-points (&optional state) 2787 "Return a cons of the points of open and close quotes of the string. 2788 The string is determined from the parse state STATE, or the parse state 2789 from the beginning of the defun to the point. 2790 This assumes that `paredit-in-string-p' has already returned true, i.e. 2791 that the point is already within a string." 2792 (save-excursion 2793 ;; 8. character address of start of comment or string; nil if not 2794 ;; in one 2795 (let ((start (nth 8 (or state (paredit-current-parse-state))))) 2796 (goto-char start) 2797 (forward-sexp 1) 2798 (cons start (1- (point)))))) 2799 2800 (defun paredit-enclosing-string-start () 2801 (car (paredit-string-start+end-points))) 2802 2803 (defun paredit-enclosing-string-end () 2804 (+ 1 (cdr (paredit-string-start+end-points)))) 2805 2806 (defun paredit-enclosing-list-start () 2807 (save-excursion 2808 (backward-up-list) 2809 (point))) 2810 2811 (defun paredit-enclosing-list-end () 2812 (save-excursion 2813 (up-list) 2814 (point))) 2815 2816 (defun paredit-in-comment-p (&optional state) 2817 "True if parse state STATE is within a comment. 2818 If no parse state is supplied, compute one from the beginning of the 2819 defun to the point." 2820 ;; 4. nil if outside a comment, t if inside a non-nestable comment, 2821 ;; else an integer (the current comment nesting) 2822 (and (nth 4 (or state (paredit-current-parse-state))) 2823 t)) 2824 2825 (defun paredit-prefix-numeric-value (argument) 2826 ;++ Kludgerific. 2827 (cond ((integerp argument) argument) 2828 ((eq argument '-) -1) 2829 ((consp argument) 2830 (cond ((equal argument '(4)) (paredit-count-sexps-forward)) ;C-u 2831 ((equal argument '(16)) (paredit-count-sexps-backward)) ;C-u C-u 2832 (t (error "Invalid prefix argument: %S" argument)))) 2833 ((paredit-region-active-p) 2834 (save-excursion 2835 (save-restriction 2836 (narrow-to-region (region-beginning) (region-end)) 2837 (cond ((= (point) (point-min)) (paredit-count-sexps-forward)) 2838 ((= (point) (point-max)) (paredit-count-sexps-backward)) 2839 (t 2840 (error "Point %S is not start or end of region: %S..%S" 2841 (point) (region-beginning) (region-end))))))) 2842 (t 1))) 2843 2844 (defun paredit-count-sexps-forward () 2845 (save-excursion 2846 (let ((n 0) (p nil)) ;hurk 2847 (paredit-ignore-sexp-errors 2848 (while (setq p (scan-sexps (point) +1)) 2849 (goto-char p) 2850 (setq n (+ n 1)))) 2851 n))) 2852 2853 (defun paredit-count-sexps-backward () 2854 (save-excursion 2855 (let ((n 0) (p nil)) ;hurk 2856 (paredit-ignore-sexp-errors 2857 (while (setq p (scan-sexps (point) -1)) 2858 (goto-char p) 2859 (setq n (+ n 1)))) 2860 n))) 2861 2862 (defun paredit-point-at-sexp-boundary (n) 2863 (cond ((< n 0) (paredit-point-at-sexp-start)) 2864 ((= n 0) (point)) 2865 ((> n 0) (paredit-point-at-sexp-end)))) 2866 2867 (defun paredit-point-at-sexp-start () 2868 (save-excursion 2869 (forward-sexp) 2870 (backward-sexp) 2871 (point))) 2872 2873 (defun paredit-point-at-sexp-end () 2874 (save-excursion 2875 (backward-sexp) 2876 (forward-sexp) 2877 (point))) 2878 2879 (defun paredit-lose-if-not-in-sexp (command) 2880 (if (or (paredit-in-string-p) 2881 (paredit-in-comment-p) 2882 (paredit-in-char-p)) 2883 (error "Invalid context for command `%s'." command))) 2884 2885 (defun paredit-check-region (start end) 2886 "Signal an error if text between `start' and `end' is unbalanced." 2887 ;; `narrow-to-region' will move the point, so avoid calling it if we 2888 ;; don't need to. We don't want to use `save-excursion' because we 2889 ;; want the point to move if `check-parens' reports an error. 2890 (if (not (paredit-region-ok-p start end)) 2891 (save-restriction 2892 (narrow-to-region start end) 2893 (check-parens)))) 2894 2895 (defun paredit-region-ok-p (start end) 2896 "Return true iff the region between `start' and `end' is balanced. 2897 This is independent of context -- it doesn't check what state the 2898 text at `start' is in." 2899 (save-excursion 2900 (paredit-handle-sexp-errors 2901 (progn 2902 (save-restriction 2903 (narrow-to-region start end) 2904 (scan-sexps (point-min) (point-max))) 2905 t) 2906 nil))) 2907 2908 (defun paredit-current-indentation () 2909 (save-excursion 2910 (back-to-indentation) 2911 (current-column))) 2912 2913 (defun paredit-restore-column (column indentation) 2914 ;; Preserve the point's position either in the indentation or in the 2915 ;; code: if on code, move with the code; if in indentation, leave it 2916 ;; in the indentation, either where it was (if still on indentation) 2917 ;; or at the end of the indentation (if the code moved far enough 2918 ;; left). 2919 (let ((indentation* (paredit-current-indentation))) 2920 (goto-char 2921 (+ (point-at-bol) 2922 (cond ((not (< column indentation)) 2923 (+ column (- indentation* indentation))) 2924 ((<= indentation* column) indentation*) 2925 (t column)))))) 2926 2927 ;;;; Initialization 2928 2929 (paredit-define-keys) 2930 (paredit-annotate-mode-with-examples) 2931 (paredit-annotate-functions-with-examples) 2932 2933 (provide 'paredit) 2934 2935 ;;; Local Variables: 2936 ;;; outline-regexp: "\n;;;;+" 2937 ;;; End: 2938 2939 ;;; paredit.el ends here