Mercurial > dotfiles
comparison .elisp/paredit.el @ 7:9541f7e47514
Some edits to .emacs after my playing with Clojure, also added Clojure support files.
| author | Augie Fackler <durin42@gmail.com> |
|---|---|
| date | Sun, 30 Nov 2008 20:50:18 -0600 |
| parents | |
| children |
comparison
equal
deleted
inserted
replaced
| 6:66f8fcaee427 | 7:9541f7e47514 |
|---|---|
| 1 ;;; -*- Mode: Emacs-Lisp; outline-regexp: " \n;;;;+" -*- | |
| 2 | |
| 3 ;;;;;; Paredit: Parenthesis-Editing Minor Mode | |
| 4 ;;;;;; Version 20 | |
| 5 | |
| 6 ;;; This code is written by Taylor R. Campbell (except where explicitly | |
| 7 ;;; noted) and placed in the Public Domain. All warranties are | |
| 8 ;;; disclaimed. | |
| 9 | |
| 10 ;;; Add this to your .emacs after adding paredit.el to /path/to/elisp/: | |
| 11 ;;; | |
| 12 ;;; (add-to-list 'load-path "/path/to/elisp/") | |
| 13 ;;; (autoload 'paredit-mode "paredit" | |
| 14 ;;; "Minor mode for pseudo-structurally editing Lisp code." | |
| 15 ;;; t) | |
| 16 ;;; (add-hook '...-mode-hook (lambda () (paredit-mode +1))) | |
| 17 ;;; | |
| 18 ;;; Usually the ... will be lisp or scheme or both. Alternatively, you | |
| 19 ;;; can manually toggle this mode with M-x paredit-mode. Customization | |
| 20 ;;; of paredit can be accomplished with `eval-after-load': | |
| 21 ;;; | |
| 22 ;;; (eval-after-load 'paredit | |
| 23 ;;; '(progn ...redefine keys, &c....)) | |
| 24 ;;; | |
| 25 ;;; This should run in GNU Emacs 21 or later and XEmacs 21.5 or later. | |
| 26 ;;; It is highly unlikely to work in earlier versions of GNU Emacs, and | |
| 27 ;;; it may have obscure problems in earlier versions of XEmacs due to | |
| 28 ;;; the way its syntax parser reports conditions, as a result of which | |
| 29 ;;; the code that uses the syntax parser must mask *all* error | |
| 30 ;;; conditions, not just those generated by the syntax parser. | |
| 31 | |
| 32 ;;; This mode changes the keybindings for a number of simple keys, | |
| 33 ;;; notably (, ), ", \, and ;. The bracket keys (round or square) are | |
| 34 ;;; defined to insert parenthesis pairs and move past the close, | |
| 35 ;;; respectively; the double-quote key is multiplexed to do both, and | |
| 36 ;;; also insert an escape if within a string; backslashes prompt the | |
| 37 ;;; user for the next character to input, because a lone backslash can | |
| 38 ;;; break structure inadvertently; and semicolons ensure that they do | |
| 39 ;;; not accidentally comment valid structure. (Use M-; to comment an | |
| 40 ;;; expression.) These all have their ordinary behaviour when inside | |
| 41 ;;; comments, and, outside comments, if truly necessary, you can insert | |
| 42 ;;; them literally with C-q. | |
| 43 ;;; | |
| 44 ;;; These keybindings are set up for my preference. One particular | |
| 45 ;;; preference which I've seen vary greatly from person to person is | |
| 46 ;;; whether the command to move past a closing delimiter ought to | |
| 47 ;;; insert a newline. Since I find this behaviour to be more common | |
| 48 ;;; than that which inserts no newline, I have ) bound to it, and the | |
| 49 ;;; more involved M-) to perform the less common action. This bothers | |
| 50 ;;; some users, though, and they prefer the other way around. This | |
| 51 ;;; code, which you can use `eval-after-load' to put in your .emacs, | |
| 52 ;;; will exchange the bindings: | |
| 53 ;;; | |
| 54 ;;; (define-key paredit-mode-map (kbd ")") | |
| 55 ;;; 'paredit-close-parenthesis) | |
| 56 ;;; (define-key paredit-mode-map (kbd "M-)") | |
| 57 ;;; 'paredit-close-parenthesis-and-newline) | |
| 58 ;;; | |
| 59 ;;; Paredit also changes the bindings of keys for deleting and killing, | |
| 60 ;;; so that they will not destroy any S-expression structure by killing | |
| 61 ;;; or deleting only one side of a bracket or quote pair. If the point | |
| 62 ;;; is on a closing bracket, DEL will move left over it; if it is on an | |
| 63 ;;; opening bracket, C-d will move right over it. Only if the point is | |
| 64 ;;; between a pair of brackets will C-d or DEL delete them, and in that | |
| 65 ;;; case it will delete both simultaneously. M-d and M-DEL kill words, | |
| 66 ;;; but skip over any S-expression structure. C-k kills from the start | |
| 67 ;;; of the line, either to the line's end, if it contains only balanced | |
| 68 ;;; expressions; to the first closing bracket, if the point is within a | |
| 69 ;;; form that ends on the line; or up to the end of the last expression | |
| 70 ;;; that starts on the line after the point. | |
| 71 ;;; | |
| 72 ;;; Automatic reindentation is performed as locally as possible, to | |
| 73 ;;; ensure that Emacs does not interfere with custom indentation used | |
| 74 ;;; elsewhere in some S-expression. It is performed only by the | |
| 75 ;;; advanced S-expression frobnication commands, and only on the forms | |
| 76 ;;; that were immediately operated upon (& their subforms). | |
| 77 ;;; | |
| 78 ;;; This code is written for clarity, not efficiency. S-expressions | |
| 79 ;;; are frequently walked over redundantly. If you have problems with | |
| 80 ;;; some of the commands taking too long to execute, tell me, but first | |
| 81 ;;; make sure that what you're doing is reasonable: it is stylistically | |
| 82 ;;; bad to have huge, long, hideously nested code anyway. | |
| 83 ;;; | |
| 84 ;;; Questions, bug reports, comments, feature suggestions, &c., can be | |
| 85 ;;; addressed to the author via mail on the host mumble.net to campbell | |
| 86 ;;; or via IRC on irc.freenode.net in the #paredit channel under the | |
| 87 ;;; nickname Riastradh. | |
| 88 | |
| 89 ;;; This assumes Unix-style LF line endings. | |
| 90 | |
| 91 (defconst paredit-version 20) | |
| 92 | |
| 93 (eval-and-compile | |
| 94 | |
| 95 (defun paredit-xemacs-p () | |
| 96 ;; No idea I got this definition from. Edward O'Connor (hober on | |
| 97 ;; IRC) suggested the current definition. | |
| 98 ;; (and (boundp 'running-xemacs) | |
| 99 ;; running-xemacs) | |
| 100 (featurep 'xemacs)) | |
| 101 | |
| 102 (defun paredit-gnu-emacs-p () | |
| 103 (not (paredit-xemacs-p))) | |
| 104 | |
| 105 (defmacro xcond (&rest clauses) | |
| 106 "Exhaustive COND. | |
| 107 Signal an error if no clause matches." | |
| 108 `(cond ,@clauses | |
| 109 (t (error "XCOND lost.")))) | |
| 110 | |
| 111 (defalias 'paredit-warn (if (fboundp 'warn) 'warn 'message)) | |
| 112 | |
| 113 (defvar paredit-sexp-error-type | |
| 114 (with-temp-buffer | |
| 115 (insert "(") | |
| 116 (condition-case condition | |
| 117 (backward-sexp) | |
| 118 (error (if (eq (car condition) 'error) | |
| 119 (paredit-warn "%s%s%s%s" | |
| 120 "Paredit is unable to discriminate" | |
| 121 " S-expression parse errors from" | |
| 122 " other errors. " | |
| 123 " This may cause obscure problems. " | |
| 124 " Please upgrade Emacs.")) | |
| 125 (car condition))))) | |
| 126 | |
| 127 (defmacro paredit-handle-sexp-errors (body &rest handler) | |
| 128 `(condition-case () | |
| 129 ,body | |
| 130 (,paredit-sexp-error-type ,@handler))) | |
| 131 | |
| 132 (put 'paredit-handle-sexp-errors 'lisp-indent-function 1) | |
| 133 | |
| 134 (defmacro paredit-ignore-sexp-errors (&rest body) | |
| 135 `(paredit-handle-sexp-errors (progn ,@body) | |
| 136 nil)) | |
| 137 | |
| 138 (put 'paredit-ignore-sexp-errors 'lisp-indent-function 0) | |
| 139 | |
| 140 nil) | |
| 141 | |
| 142 ;;;; Minor Mode Definition | |
| 143 | |
| 144 (defvar paredit-mode-map (make-sparse-keymap) | |
| 145 "Keymap for the paredit minor mode.") | |
| 146 | |
| 147 (define-minor-mode paredit-mode | |
| 148 "Minor mode for pseudo-structurally editing Lisp code. | |
| 149 \\<paredit-mode-map>" | |
| 150 :lighter " Paredit" | |
| 151 ;; If we're enabling paredit-mode, the prefix to this code that | |
| 152 ;; DEFINE-MINOR-MODE inserts will have already set PAREDIT-MODE to | |
| 153 ;; true. If this is the case, then first check the parentheses, and | |
| 154 ;; if there are any imbalanced ones we must inhibit the activation of | |
| 155 ;; paredit mode. We skip the check, though, if the user supplied a | |
| 156 ;; prefix argument interactively. | |
| 157 (if (and paredit-mode | |
| 158 (not current-prefix-arg)) | |
| 159 (if (not (fboundp 'check-parens)) | |
| 160 (paredit-warn "`check-parens' is not defined; %s" | |
| 161 "be careful of malformed S-expressions.") | |
| 162 (condition-case condition | |
| 163 (check-parens) | |
| 164 (error (setq paredit-mode nil) | |
| 165 (signal (car condition) (cdr condition))))))) | |
| 166 | |
| 167 ;;; Old functions from when there was a different mode for emacs -nw. | |
| 168 | |
| 169 (defun enable-paredit-mode () | |
| 170 "Turn on pseudo-structural editing of Lisp code. | |
| 171 | |
| 172 Deprecated: use `paredit-mode' instead." | |
| 173 (interactive) | |
| 174 (paredit-mode +1)) | |
| 175 | |
| 176 (defun disable-paredit-mode () | |
| 177 "Turn off pseudo-structural editing of Lisp code. | |
| 178 | |
| 179 Deprecated: use `paredit-mode' instead." | |
| 180 (interactive) | |
| 181 (paredit-mode -1)) | |
| 182 | |
| 183 (defvar paredit-backward-delete-key | |
| 184 (xcond ((paredit-xemacs-p) "BS") | |
| 185 ((paredit-gnu-emacs-p) "DEL"))) | |
| 186 | |
| 187 (defvar paredit-forward-delete-keys | |
| 188 (xcond ((paredit-xemacs-p) '("DEL")) | |
| 189 ((paredit-gnu-emacs-p) '("<delete>" "<deletechar>")))) | |
| 190 | |
| 191 ;;;; Paredit Keys | |
| 192 | |
| 193 ;;; Separating the definition and initialization of this variable | |
| 194 ;;; simplifies the development of paredit, since re-evaluating DEFVAR | |
| 195 ;;; forms doesn't actually do anything. | |
| 196 | |
| 197 (defvar paredit-commands nil | |
| 198 "List of paredit commands with their keys and examples.") | |
| 199 | |
| 200 ;;; Each specifier is of the form: | |
| 201 ;;; (key[s] function (example-input example-output) ...) | |
| 202 ;;; where key[s] is either a single string suitable for passing to KBD | |
| 203 ;;; or a list of such strings. Entries in this list may also just be | |
| 204 ;;; strings, in which case they are headings for the next entries. | |
| 205 | |
| 206 (progn (setq paredit-commands | |
| 207 `( | |
| 208 "Basic Insertion Commands" | |
| 209 ("(" paredit-open-parenthesis | |
| 210 ("(a b |c d)" | |
| 211 "(a b (|) c d)") | |
| 212 ("(foo \"bar |baz\" quux)" | |
| 213 "(foo \"bar (|baz\" quux)")) | |
| 214 (")" paredit-close-parenthesis-and-newline | |
| 215 ("(defun f (x| ))" | |
| 216 "(defun f (x)\n |)") | |
| 217 ("; (Foo.|" | |
| 218 "; (Foo.)|")) | |
| 219 ("M-)" paredit-close-parenthesis | |
| 220 ("(a b |c )" "(a b c)|") | |
| 221 ("; Hello,| world!" | |
| 222 "; Hello,)| world!")) | |
| 223 ("[" paredit-open-bracket | |
| 224 ("(a b |c d)" | |
| 225 "(a b [|] c d)") | |
| 226 ("(foo \"bar |baz\" quux)" | |
| 227 "(foo \"bar [baz\" quux)")) | |
| 228 ("]" paredit-close-bracket | |
| 229 ("(define-key keymap [frob| ] 'frobnicate)" | |
| 230 "(define-key keymap [frob]| 'frobnicate)") | |
| 231 ("; [Bar.|" | |
| 232 "; [Bar.]|")) | |
| 233 ("\"" paredit-doublequote | |
| 234 ("(frob grovel |full lexical)" | |
| 235 "(frob grovel \"|\" full lexical)") | |
| 236 ("(foo \"bar |baz\" quux)" | |
| 237 "(foo \"bar \\\"|baz\" quux)")) | |
| 238 ("M-\"" paredit-meta-doublequote | |
| 239 ("(foo \"bar |baz\" quux)" | |
| 240 "(foo \"bar baz\"\n |quux)") | |
| 241 ("(foo |(bar #\\x \"baz \\\\ quux\") zot)" | |
| 242 ,(concat "(foo \"|(bar #\\\\x \\\"baz \\\\" | |
| 243 "\\\\ quux\\\")\" zot)"))) | |
| 244 ("\\" paredit-backslash | |
| 245 ("(string #|)\n ; Escaping character... (x)" | |
| 246 "(string #\\x|)") | |
| 247 ("\"foo|bar\"\n ; Escaping character... (\")" | |
| 248 "\"foo\\\"|bar\"")) | |
| 249 (";" paredit-semicolon | |
| 250 ("|(frob grovel)" | |
| 251 ";|\n(frob grovel)") | |
| 252 ("(frob grovel) |" | |
| 253 "(frob grovel) ;|")) | |
| 254 ("M-;" paredit-comment-dwim | |
| 255 ("(foo |bar) ; baz" | |
| 256 "(foo bar) ; |baz") | |
| 257 ("(frob grovel)|" | |
| 258 "(frob grovel) ;|") | |
| 259 (" (foo bar)\n|\n (baz quux)" | |
| 260 " (foo bar)\n ;; |\n (baz quux)") | |
| 261 (" (foo bar) |(baz quux)" | |
| 262 " (foo bar)\n ;; |\n (baz quux)") | |
| 263 ("|(defun hello-world ...)" | |
| 264 ";;; |\n(defun hello-world ...)")) | |
| 265 | |
| 266 ("C-j" paredit-newline | |
| 267 ("(let ((n (frobbotz))) |(display (+ n 1)\nport))" | |
| 268 ,(concat "(let ((n (frobbotz)))" | |
| 269 "\n |(display (+ n 1)" | |
| 270 "\n port))"))) | |
| 271 | |
| 272 "Deleting & Killing" | |
| 273 (("C-d" ,@paredit-forward-delete-keys) | |
| 274 paredit-forward-delete | |
| 275 ("(quu|x \"zot\")" "(quu| \"zot\")") | |
| 276 ("(quux |\"zot\")" | |
| 277 "(quux \"|zot\")" | |
| 278 "(quux \"|ot\")") | |
| 279 ("(foo (|) bar)" "(foo | bar)") | |
| 280 ("|(foo bar)" "(|foo bar)")) | |
| 281 (,paredit-backward-delete-key | |
| 282 paredit-backward-delete | |
| 283 ("(\"zot\" q|uux)" "(\"zot\" |uux)") | |
| 284 ("(\"zot\"| quux)" | |
| 285 "(\"zot|\" quux)" | |
| 286 "(\"zo|\" quux)") | |
| 287 ("(foo (|) bar)" "(foo | bar)") | |
| 288 ("(foo bar)|" "(foo bar|)")) | |
| 289 ("C-k" paredit-kill | |
| 290 ("(foo bar)| ; Useless comment!" | |
| 291 "(foo bar)|") | |
| 292 ("(|foo bar) ; Useful comment!" | |
| 293 "(|) ; Useful comment!") | |
| 294 ("|(foo bar) ; Useless line!" | |
| 295 "|") | |
| 296 ("(foo \"|bar baz\"\n quux)" | |
| 297 "(foo \"|\"\n quux)")) | |
| 298 ("M-d" paredit-forward-kill-word | |
| 299 ("|(foo bar) ; baz" | |
| 300 "(| bar) ; baz" | |
| 301 "(|) ; baz" | |
| 302 "() ;|") | |
| 303 (";;;| Frobnicate\n(defun frobnicate ...)" | |
| 304 ";;;|\n(defun frobnicate ...)" | |
| 305 ";;;\n(| frobnicate ...)")) | |
| 306 (,(concat "M-" paredit-backward-delete-key) | |
| 307 paredit-backward-kill-word | |
| 308 ("(foo bar) ; baz\n(quux)|" | |
| 309 "(foo bar) ; baz\n(|)" | |
| 310 "(foo bar) ; |\n()" | |
| 311 "(foo |) ; \n()" | |
| 312 "(|) ; \n()")) | |
| 313 | |
| 314 "Movement & Navigation" | |
| 315 ("C-M-f" paredit-forward | |
| 316 ("(foo |(bar baz) quux)" | |
| 317 "(foo (bar baz)| quux)") | |
| 318 ("(foo (bar)|)" | |
| 319 "(foo (bar))|")) | |
| 320 ("C-M-b" paredit-backward | |
| 321 ("(foo (bar baz)| quux)" | |
| 322 "(foo |(bar baz) quux)") | |
| 323 ("(|(foo) bar)" | |
| 324 "|((foo) bar)")) | |
| 325 ;;;("C-M-u" backward-up-list) ; These two are built-in. | |
| 326 ;;;("C-M-d" down-list) | |
| 327 ("C-M-p" backward-down-list) ; Built-in, these are FORWARD- | |
| 328 ("C-M-n" up-list) ; & BACKWARD-LIST, which have | |
| 329 ; no need given C-M-f & C-M-b. | |
| 330 | |
| 331 "Depth-Changing Commands" | |
| 332 ("M-(" paredit-wrap-sexp | |
| 333 ("(foo |bar baz)" | |
| 334 "(foo (|bar) baz)")) | |
| 335 ("M-[" paredit-bracket-wrap-sexp | |
| 336 ("(foo |bar baz)" | |
| 337 "(foo [|bar] baz)")) | |
| 338 ("M-s" paredit-splice-sexp | |
| 339 ("(foo (bar| baz) quux)" | |
| 340 "(foo bar| baz quux)")) | |
| 341 (("M-<up>" "ESC <up>") | |
| 342 paredit-splice-sexp-killing-backward | |
| 343 ("(foo (let ((x 5)) |(sqrt n)) bar)" | |
| 344 "(foo (sqrt n) bar)")) | |
| 345 (("M-<down>" "ESC <down>") | |
| 346 paredit-splice-sexp-killing-forward | |
| 347 ("(a (b c| d e) f)" | |
| 348 "(a b c f)")) | |
| 349 ("M-r" paredit-raise-sexp | |
| 350 ("(dynamic-wind in (lambda () |body) out)" | |
| 351 "(dynamic-wind in |body out)" | |
| 352 "|body")) | |
| 353 | |
| 354 "Barfage & Slurpage" | |
| 355 (("C-)" "C-<right>") | |
| 356 paredit-forward-slurp-sexp | |
| 357 ("(foo (bar |baz) quux zot)" | |
| 358 "(foo (bar |baz quux) zot)") | |
| 359 ("(a b ((c| d)) e f)" | |
| 360 "(a b ((c| d) e) f)")) | |
| 361 (("C-}" "C-<left>") | |
| 362 paredit-forward-barf-sexp | |
| 363 ("(foo (bar |baz quux) zot)" | |
| 364 "(foo (bar |baz) quux zot)")) | |
| 365 (("C-(" "C-M-<left>" "ESC C-<left>") | |
| 366 paredit-backward-slurp-sexp | |
| 367 ("(foo bar (baz| quux) zot)" | |
| 368 "(foo (bar baz| quux) zot)") | |
| 369 ("(a b ((c| d)) e f)" | |
| 370 "(a (b (c| d)) e f)")) | |
| 371 (("C-{" "C-M-<right>" "ESC C-<right>") | |
| 372 paredit-backward-barf-sexp | |
| 373 ("(foo (bar baz |quux) zot)" | |
| 374 "(foo bar (baz |quux) zot)")) | |
| 375 | |
| 376 "Miscellaneous Commands" | |
| 377 ("M-S" paredit-split-sexp | |
| 378 ("(hello| world)" | |
| 379 "(hello)| (world)") | |
| 380 ("\"Hello, |world!\"" | |
| 381 "\"Hello, \"| \"world!\"")) | |
| 382 ("M-J" paredit-join-sexps | |
| 383 ("(hello)| (world)" | |
| 384 "(hello| world)") | |
| 385 ("\"Hello, \"| \"world!\"" | |
| 386 "\"Hello, |world!\"") | |
| 387 ("hello-\n| world" | |
| 388 "hello-|world")) | |
| 389 ("C-c C-M-l" paredit-recentre-on-sexp) | |
| 390 )) | |
| 391 nil) ; end of PROGN | |
| 392 | |
| 393 ;;;;; Command Examples | |
| 394 | |
| 395 (eval-and-compile | |
| 396 (defmacro paredit-do-commands (vars string-case &rest body) | |
| 397 (let ((spec (nth 0 vars)) | |
| 398 (keys (nth 1 vars)) | |
| 399 (fn (nth 2 vars)) | |
| 400 (examples (nth 3 vars))) | |
| 401 `(dolist (,spec paredit-commands) | |
| 402 (if (stringp ,spec) | |
| 403 ,string-case | |
| 404 (let ((,keys (let ((k (car ,spec))) | |
| 405 (cond ((stringp k) (list k)) | |
| 406 ((listp k) k) | |
| 407 (t (error "Invalid paredit command %s." | |
| 408 ,spec))))) | |
| 409 (,fn (cadr ,spec)) | |
| 410 (,examples (cddr ,spec))) | |
| 411 ,@body))))) | |
| 412 | |
| 413 (put 'paredit-do-commands 'lisp-indent-function 2)) | |
| 414 | |
| 415 (defun paredit-define-keys () | |
| 416 (paredit-do-commands (spec keys fn examples) | |
| 417 nil ; string case | |
| 418 (dolist (key keys) | |
| 419 (define-key paredit-mode-map (read-kbd-macro key) fn)))) | |
| 420 | |
| 421 (defun paredit-function-documentation (fn) | |
| 422 (let ((original-doc (get fn 'paredit-original-documentation)) | |
| 423 (doc (documentation fn 'function-documentation))) | |
| 424 (or original-doc | |
| 425 (progn (put fn 'paredit-original-documentation doc) | |
| 426 doc)))) | |
| 427 | |
| 428 (defun paredit-annotate-mode-with-examples () | |
| 429 (let ((contents | |
| 430 (list (paredit-function-documentation 'paredit-mode)))) | |
| 431 (paredit-do-commands (spec keys fn examples) | |
| 432 (push (concat "\n \n" spec "\n") | |
| 433 contents) | |
| 434 (let ((name (symbol-name fn))) | |
| 435 (if (string-match (symbol-name 'paredit-) name) | |
| 436 (push (concat "\n\n\\[" name "]\t" name | |
| 437 (if examples | |
| 438 (mapconcat (lambda (example) | |
| 439 (concat | |
| 440 "\n" | |
| 441 (mapconcat 'identity | |
| 442 example | |
| 443 "\n --->\n") | |
| 444 "\n")) | |
| 445 examples | |
| 446 "") | |
| 447 "\n (no examples)\n")) | |
| 448 contents)))) | |
| 449 (put 'paredit-mode 'function-documentation | |
| 450 (apply 'concat (reverse contents)))) | |
| 451 ;; PUT returns the huge string we just constructed, which we don't | |
| 452 ;; want it to return. | |
| 453 nil) | |
| 454 | |
| 455 (defun paredit-annotate-functions-with-examples () | |
| 456 (paredit-do-commands (spec keys fn examples) | |
| 457 nil ; string case | |
| 458 (put fn 'function-documentation | |
| 459 (concat (paredit-function-documentation fn) | |
| 460 "\n\n\\<paredit-mode-map>\\[" (symbol-name fn) "]\n" | |
| 461 (mapconcat (lambda (example) | |
| 462 (concat "\n" | |
| 463 (mapconcat 'identity | |
| 464 example | |
| 465 "\n ->\n") | |
| 466 "\n")) | |
| 467 examples | |
| 468 ""))))) | |
| 469 | |
| 470 ;;;;; HTML Examples | |
| 471 | |
| 472 (defun paredit-insert-html-examples () | |
| 473 "Insert HTML for a paredit quick reference table." | |
| 474 (interactive) | |
| 475 (let ((insert-lines (lambda (&rest lines) | |
| 476 (mapc (lambda (line) (insert line) (newline)) | |
| 477 lines))) | |
| 478 (html-keys (lambda (keys) | |
| 479 (mapconcat 'paredit-html-quote keys ", "))) | |
| 480 (html-example | |
| 481 (lambda (example) | |
| 482 (concat "<table><tr><td><pre>" | |
| 483 (mapconcat 'paredit-html-quote | |
| 484 example | |
| 485 (concat "</pre></td></tr><tr><td>" | |
| 486 " --->" | |
| 487 "</td></tr><tr><td><pre>")) | |
| 488 "</pre></td></tr></table>"))) | |
| 489 (firstp t)) | |
| 490 (paredit-do-commands (spec keys fn examples) | |
| 491 (progn (if (not firstp) | |
| 492 (insert "</table>\n") | |
| 493 (setq firstp nil)) | |
| 494 (funcall insert-lines | |
| 495 (concat "<h3>" spec "</h3>") | |
| 496 "<table border=\"1\" cellpadding=\"1\">" | |
| 497 " <tr>" | |
| 498 " <th>Command</th>" | |
| 499 " <th>Keys</th>" | |
| 500 " <th>Examples</th>" | |
| 501 " </tr>")) | |
| 502 (let ((name (symbol-name fn))) | |
| 503 (if (string-match (symbol-name 'paredit-) name) | |
| 504 (funcall insert-lines | |
| 505 " <tr>" | |
| 506 (concat " <td><tt>" name "</tt></td>") | |
| 507 (concat " <td align=\"center\">" | |
| 508 (funcall html-keys keys) | |
| 509 "</td>") | |
| 510 (concat " <td>" | |
| 511 (if examples | |
| 512 (mapconcat html-example examples | |
| 513 "<hr>") | |
| 514 "(no examples)") | |
| 515 "</td>") | |
| 516 " </tr>"))))) | |
| 517 (insert "</table>\n")) | |
| 518 | |
| 519 (defun paredit-html-quote (string) | |
| 520 (with-temp-buffer | |
| 521 (dotimes (i (length string)) | |
| 522 (insert (let ((c (elt string i))) | |
| 523 (cond ((eq c ?\<) "<") | |
| 524 ((eq c ?\>) ">") | |
| 525 ((eq c ?\&) "&") | |
| 526 ((eq c ?\') "'") | |
| 527 ((eq c ?\") """) | |
| 528 (t c))))) | |
| 529 (buffer-string))) | |
| 530 | |
| 531 ;;;; Delimiter Insertion | |
| 532 | |
| 533 (eval-and-compile | |
| 534 (defun paredit-conc-name (&rest strings) | |
| 535 (intern (apply 'concat strings))) | |
| 536 | |
| 537 (defmacro define-paredit-pair (open close name) | |
| 538 `(progn | |
| 539 (defun ,(paredit-conc-name "paredit-open-" name) (&optional n) | |
| 540 ,(concat "Insert a balanced " name " pair. | |
| 541 With a prefix argument N, put the closing " name " after N | |
| 542 S-expressions forward. | |
| 543 If the region is active, `transient-mark-mode' is enabled, and the | |
| 544 region's start and end fall in the same parenthesis depth, insert a | |
| 545 " name " pair around the region. | |
| 546 If in a string or a comment, insert a single " name ". | |
| 547 If in a character literal, do nothing. This prevents changing what was | |
| 548 in the character literal to a meaningful delimiter unintentionally.") | |
| 549 (interactive "P") | |
| 550 (cond ((or (paredit-in-string-p) | |
| 551 (paredit-in-comment-p)) | |
| 552 (insert ,open)) | |
| 553 ((not (paredit-in-char-p)) | |
| 554 (paredit-insert-pair n ,open ,close 'goto-char)))) | |
| 555 (defun ,(paredit-conc-name "paredit-close-" name) () | |
| 556 ,(concat "Move past one closing delimiter and reindent. | |
| 557 \(Agnostic to the specific closing delimiter.) | |
| 558 If in a string or comment, insert a single closing " name ". | |
| 559 If in a character literal, do nothing. This prevents changing what was | |
| 560 in the character literal to a meaningful delimiter unintentionally.") | |
| 561 (interactive) | |
| 562 (paredit-move-past-close ,close)) | |
| 563 (defun ,(paredit-conc-name "paredit-close-" name "-and-newline") () | |
| 564 ,(concat "Move past one closing delimiter, add a newline," | |
| 565 " and reindent. | |
| 566 If there was a margin comment after the closing delimiter, preserve it | |
| 567 on the same line.") | |
| 568 (interactive) | |
| 569 (paredit-move-past-close-and-newline ,close)) | |
| 570 (defun ,(paredit-conc-name "paredit-" name "-wrap-sexp") (&optional n) | |
| 571 ,(concat "Wrap a pair of " name " around a sexp") | |
| 572 (interactive "P") | |
| 573 (paredit-wrap-sexp n ,open ,close))))) | |
| 574 | |
| 575 (define-paredit-pair ?\( ?\) "parenthesis") | |
| 576 (define-paredit-pair ?\[ ?\] "bracket") | |
| 577 (define-paredit-pair ?\{ ?\} "brace") | |
| 578 (define-paredit-pair ?\< ?\> "brocket") | |
| 579 | |
| 580 (defun paredit-move-past-close (close) | |
| 581 (cond ((or (paredit-in-string-p) | |
| 582 (paredit-in-comment-p)) | |
| 583 (insert close)) | |
| 584 ((not (paredit-in-char-p)) | |
| 585 (paredit-move-past-close-and-reindent) | |
| 586 (paredit-blink-paren-match nil)))) | |
| 587 | |
| 588 (defun paredit-move-past-close-and-newline (close) | |
| 589 (cond ((or (paredit-in-string-p) | |
| 590 (paredit-in-comment-p)) | |
| 591 (insert close)) | |
| 592 (t (if (paredit-in-char-p) (forward-char)) | |
| 593 (paredit-move-past-close-and-reindent) | |
| 594 (let ((comment.point (paredit-find-comment-on-line))) | |
| 595 (newline) | |
| 596 (if comment.point | |
| 597 (save-excursion | |
| 598 (forward-line -1) | |
| 599 (end-of-line) | |
| 600 (indent-to (cdr comment.point)) | |
| 601 (insert (car comment.point))))) | |
| 602 (lisp-indent-line) | |
| 603 (paredit-ignore-sexp-errors (indent-sexp)) | |
| 604 (paredit-blink-paren-match t)))) | |
| 605 | |
| 606 (defun paredit-find-comment-on-line () | |
| 607 "Find a margin comment on the current line. | |
| 608 If such a comment exists, delete the comment (including all leading | |
| 609 whitespace) and return a cons whose car is the comment as a string | |
| 610 and whose cdr is the point of the comment's initial semicolon, | |
| 611 relative to the start of the line." | |
| 612 (save-excursion | |
| 613 (catch 'return | |
| 614 (while t | |
| 615 (if (search-forward ";" (point-at-eol) t) | |
| 616 (if (not (or (paredit-in-string-p) | |
| 617 (paredit-in-char-p))) | |
| 618 (let* ((start (progn (backward-char) ;before semicolon | |
| 619 (point))) | |
| 620 (comment (buffer-substring start | |
| 621 (point-at-eol)))) | |
| 622 (paredit-skip-whitespace nil (point-at-bol)) | |
| 623 (delete-region (point) (point-at-eol)) | |
| 624 (throw 'return | |
| 625 (cons comment (- start (point-at-bol)))))) | |
| 626 (throw 'return nil)))))) | |
| 627 | |
| 628 (defun paredit-insert-pair (n open close forward) | |
| 629 (let* ((regionp (and (paredit-region-active-p) | |
| 630 (paredit-region-safe-for-insert-p))) | |
| 631 (end (and regionp | |
| 632 (not n) | |
| 633 (prog1 (region-end) | |
| 634 (goto-char (region-beginning)))))) | |
| 635 (let ((spacep (paredit-space-for-delimiter-p nil open))) | |
| 636 (if spacep (insert " ")) | |
| 637 (insert open) | |
| 638 (save-excursion | |
| 639 ;; Move past the desired region. | |
| 640 (cond (n (funcall forward | |
| 641 (save-excursion | |
| 642 (forward-sexp (prefix-numeric-value n)) | |
| 643 (point)))) | |
| 644 (regionp (funcall forward (+ end (if spacep 2 1))))) | |
| 645 (insert close) | |
| 646 (if (paredit-space-for-delimiter-p t close) | |
| 647 (insert " ")))))) | |
| 648 | |
| 649 (defun paredit-region-safe-for-insert-p () | |
| 650 (save-excursion | |
| 651 (let ((beginning (region-beginning)) | |
| 652 (end (region-end))) | |
| 653 (goto-char beginning) | |
| 654 (let* ((beginning-state (paredit-current-parse-state)) | |
| 655 (end-state (parse-partial-sexp beginning end | |
| 656 nil nil beginning-state))) | |
| 657 (and (= (nth 0 beginning-state) ; 0. depth in parens | |
| 658 (nth 0 end-state)) | |
| 659 (eq (nth 3 beginning-state) ; 3. non-nil if inside a | |
| 660 (nth 3 end-state)) ; string | |
| 661 (eq (nth 4 beginning-state) ; 4. comment status, yada | |
| 662 (nth 4 end-state)) | |
| 663 (eq (nth 5 beginning-state) ; 5. t if following char | |
| 664 (nth 5 end-state))))))) ; quote | |
| 665 | |
| 666 (defun paredit-space-for-delimiter-p (endp delimiter) | |
| 667 ;; If at the buffer limit, don't insert a space. If there is a word, | |
| 668 ;; symbol, other quote, or non-matching parenthesis delimiter (i.e. a | |
| 669 ;; close when want an open the string or an open when we want to | |
| 670 ;; close the string), do insert a space. | |
| 671 (and (not (if endp (eobp) (bobp))) | |
| 672 (memq (char-syntax (if endp | |
| 673 (char-after) | |
| 674 (char-before))) | |
| 675 (list ?w ?_ ?\" | |
| 676 (let ((matching (matching-paren delimiter))) | |
| 677 (and matching (char-syntax matching))))))) | |
| 678 | |
| 679 (defun paredit-move-past-close-and-reindent () | |
| 680 (let ((orig (point))) | |
| 681 (up-list) | |
| 682 (if (catch 'return ; This CATCH returns T if it | |
| 683 (while t ; should delete leading spaces | |
| 684 (save-excursion ; and NIL if not. | |
| 685 (let ((before-paren (1- (point)))) | |
| 686 (back-to-indentation) | |
| 687 (cond ((not (eq (point) before-paren)) | |
| 688 ;; Can't call PAREDIT-DELETE-LEADING-WHITESPACE | |
| 689 ;; here -- we must return from SAVE-EXCURSION | |
| 690 ;; first. | |
| 691 (throw 'return t)) | |
| 692 ((save-excursion (forward-line -1) | |
| 693 (end-of-line) | |
| 694 (paredit-in-comment-p)) | |
| 695 ;; Moving the closing parenthesis any further | |
| 696 ;; would put it into a comment, so we just | |
| 697 ;; indent the closing parenthesis where it is | |
| 698 ;; and abort the loop, telling its continuation | |
| 699 ;; that no leading whitespace should be deleted. | |
| 700 (lisp-indent-line) | |
| 701 (throw 'return nil)) | |
| 702 (t (delete-indentation))))))) | |
| 703 (paredit-delete-leading-whitespace)))) | |
| 704 | |
| 705 (defun paredit-delete-leading-whitespace () | |
| 706 ;; This assumes that we're on the closing parenthesis already. | |
| 707 (save-excursion | |
| 708 (backward-char) | |
| 709 (while (let ((syn (char-syntax (char-before)))) | |
| 710 (and (or (eq syn ?\ ) (eq syn ?-)) ; whitespace syntax | |
| 711 ;; The above line is a perfect example of why the | |
| 712 ;; following test is necessary. | |
| 713 (not (paredit-in-char-p (1- (point)))))) | |
| 714 (backward-delete-char 1)))) | |
| 715 | |
| 716 (defun paredit-blink-paren-match (another-line-p) | |
| 717 (if (and blink-matching-paren | |
| 718 (or (not show-paren-mode) another-line-p)) | |
| 719 (paredit-ignore-sexp-errors | |
| 720 (save-excursion | |
| 721 (backward-sexp) | |
| 722 (forward-sexp) | |
| 723 ;; SHOW-PAREN-MODE inhibits any blinking, so we disable it | |
| 724 ;; locally here. | |
| 725 (let ((show-paren-mode nil)) | |
| 726 (blink-matching-open)))))) | |
| 727 | |
| 728 (defun paredit-doublequote (&optional n) | |
| 729 "Insert a pair of double-quotes. | |
| 730 With a prefix argument N, wrap the following N S-expressions in | |
| 731 double-quotes, escaping intermediate characters if necessary. | |
| 732 If the region is active, `transient-mark-mode' is enabled, and the | |
| 733 region's start and end fall in the same parenthesis depth, insert a | |
| 734 pair of double-quotes around the region, again escaping intermediate | |
| 735 characters if necessary. | |
| 736 Inside a comment, insert a literal double-quote. | |
| 737 At the end of a string, move past the closing double-quote. | |
| 738 In the middle of a string, insert a backslash-escaped double-quote. | |
| 739 If in a character literal, do nothing. This prevents accidentally | |
| 740 changing a what was in the character literal to become a meaningful | |
| 741 delimiter unintentionally." | |
| 742 (interactive "P") | |
| 743 (cond ((paredit-in-string-p) | |
| 744 (if (eq (cdr (paredit-string-start+end-points)) | |
| 745 (point)) | |
| 746 (forward-char) ; We're on the closing quote. | |
| 747 (insert ?\\ ?\" ))) | |
| 748 ((paredit-in-comment-p) | |
| 749 (insert ?\" )) | |
| 750 ((not (paredit-in-char-p)) | |
| 751 (paredit-insert-pair n ?\" ?\" 'paredit-forward-for-quote)))) | |
| 752 | |
| 753 (defun paredit-meta-doublequote (&optional n) | |
| 754 "Move to the end of the string, insert a newline, and indent. | |
| 755 If not in a string, act as `paredit-doublequote'; if no prefix argument | |
| 756 is specified and the region is not active or `transient-mark-mode' is | |
| 757 disabled, the default is to wrap one S-expression, however, not | |
| 758 zero." | |
| 759 (interactive "P") | |
| 760 (if (not (paredit-in-string-p)) | |
| 761 (paredit-doublequote (or n | |
| 762 (and (not (paredit-region-active-p)) | |
| 763 1))) | |
| 764 (let ((start+end (paredit-string-start+end-points))) | |
| 765 (goto-char (1+ (cdr start+end))) | |
| 766 (newline) | |
| 767 (lisp-indent-line) | |
| 768 (paredit-ignore-sexp-errors (indent-sexp))))) | |
| 769 | |
| 770 (defun paredit-forward-for-quote (end) | |
| 771 (let ((state (paredit-current-parse-state))) | |
| 772 (while (< (point) end) | |
| 773 (let ((new-state (parse-partial-sexp (point) (1+ (point)) | |
| 774 nil nil state))) | |
| 775 (if (paredit-in-string-p new-state) | |
| 776 (if (not (paredit-in-string-escape-p)) | |
| 777 (setq state new-state) | |
| 778 ;; Escape character: turn it into an escaped escape | |
| 779 ;; character by appending another backslash. | |
| 780 (insert ?\\ ) | |
| 781 ;; Now the point is after both escapes, and we want to | |
| 782 ;; rescan from before the first one to after the second | |
| 783 ;; one. | |
| 784 (setq state | |
| 785 (parse-partial-sexp (- (point) 2) (point) | |
| 786 nil nil state)) | |
| 787 ;; Advance the end point, since we just inserted a new | |
| 788 ;; character. | |
| 789 (setq end (1+ end))) | |
| 790 ;; String: escape by inserting a backslash before the quote. | |
| 791 (backward-char) | |
| 792 (insert ?\\ ) | |
| 793 ;; The point is now between the escape and the quote, and we | |
| 794 ;; want to rescan from before the escape to after the quote. | |
| 795 (setq state | |
| 796 (parse-partial-sexp (1- (point)) (1+ (point)) | |
| 797 nil nil state)) | |
| 798 ;; Advance the end point for the same reason as above. | |
| 799 (setq end (1+ end))))))) | |
| 800 | |
| 801 ;;;; Escape Insertion | |
| 802 | |
| 803 (defun paredit-backslash () | |
| 804 "Insert a backslash followed by a character to escape." | |
| 805 (interactive) | |
| 806 (insert ?\\ ) | |
| 807 ;; This funny conditional is necessary because PAREDIT-IN-COMMENT-P | |
| 808 ;; assumes that PAREDIT-IN-STRING-P already returned false; otherwise | |
| 809 ;; it may give erroneous answers. | |
| 810 (if (or (paredit-in-string-p) | |
| 811 (not (paredit-in-comment-p))) | |
| 812 (let ((delp t)) | |
| 813 (unwind-protect (setq delp | |
| 814 (call-interactively 'paredit-escape)) | |
| 815 ;; We need this in an UNWIND-PROTECT so that the backlash is | |
| 816 ;; left in there *only* if PAREDIT-ESCAPE return NIL normally | |
| 817 ;; -- in any other case, such as the user hitting C-g or an | |
| 818 ;; error occurring, we must delete the backslash to avoid | |
| 819 ;; leaving a dangling escape. (This control structure is a | |
| 820 ;; crock.) | |
| 821 (if delp (backward-delete-char 1)))))) | |
| 822 | |
| 823 ;;; This auxiliary interactive function returns true if the backslash | |
| 824 ;;; should be deleted and false if not. | |
| 825 | |
| 826 (defun paredit-escape (char) | |
| 827 ;; I'm too lazy to figure out how to do this without a separate | |
| 828 ;; interactive function. | |
| 829 (interactive "cEscaping character...") | |
| 830 (if (eq char 127) ; The backslash was a typo, so | |
| 831 t ; the luser wants to delete it. | |
| 832 (insert char) ; (Is there a better way to | |
| 833 nil)) ; express the rubout char? | |
| 834 ; ?\^? works, but ugh...) | |
| 835 | |
| 836 ;;; The placement of this function in this file is totally random. | |
| 837 | |
| 838 (defun paredit-newline () | |
| 839 "Insert a newline and indent it. | |
| 840 This is like `newline-and-indent', but it not only indents the line | |
| 841 that the point is on but also the S-expression following the point, | |
| 842 if there is one. | |
| 843 Move forward one character first if on an escaped character. | |
| 844 If in a string, just insert a literal newline." | |
| 845 (interactive) | |
| 846 (if (paredit-in-string-p) | |
| 847 (newline) | |
| 848 (if (and (not (paredit-in-comment-p)) (paredit-in-char-p)) | |
| 849 (forward-char)) | |
| 850 (newline-and-indent) | |
| 851 ;; Indent the following S-expression, but don't signal an error if | |
| 852 ;; there's only a closing parenthesis after the point. | |
| 853 (paredit-ignore-sexp-errors (indent-sexp)))) | |
| 854 | |
| 855 ;;;; Comment Insertion | |
| 856 | |
| 857 (defun paredit-semicolon (&optional n) | |
| 858 "Insert a semicolon, moving any code after the point to a new line. | |
| 859 If in a string, comment, or character literal, insert just a literal | |
| 860 semicolon, and do not move anything to the next line. | |
| 861 With a prefix argument N, insert N semicolons." | |
| 862 (interactive "P") | |
| 863 (if (not (or (paredit-in-string-p) | |
| 864 (paredit-in-comment-p) | |
| 865 (paredit-in-char-p) | |
| 866 ;; No more code on the line after the point. | |
| 867 (save-excursion | |
| 868 (paredit-skip-whitespace t (point-at-eol)) | |
| 869 (or (eolp) | |
| 870 ;; Let the user prefix semicolons to existing | |
| 871 ;; comments. | |
| 872 (eq (char-after) ?\;))))) | |
| 873 ;; Don't use NEWLINE-AND-INDENT, because that will delete all of | |
| 874 ;; the horizontal whitespace first, but we just want to move the | |
| 875 ;; code following the point onto the next line while preserving | |
| 876 ;; the point on this line. | |
| 877 ;++ Why indent only the line? | |
| 878 (save-excursion (newline) (lisp-indent-line))) | |
| 879 (insert (make-string (if n (prefix-numeric-value n) 1) | |
| 880 ?\; ))) | |
| 881 | |
| 882 (defun paredit-comment-dwim (&optional arg) | |
| 883 "Call the Lisp comment command you want (Do What I Mean). | |
| 884 This is like `comment-dwim', but it is specialized for Lisp editing. | |
| 885 If transient mark mode is enabled and the mark is active, comment or | |
| 886 uncomment the selected region, depending on whether it was entirely | |
| 887 commented not not already. | |
| 888 If there is already a comment on the current line, with no prefix | |
| 889 argument, indent to that comment; with a prefix argument, kill that | |
| 890 comment. | |
| 891 Otherwise, insert a comment appropriate for the context and ensure that | |
| 892 any code following the comment is moved to the next line. | |
| 893 At the top level, where indentation is calculated to be at column 0, | |
| 894 insert a triple-semicolon comment; within code, where the indentation | |
| 895 is calculated to be non-zero, and on the line there is either no code | |
| 896 at all or code after the point, insert a double-semicolon comment; | |
| 897 and if the point is after all code on the line, insert a single- | |
| 898 semicolon margin comment at `comment-column'." | |
| 899 (interactive "*P") | |
| 900 (require 'newcomment) | |
| 901 (comment-normalize-vars) | |
| 902 (cond ((paredit-region-active-p) | |
| 903 (comment-or-uncomment-region (region-beginning) | |
| 904 (region-end) | |
| 905 arg)) | |
| 906 ((paredit-comment-on-line-p) | |
| 907 (if arg | |
| 908 (comment-kill (if (integerp arg) arg nil)) | |
| 909 (comment-indent))) | |
| 910 (t (paredit-insert-comment)))) | |
| 911 | |
| 912 (defun paredit-comment-on-line-p () | |
| 913 (save-excursion | |
| 914 (beginning-of-line) | |
| 915 (let ((comment-p nil)) | |
| 916 ;; Search forward for a comment beginning. If there is one, set | |
| 917 ;; COMMENT-P to true; if not, it will be nil. | |
| 918 (while (progn (setq comment-p | |
| 919 (search-forward ";" (point-at-eol) | |
| 920 ;; t -> no error | |
| 921 t)) | |
| 922 (and comment-p | |
| 923 (or (paredit-in-string-p) | |
| 924 (paredit-in-char-p (1- (point)))))) | |
| 925 (forward-char)) | |
| 926 comment-p))) | |
| 927 | |
| 928 (defun paredit-insert-comment () | |
| 929 (let ((code-after-p | |
| 930 (save-excursion (paredit-skip-whitespace t (point-at-eol)) | |
| 931 (not (eolp)))) | |
| 932 (code-before-p | |
| 933 (save-excursion (paredit-skip-whitespace nil (point-at-bol)) | |
| 934 (not (bolp))))) | |
| 935 (if (and (bolp) | |
| 936 ;; We have to use EQ 0 here and not ZEROP because ZEROP | |
| 937 ;; signals an error if its argument is non-numeric, but | |
| 938 ;; CALCULATE-LISP-INDENT may return nil. | |
| 939 (eq (let ((indent (calculate-lisp-indent))) | |
| 940 (if (consp indent) | |
| 941 (car indent) | |
| 942 indent)) | |
| 943 0)) | |
| 944 ;; Top-level comment | |
| 945 (progn (if code-after-p (save-excursion (newline))) | |
| 946 (insert ";;; ")) | |
| 947 (if code-after-p | |
| 948 ;; Code comment | |
| 949 (progn (if code-before-p | |
| 950 ;++ Why NEWLINE-AND-INDENT here and not just | |
| 951 ;++ NEWLINE, or PAREDIT-NEWLINE? | |
| 952 (newline-and-indent)) | |
| 953 (lisp-indent-line) | |
| 954 (insert ";; ") | |
| 955 ;; Move the following code. (NEWLINE-AND-INDENT will | |
| 956 ;; delete whitespace after the comment, though, so use | |
| 957 ;; NEWLINE & LISP-INDENT-LINE manually here.) | |
| 958 (save-excursion (newline) | |
| 959 (lisp-indent-line))) | |
| 960 ;; Margin comment | |
| 961 (progn (indent-to comment-column | |
| 962 1) ; 1 -> force one leading space | |
| 963 (insert ?\; )))))) | |
| 964 | |
| 965 ;;;; Character Deletion | |
| 966 | |
| 967 (defun paredit-forward-delete (&optional arg) | |
| 968 "Delete a character forward or move forward over a delimiter. | |
| 969 If on an opening S-expression delimiter, move forward into the | |
| 970 S-expression. | |
| 971 If on a closing S-expression delimiter, refuse to delete unless the | |
| 972 S-expression is empty, in which case delete the whole S-expression. | |
| 973 With a prefix argument, simply delete a character forward, without | |
| 974 regard for delimiter balancing." | |
| 975 (interactive "P") | |
| 976 (cond ((or arg (eobp)) | |
| 977 (delete-char 1)) | |
| 978 ((paredit-in-string-p) | |
| 979 (paredit-forward-delete-in-string)) | |
| 980 ((paredit-in-comment-p) | |
| 981 ;++ What to do here? This could move a partial S-expression | |
| 982 ;++ into a comment and thereby invalidate the file's form, | |
| 983 ;++ or move random text out of a comment. | |
| 984 (delete-char 1)) | |
| 985 ((paredit-in-char-p) ; Escape -- delete both chars. | |
| 986 (backward-delete-char 1) | |
| 987 (delete-char 1)) | |
| 988 ((eq (char-after) ?\\ ) ; ditto | |
| 989 (delete-char 2)) | |
| 990 ((let ((syn (char-syntax (char-after)))) | |
| 991 (or (eq syn ?\( ) | |
| 992 (eq syn ?\" ))) | |
| 993 (forward-char)) | |
| 994 ((and (not (paredit-in-char-p (1- (point)))) | |
| 995 (eq (char-syntax (char-after)) ?\) ) | |
| 996 (eq (char-before) (matching-paren (char-after)))) | |
| 997 (backward-delete-char 1) ; Empty list -- delete both | |
| 998 (delete-char 1)) ; delimiters. | |
| 999 ;; Just delete a single character, if it's not a closing | |
| 1000 ;; parenthesis. (The character literal case is already | |
| 1001 ;; handled by now.) | |
| 1002 ((not (eq (char-syntax (char-after)) ?\) )) | |
| 1003 (delete-char 1)))) | |
| 1004 | |
| 1005 (defun paredit-forward-delete-in-string () | |
| 1006 (let ((start+end (paredit-string-start+end-points))) | |
| 1007 (cond ((not (eq (point) (cdr start+end))) | |
| 1008 ;; If it's not the close-quote, it's safe to delete. But | |
| 1009 ;; first handle the case that we're in a string escape. | |
| 1010 (cond ((paredit-in-string-escape-p) | |
| 1011 ;; We're right after the backslash, so backward | |
| 1012 ;; delete it before deleting the escaped character. | |
| 1013 (backward-delete-char 1)) | |
| 1014 ((eq (char-after) ?\\ ) | |
| 1015 ;; If we're not in a string escape, but we are on a | |
| 1016 ;; backslash, it must start the escape for the next | |
| 1017 ;; character, so delete the backslash before deleting | |
| 1018 ;; the next character. | |
| 1019 (delete-char 1))) | |
| 1020 (delete-char 1)) | |
| 1021 ((eq (1- (point)) (car start+end)) | |
| 1022 ;; If it is the close-quote, delete only if we're also right | |
| 1023 ;; past the open-quote (i.e. it's empty), and then delete | |
| 1024 ;; both quotes. Otherwise we refuse to delete it. | |
| 1025 (backward-delete-char 1) | |
| 1026 (delete-char 1))))) | |
| 1027 | |
| 1028 (defun paredit-backward-delete (&optional arg) | |
| 1029 "Delete a character backward or move backward over a delimiter. | |
| 1030 If on a closing S-expression delimiter, move backward into the | |
| 1031 S-expression. | |
| 1032 If on an opening S-expression delimiter, refuse to delete unless the | |
| 1033 S-expression is empty, in which case delete the whole S-expression. | |
| 1034 With a prefix argument, simply delete a character backward, without | |
| 1035 regard for delimiter balancing." | |
| 1036 (interactive "P") | |
| 1037 (cond ((or arg (bobp)) | |
| 1038 (backward-delete-char 1)) ;++ should this untabify? | |
| 1039 ((paredit-in-string-p) | |
| 1040 (paredit-backward-delete-in-string)) | |
| 1041 ((paredit-in-comment-p) | |
| 1042 (backward-delete-char 1)) | |
| 1043 ((paredit-in-char-p) ; Escape -- delete both chars. | |
| 1044 (backward-delete-char 1) | |
| 1045 (delete-char 1)) | |
| 1046 ((paredit-in-char-p (1- (point))) | |
| 1047 (backward-delete-char 2)) ; ditto | |
| 1048 ((let ((syn (char-syntax (char-before)))) | |
| 1049 (or (eq syn ?\) ) | |
| 1050 (eq syn ?\" ))) | |
| 1051 (backward-char)) | |
| 1052 ((and (eq (char-syntax (char-before)) ?\( ) | |
| 1053 (eq (char-after) (matching-paren (char-before)))) | |
| 1054 (backward-delete-char 1) ; Empty list -- delete both | |
| 1055 (delete-char 1)) ; delimiters. | |
| 1056 ;; Delete it, unless it's an opening parenthesis. The case | |
| 1057 ;; of character literals is already handled by now. | |
| 1058 ((not (eq (char-syntax (char-before)) ?\( )) | |
| 1059 (backward-delete-char-untabify 1)))) | |
| 1060 | |
| 1061 (defun paredit-backward-delete-in-string () | |
| 1062 (let ((start+end (paredit-string-start+end-points))) | |
| 1063 (cond ((not (eq (1- (point)) (car start+end))) | |
| 1064 ;; If it's not the open-quote, it's safe to delete. | |
| 1065 (if (paredit-in-string-escape-p) | |
| 1066 ;; If we're on a string escape, since we're about to | |
| 1067 ;; delete the backslash, we must first delete the | |
| 1068 ;; escaped char. | |
| 1069 (delete-char 1)) | |
| 1070 (backward-delete-char 1) | |
| 1071 (if (paredit-in-string-escape-p) | |
| 1072 ;; If, after deleting a character, we find ourselves in | |
| 1073 ;; a string escape, we must have deleted the escaped | |
| 1074 ;; character, and the backslash is behind the point, so | |
| 1075 ;; backward delete it. | |
| 1076 (backward-delete-char 1))) | |
| 1077 ((eq (point) (cdr start+end)) | |
| 1078 ;; If it is the open-quote, delete only if we're also right | |
| 1079 ;; past the close-quote (i.e. it's empty), and then delete | |
| 1080 ;; both quotes. Otherwise we refuse to delete it. | |
| 1081 (backward-delete-char 1) | |
| 1082 (delete-char 1))))) | |
| 1083 | |
| 1084 ;;;; Killing | |
| 1085 | |
| 1086 (defun paredit-kill (&optional arg) | |
| 1087 "Kill a line as if with `kill-line', but respecting delimiters. | |
| 1088 In a string, act exactly as `kill-line' but do not kill past the | |
| 1089 closing string delimiter. | |
| 1090 On a line with no S-expressions on it starting after the point or | |
| 1091 within a comment, act exactly as `kill-line'. | |
| 1092 Otherwise, kill all S-expressions that start after the point." | |
| 1093 (interactive "P") | |
| 1094 (cond (arg (kill-line)) | |
| 1095 ((paredit-in-string-p) | |
| 1096 (paredit-kill-line-in-string)) | |
| 1097 ((or (paredit-in-comment-p) | |
| 1098 (save-excursion | |
| 1099 (paredit-skip-whitespace t (point-at-eol)) | |
| 1100 (or (eq (char-after) ?\; ) | |
| 1101 (eolp)))) | |
| 1102 ;** Be careful about trailing backslashes. | |
| 1103 (kill-line)) | |
| 1104 (t (paredit-kill-sexps-on-line)))) | |
| 1105 | |
| 1106 (defun paredit-kill-line-in-string () | |
| 1107 (if (save-excursion (paredit-skip-whitespace t (point-at-eol)) | |
| 1108 (eolp)) | |
| 1109 (kill-line) | |
| 1110 (save-excursion | |
| 1111 ;; Be careful not to split an escape sequence. | |
| 1112 (if (paredit-in-string-escape-p) | |
| 1113 (backward-char)) | |
| 1114 (let ((beginning (point))) | |
| 1115 (while (not (or (eolp) | |
| 1116 (eq (char-after) ?\" ))) | |
| 1117 (forward-char) | |
| 1118 ;; Skip past escaped characters. | |
| 1119 (if (eq (char-before) ?\\ ) | |
| 1120 (forward-char))) | |
| 1121 (kill-region beginning (point)))))) | |
| 1122 | |
| 1123 (defun paredit-kill-sexps-on-line () | |
| 1124 (if (paredit-in-char-p) ; Move past the \ and prefix. | |
| 1125 (backward-char 2)) ; (# in Scheme/CL, ? in elisp) | |
| 1126 (let ((beginning (point)) | |
| 1127 (eol (point-at-eol))) | |
| 1128 (let ((end-of-list-p (paredit-forward-sexps-to-kill beginning eol))) | |
| 1129 ;; If we got to the end of the list and it's on the same line, | |
| 1130 ;; move backward past the closing delimiter before killing. (This | |
| 1131 ;; allows something like killing the whitespace in ( ).) | |
| 1132 (if end-of-list-p (progn (up-list) (backward-char))) | |
| 1133 (if kill-whole-line | |
| 1134 (paredit-kill-sexps-on-whole-line beginning) | |
| 1135 (kill-region beginning | |
| 1136 ;; If all of the S-expressions were on one line, | |
| 1137 ;; i.e. we're still on that line after moving past | |
| 1138 ;; the last one, kill the whole line, including | |
| 1139 ;; any comments; otherwise just kill to the end of | |
| 1140 ;; the last S-expression we found. Be sure, | |
| 1141 ;; though, not to kill any closing parentheses. | |
| 1142 (if (and (not end-of-list-p) | |
| 1143 (eq (point-at-eol) eol)) | |
| 1144 eol | |
| 1145 (point))))))) | |
| 1146 | |
| 1147 ;;; Please do not try to understand this code unless you have a VERY | |
| 1148 ;;; good reason to do so. I gave up trying to figure it out well | |
| 1149 ;;; enough to explain it, long ago. | |
| 1150 | |
| 1151 (defun paredit-forward-sexps-to-kill (beginning eol) | |
| 1152 (let ((end-of-list-p nil) | |
| 1153 (firstp t)) | |
| 1154 ;; Move to the end of the last S-expression that started on this | |
| 1155 ;; line, or to the closing delimiter if the last S-expression in | |
| 1156 ;; this list is on the line. | |
| 1157 (catch 'return | |
| 1158 (while t | |
| 1159 ;; This and the `kill-whole-line' business below fix a bug that | |
| 1160 ;; inhibited any S-expression at the very end of the buffer | |
| 1161 ;; (with no trailing newline) from being deleted. It's a | |
| 1162 ;; bizarre fix that I ought to document at some point, but I am | |
| 1163 ;; too busy at the moment to do so. | |
| 1164 (if (and kill-whole-line (eobp)) (throw 'return nil)) | |
| 1165 (save-excursion | |
| 1166 (paredit-handle-sexp-errors (forward-sexp) | |
| 1167 (up-list) | |
| 1168 (setq end-of-list-p (eq (point-at-eol) eol)) | |
| 1169 (throw 'return nil)) | |
| 1170 (if (or (and (not firstp) | |
| 1171 (not kill-whole-line) | |
| 1172 (eobp)) | |
| 1173 (paredit-handle-sexp-errors | |
| 1174 (progn (backward-sexp) nil) | |
| 1175 t) | |
| 1176 (not (eq (point-at-eol) eol))) | |
| 1177 (throw 'return nil))) | |
| 1178 (forward-sexp) | |
| 1179 (if (and firstp | |
| 1180 (not kill-whole-line) | |
| 1181 (eobp)) | |
| 1182 (throw 'return nil)) | |
| 1183 (setq firstp nil))) | |
| 1184 end-of-list-p)) | |
| 1185 | |
| 1186 (defun paredit-kill-sexps-on-whole-line (beginning) | |
| 1187 (kill-region beginning | |
| 1188 (or (save-excursion ; Delete trailing indentation... | |
| 1189 (paredit-skip-whitespace t) | |
| 1190 (and (not (eq (char-after) ?\; )) | |
| 1191 (point))) | |
| 1192 ;; ...or just use the point past the newline, if | |
| 1193 ;; we encounter a comment. | |
| 1194 (point-at-eol))) | |
| 1195 (cond ((save-excursion (paredit-skip-whitespace nil (point-at-bol)) | |
| 1196 (bolp)) | |
| 1197 ;; Nothing but indentation before the point, so indent it. | |
| 1198 (lisp-indent-line)) | |
| 1199 ((eobp) nil) ; Protect the CHAR-SYNTAX below against NIL. | |
| 1200 ;; Insert a space to avoid invalid joining if necessary. | |
| 1201 ((let ((syn-before (char-syntax (char-before))) | |
| 1202 (syn-after (char-syntax (char-after)))) | |
| 1203 (or (and (eq syn-before ?\) ) ; Separate opposing | |
| 1204 (eq syn-after ?\( )) ; parentheses, | |
| 1205 (and (eq syn-before ?\" ) ; string delimiter | |
| 1206 (eq syn-after ?\" )) ; pairs, | |
| 1207 (and (memq syn-before '(?_ ?w)) ; or word or symbol | |
| 1208 (memq syn-after '(?_ ?w))))) ; constituents. | |
| 1209 (insert " ")))) | |
| 1210 | |
| 1211 ;;;;; Killing Words | |
| 1212 | |
| 1213 ;;; This is tricky and asymmetrical because backward parsing is | |
| 1214 ;;; extraordinarily difficult or impossible, so we have to implement | |
| 1215 ;;; killing in both directions by parsing forward. | |
| 1216 | |
| 1217 (defun paredit-forward-kill-word () | |
| 1218 "Kill a word forward, skipping over intervening delimiters." | |
| 1219 (interactive) | |
| 1220 (let ((beginning (point))) | |
| 1221 (skip-syntax-forward " -") | |
| 1222 (let* ((parse-state (paredit-current-parse-state)) | |
| 1223 (state (paredit-kill-word-state parse-state 'char-after))) | |
| 1224 (while (not (or (eobp) | |
| 1225 (eq ?w (char-syntax (char-after))))) | |
| 1226 (setq parse-state | |
| 1227 (progn (forward-char 1) (paredit-current-parse-state)) | |
| 1228 ;; (parse-partial-sexp (point) (1+ (point)) | |
| 1229 ;; nil nil parse-state) | |
| 1230 ) | |
| 1231 (let* ((old-state state) | |
| 1232 (new-state | |
| 1233 (paredit-kill-word-state parse-state 'char-after))) | |
| 1234 (cond ((not (eq old-state new-state)) | |
| 1235 (setq parse-state | |
| 1236 (paredit-kill-word-hack old-state | |
| 1237 new-state | |
| 1238 parse-state)) | |
| 1239 (setq state | |
| 1240 (paredit-kill-word-state parse-state | |
| 1241 'char-after)) | |
| 1242 (setq beginning (point))))))) | |
| 1243 (goto-char beginning) | |
| 1244 (kill-word 1))) | |
| 1245 | |
| 1246 (defun paredit-backward-kill-word () | |
| 1247 "Kill a word backward, skipping over any intervening delimiters." | |
| 1248 (interactive) | |
| 1249 (if (not (or (bobp) | |
| 1250 (eq (char-syntax (char-before)) ?w))) | |
| 1251 (let ((end (point))) | |
| 1252 (backward-word 1) | |
| 1253 (forward-word 1) | |
| 1254 (goto-char (min end (point))) | |
| 1255 (let* ((parse-state (paredit-current-parse-state)) | |
| 1256 (state | |
| 1257 (paredit-kill-word-state parse-state 'char-before))) | |
| 1258 (while (and (< (point) end) | |
| 1259 (progn | |
| 1260 (setq parse-state | |
| 1261 (parse-partial-sexp (point) (1+ (point)) | |
| 1262 nil nil parse-state)) | |
| 1263 (or (eq state | |
| 1264 (paredit-kill-word-state parse-state | |
| 1265 'char-before)) | |
| 1266 (progn (backward-char 1) nil))))) | |
| 1267 (if (and (eq state 'comment) | |
| 1268 (eq ?\# (char-after (point))) | |
| 1269 (eq ?\| (char-before (point)))) | |
| 1270 (backward-char 1))))) | |
| 1271 (backward-kill-word 1)) | |
| 1272 | |
| 1273 ;;; Word-Killing Auxiliaries | |
| 1274 | |
| 1275 (defun paredit-kill-word-state (parse-state adjacent-char-fn) | |
| 1276 (cond ((paredit-in-comment-p parse-state) 'comment) | |
| 1277 ((paredit-in-string-p parse-state) 'string) | |
| 1278 ((memq (char-syntax (funcall adjacent-char-fn)) | |
| 1279 '(?\( ?\) )) | |
| 1280 'delimiter) | |
| 1281 (t 'other))) | |
| 1282 | |
| 1283 ;;; This optionally advances the point past any comment delimiters that | |
| 1284 ;;; should probably not be touched, based on the last state change and | |
| 1285 ;;; the characters around the point. It returns a new parse state, | |
| 1286 ;;; starting from the PARSE-STATE parameter. | |
| 1287 | |
| 1288 (defun paredit-kill-word-hack (old-state new-state parse-state) | |
| 1289 (cond ((and (not (eq old-state 'comment)) | |
| 1290 (not (eq new-state 'comment)) | |
| 1291 (not (paredit-in-string-escape-p)) | |
| 1292 (eq ?\# (char-before)) | |
| 1293 (eq ?\| (char-after))) | |
| 1294 (forward-char 1) | |
| 1295 (paredit-current-parse-state) | |
| 1296 ;; (parse-partial-sexp (point) (1+ (point)) | |
| 1297 ;; nil nil parse-state) | |
| 1298 ) | |
| 1299 ((and (not (eq old-state 'comment)) | |
| 1300 (eq new-state 'comment) | |
| 1301 (eq ?\; (char-before))) | |
| 1302 (skip-chars-forward ";") | |
| 1303 (paredit-current-parse-state) | |
| 1304 ;; (parse-partial-sexp (point) (save-excursion | |
| 1305 ;; (skip-chars-forward ";")) | |
| 1306 ;; nil nil parse-state) | |
| 1307 ) | |
| 1308 (t parse-state))) | |
| 1309 | |
| 1310 ;;;; Cursor and Screen Movement | |
| 1311 | |
| 1312 (eval-and-compile | |
| 1313 (defmacro defun-saving-mark (name bvl doc &rest body) | |
| 1314 `(defun ,name ,bvl | |
| 1315 ,doc | |
| 1316 ,(xcond ((paredit-xemacs-p) | |
| 1317 '(interactive "_")) | |
| 1318 ((paredit-gnu-emacs-p) | |
| 1319 '(interactive))) | |
| 1320 ,@body))) | |
| 1321 | |
| 1322 (defun-saving-mark paredit-forward () | |
| 1323 "Move forward an S-expression, or up an S-expression forward. | |
| 1324 If there are no more S-expressions in this one before the closing | |
| 1325 delimiter, move past that closing delimiter; otherwise, move forward | |
| 1326 past the S-expression following the point." | |
| 1327 (paredit-handle-sexp-errors | |
| 1328 (forward-sexp) | |
| 1329 ;++ Is it necessary to use UP-LIST and not just FORWARD-CHAR? | |
| 1330 (if (paredit-in-string-p) (forward-char) (up-list)))) | |
| 1331 | |
| 1332 (defun-saving-mark paredit-backward () | |
| 1333 "Move backward an S-expression, or up an S-expression backward. | |
| 1334 If there are no more S-expressions in this one before the opening | |
| 1335 delimiter, move past that opening delimiter backward; otherwise, move | |
| 1336 move backward past the S-expression preceding the point." | |
| 1337 (paredit-handle-sexp-errors | |
| 1338 (backward-sexp) | |
| 1339 (if (paredit-in-string-p) (backward-char) (backward-up-list)))) | |
| 1340 | |
| 1341 ;;; Why is this not in lisp.el? | |
| 1342 | |
| 1343 (defun backward-down-list (&optional arg) | |
| 1344 "Move backward and descend into one level of parentheses. | |
| 1345 With ARG, do this that many times. | |
| 1346 A negative argument means move forward but still descend a level." | |
| 1347 (interactive "p") | |
| 1348 (down-list (- (or arg 1)))) | |
| 1349 | |
| 1350 ;;; Thanks to Marco Baringer for suggesting & writing this function. | |
| 1351 | |
| 1352 (defun paredit-recentre-on-sexp (&optional n) | |
| 1353 "Recentre the screen on the S-expression following the point. | |
| 1354 With a prefix argument N, encompass all N S-expressions forward." | |
| 1355 (interactive "P") | |
| 1356 (save-excursion | |
| 1357 (forward-sexp n) | |
| 1358 (let ((end-point (point))) | |
| 1359 (backward-sexp n) | |
| 1360 (let* ((start-point (point)) | |
| 1361 (start-line (count-lines (point-min) (point))) | |
| 1362 (lines-on-sexps (count-lines start-point end-point))) | |
| 1363 (goto-line (+ start-line (/ lines-on-sexps 2))) | |
| 1364 (recenter))))) | |
| 1365 | |
| 1366 ;;;; Depth-Changing Commands: Wrapping, Splicing, & Raising | |
| 1367 | |
| 1368 (defun paredit-wrap-sexp (&optional n open close) | |
| 1369 "Wrap the following S-expression in a list. | |
| 1370 If a prefix argument N is given, wrap N S-expressions. | |
| 1371 Automatically indent the newly wrapped S-expression. | |
| 1372 As a special case, if the point is at the end of a list, simply insert | |
| 1373 a pair of parentheses, rather than insert a lone opening parenthesis | |
| 1374 and then signal an error, in the interest of preserving structure." | |
| 1375 (interactive "P") | |
| 1376 (let ((open (or open ?\()) | |
| 1377 (close (or close ?\)))) | |
| 1378 (paredit-handle-sexp-errors | |
| 1379 (paredit-insert-pair (or n | |
| 1380 (and (not (paredit-region-active-p)) | |
| 1381 1)) | |
| 1382 open close | |
| 1383 'goto-char) | |
| 1384 (insert close) | |
| 1385 (backward-char)) | |
| 1386 (save-excursion (backward-up-list) (indent-sexp)))) | |
| 1387 | |
| 1388 ;;; Thanks to Marco Baringer for the suggestion of a prefix argument | |
| 1389 ;;; for PAREDIT-SPLICE-SEXP. (I, Taylor R. Campbell, however, still | |
| 1390 ;;; implemented it, in case any of you lawyer-folk get confused by the | |
| 1391 ;;; remark in the top of the file about explicitly noting code written | |
| 1392 ;;; by other people.) | |
| 1393 | |
| 1394 (defun paredit-splice-sexp (&optional arg) | |
| 1395 "Splice the list that the point is on by removing its delimiters. | |
| 1396 With a prefix argument as in `C-u', kill all S-expressions backward in | |
| 1397 the current list before splicing all S-expressions forward into the | |
| 1398 enclosing list. | |
| 1399 With two prefix arguments as in `C-u C-u', kill all S-expressions | |
| 1400 forward in the current list before splicing all S-expressions | |
| 1401 backward into the enclosing list. | |
| 1402 With a numerical prefix argument N, kill N S-expressions backward in | |
| 1403 the current list before splicing the remaining S-expressions into the | |
| 1404 enclosing list. If N is negative, kill forward. | |
| 1405 This always creates a new entry on the kill ring." | |
| 1406 (interactive "P") | |
| 1407 (save-excursion | |
| 1408 (paredit-kill-surrounding-sexps-for-splice arg) | |
| 1409 (backward-up-list) ; Go up to the beginning... | |
| 1410 (save-excursion | |
| 1411 (forward-sexp) ; Go forward an expression, to | |
| 1412 (backward-delete-char 1)) ; delete the end delimiter. | |
| 1413 (delete-char 1) ; ...to delete the open char. | |
| 1414 (paredit-ignore-sexp-errors | |
| 1415 (backward-up-list) ; Reindent, now that the | |
| 1416 (indent-sexp)))) ; structure has changed. | |
| 1417 | |
| 1418 (defun paredit-kill-surrounding-sexps-for-splice (arg) | |
| 1419 (cond ((paredit-in-string-p) (error "Splicing illegal in strings.")) | |
| 1420 ((or (not arg) (eq arg 0)) nil) | |
| 1421 ((or (numberp arg) (eq arg '-)) | |
| 1422 ;; Kill ARG S-expressions before/after the point by saving | |
| 1423 ;; the point, moving across them, and killing the region. | |
| 1424 (let* ((arg (if (eq arg '-) -1 arg)) | |
| 1425 (saved (paredit-point-at-sexp-boundary (- arg)))) | |
| 1426 (paredit-ignore-sexp-errors (backward-sexp arg)) | |
| 1427 (kill-region-new saved (point)))) | |
| 1428 ((consp arg) | |
| 1429 (let ((v (car arg))) | |
| 1430 (if (= v 4) ; one prefix argument | |
| 1431 ;; Move backward until we hit the open paren; then | |
| 1432 ;; kill that selected region. | |
| 1433 (let ((end (paredit-point-at-sexp-start))) | |
| 1434 (paredit-ignore-sexp-errors | |
| 1435 (while (not (bobp)) | |
| 1436 (backward-sexp))) | |
| 1437 (kill-region-new (point) end)) | |
| 1438 ;; Move forward until we hit the close paren; then | |
| 1439 ;; kill that selected region. | |
| 1440 (let ((beginning (paredit-point-at-sexp-end))) | |
| 1441 (paredit-ignore-sexp-errors | |
| 1442 (while (not (eobp)) | |
| 1443 (forward-sexp))) | |
| 1444 (kill-region-new beginning (point)))))) | |
| 1445 (t (error "Bizarre prefix argument: %s" arg)))) | |
| 1446 | |
| 1447 (defun paredit-splice-sexp-killing-backward (&optional n) | |
| 1448 "Splice the list the point is on by removing its delimiters, and | |
| 1449 also kill all S-expressions before the point in the current list. | |
| 1450 With a prefix argument N, kill only the preceding N S-expressions." | |
| 1451 (interactive "P") | |
| 1452 (paredit-splice-sexp (if n | |
| 1453 (prefix-numeric-value n) | |
| 1454 '(4)))) | |
| 1455 | |
| 1456 (defun paredit-splice-sexp-killing-forward (&optional n) | |
| 1457 "Splice the list the point is on by removing its delimiters, and | |
| 1458 also kill all S-expressions after the point in the current list. | |
| 1459 With a prefix argument N, kill only the following N S-expressions." | |
| 1460 (interactive "P") | |
| 1461 (paredit-splice-sexp (if n | |
| 1462 (- (prefix-numeric-value n)) | |
| 1463 '(16)))) | |
| 1464 | |
| 1465 (defun paredit-raise-sexp (&optional n) | |
| 1466 "Raise the following S-expression in a tree, deleting its siblings. | |
| 1467 With a prefix argument N, raise the following N S-expressions. If N | |
| 1468 is negative, raise the preceding N S-expressions." | |
| 1469 (interactive "p") | |
| 1470 ;; Select the S-expressions we want to raise in a buffer substring. | |
| 1471 (let* ((bound (save-excursion (forward-sexp n) (point))) | |
| 1472 (sexps (save-excursion ;++ Is this necessary? | |
| 1473 (if (and n (< n 0)) | |
| 1474 (buffer-substring bound | |
| 1475 (paredit-point-at-sexp-end)) | |
| 1476 (buffer-substring (paredit-point-at-sexp-start) | |
| 1477 bound))))) | |
| 1478 ;; Move up to the list we're raising those S-expressions out of and | |
| 1479 ;; delete it. | |
| 1480 (backward-up-list) | |
| 1481 (delete-region (point) (save-excursion (forward-sexp) (point))) | |
| 1482 (save-excursion (insert sexps)) ; Insert & reindent the sexps. | |
| 1483 (save-excursion (let ((n (abs (or n 1)))) | |
| 1484 (while (> n 0) | |
| 1485 (paredit-forward-and-indent) | |
| 1486 (setq n (1- n))))))) | |
| 1487 | |
| 1488 ;;;; Slurpage & Barfage | |
| 1489 | |
| 1490 (defun paredit-forward-slurp-sexp () | |
| 1491 "Add the S-expression following the current list into that list | |
| 1492 by moving the closing delimiter. | |
| 1493 Automatically reindent the newly slurped S-expression with respect to | |
| 1494 its new enclosing form. | |
| 1495 If in a string, move the opening double-quote forward by one | |
| 1496 S-expression and escape any intervening characters as necessary, | |
| 1497 without altering any indentation or formatting." | |
| 1498 (interactive) | |
| 1499 (save-excursion | |
| 1500 (cond ((or (paredit-in-comment-p) | |
| 1501 (paredit-in-char-p)) | |
| 1502 (error "Invalid context for slurpage")) | |
| 1503 ((paredit-in-string-p) | |
| 1504 (paredit-forward-slurp-into-string)) | |
| 1505 (t | |
| 1506 (paredit-forward-slurp-into-list))))) | |
| 1507 | |
| 1508 (defun paredit-forward-slurp-into-list () | |
| 1509 (up-list) ; Up to the end of the list to | |
| 1510 (let ((close (char-before))) ; save and delete the closing | |
| 1511 (backward-delete-char 1) ; delimiter. | |
| 1512 (catch 'return ; Go to the end of the desired | |
| 1513 (while t ; S-expression, going up a | |
| 1514 (paredit-handle-sexp-errors ; list if it's not in this, | |
| 1515 (progn (paredit-forward-and-indent) | |
| 1516 (throw 'return nil)) | |
| 1517 (insert close) | |
| 1518 (up-list) | |
| 1519 (setq close (char-before)) | |
| 1520 (backward-delete-char 1)))) | |
| 1521 (insert close))) ; to insert that delimiter. | |
| 1522 | |
| 1523 (defun paredit-forward-slurp-into-string () | |
| 1524 (goto-char (1+ (cdr (paredit-string-start+end-points)))) | |
| 1525 ;; Signal any errors that we might get first, before mucking with the | |
| 1526 ;; buffer's contents. | |
| 1527 (save-excursion (forward-sexp)) | |
| 1528 (let ((close (char-before))) | |
| 1529 (backward-delete-char 1) | |
| 1530 (paredit-forward-for-quote (save-excursion (forward-sexp) (point))) | |
| 1531 (insert close))) | |
| 1532 | |
| 1533 (defun paredit-forward-barf-sexp () | |
| 1534 "Remove the last S-expression in the current list from that list | |
| 1535 by moving the closing delimiter. | |
| 1536 Automatically reindent the newly barfed S-expression with respect to | |
| 1537 its new enclosing form." | |
| 1538 (interactive) | |
| 1539 (save-excursion | |
| 1540 (up-list) ; Up to the end of the list to | |
| 1541 (let ((close (char-before))) ; save and delete the closing | |
| 1542 (backward-delete-char 1) ; delimiter. | |
| 1543 (paredit-ignore-sexp-errors ; Go back to where we want to | |
| 1544 (backward-sexp)) ; insert the delimiter. | |
| 1545 (paredit-skip-whitespace nil) ; Skip leading whitespace. | |
| 1546 (cond ((bobp) | |
| 1547 (error "Barfing all subexpressions with no open-paren?")) | |
| 1548 ((paredit-in-comment-p) ; Don't put the close-paren in | |
| 1549 (newline-and-indent))) ; a comment. | |
| 1550 (insert close)) | |
| 1551 ;; Reindent all of the newly barfed S-expressions. | |
| 1552 (paredit-forward-and-indent))) | |
| 1553 | |
| 1554 (defun paredit-backward-slurp-sexp () | |
| 1555 "Add the S-expression preceding the current list into that list | |
| 1556 by moving the closing delimiter. | |
| 1557 Automatically reindent the whole form into which new S-expression was | |
| 1558 slurped. | |
| 1559 If in a string, move the opening double-quote backward by one | |
| 1560 S-expression and escape any intervening characters as necessary, | |
| 1561 without altering any indentation or formatting." | |
| 1562 (interactive) | |
| 1563 (save-excursion | |
| 1564 (cond ((or (paredit-in-comment-p) | |
| 1565 (paredit-in-char-p)) | |
| 1566 (error "Invalid context for slurpage")) | |
| 1567 ((paredit-in-string-p) | |
| 1568 (paredit-backward-slurp-into-string)) | |
| 1569 (t | |
| 1570 (paredit-backward-slurp-into-list))))) | |
| 1571 | |
| 1572 (defun paredit-backward-slurp-into-list () | |
| 1573 (backward-up-list) | |
| 1574 (let ((open (char-after))) | |
| 1575 (delete-char 1) | |
| 1576 (catch 'return | |
| 1577 (while t | |
| 1578 (paredit-handle-sexp-errors | |
| 1579 (progn (backward-sexp) | |
| 1580 (throw 'return nil)) | |
| 1581 (insert open) | |
| 1582 (backward-char 1) | |
| 1583 (backward-up-list) | |
| 1584 (setq open (char-after)) | |
| 1585 (delete-char 1)))) | |
| 1586 (insert open)) | |
| 1587 ;; Reindent the line at the beginning of wherever we inserted the | |
| 1588 ;; opening parenthesis, and then indent the whole S-expression. | |
| 1589 (backward-up-list) | |
| 1590 (lisp-indent-line) | |
| 1591 (indent-sexp)) | |
| 1592 | |
| 1593 (defun paredit-backward-slurp-into-string () | |
| 1594 (goto-char (car (paredit-string-start+end-points))) | |
| 1595 ;; Signal any errors that we might get first, before mucking with the | |
| 1596 ;; buffer's contents. | |
| 1597 (save-excursion (backward-sexp)) | |
| 1598 (let ((open (char-after)) | |
| 1599 (target (point))) | |
| 1600 (message "open = %S" open) | |
| 1601 (delete-char 1) | |
| 1602 (backward-sexp) | |
| 1603 (insert open) | |
| 1604 (paredit-forward-for-quote target))) | |
| 1605 | |
| 1606 (defun paredit-backward-barf-sexp () | |
| 1607 "Remove the first S-expression in the current list from that list | |
| 1608 by moving the closing delimiter. | |
| 1609 Automatically reindent the barfed S-expression and the form from which | |
| 1610 it was barfed." | |
| 1611 (interactive) | |
| 1612 (save-excursion | |
| 1613 (backward-up-list) | |
| 1614 (let ((open (char-after))) | |
| 1615 (delete-char 1) | |
| 1616 (paredit-ignore-sexp-errors | |
| 1617 (paredit-forward-and-indent)) | |
| 1618 (while (progn (paredit-skip-whitespace t) | |
| 1619 (eq (char-after) ?\; )) | |
| 1620 (forward-line 1)) | |
| 1621 (if (eobp) | |
| 1622 (error | |
| 1623 "Barfing all subexpressions with no close-paren?")) | |
| 1624 ;** Don't use `insert' here. Consider, e.g., barfing from | |
| 1625 ;** (foo|) | |
| 1626 ;** and how `save-excursion' works. | |
| 1627 (insert-before-markers open)) | |
| 1628 (backward-up-list) | |
| 1629 (lisp-indent-line) | |
| 1630 (indent-sexp))) | |
| 1631 | |
| 1632 ;;;; Splitting & Joining | |
| 1633 | |
| 1634 (defun paredit-split-sexp () | |
| 1635 "Split the list or string the point is on into two." | |
| 1636 (interactive) | |
| 1637 (cond ((paredit-in-string-p) | |
| 1638 (insert "\"") | |
| 1639 (save-excursion (insert " \""))) | |
| 1640 ((or (paredit-in-comment-p) | |
| 1641 (paredit-in-char-p)) | |
| 1642 (error "Invalid context for `paredit-split-sexp'")) | |
| 1643 (t (let ((open (save-excursion (backward-up-list) | |
| 1644 (char-after))) | |
| 1645 (close (save-excursion (up-list) | |
| 1646 (char-before)))) | |
| 1647 (delete-horizontal-space) | |
| 1648 (insert close) | |
| 1649 (save-excursion (insert ?\ ) | |
| 1650 (insert open) | |
| 1651 (backward-char) | |
| 1652 (indent-sexp)))))) | |
| 1653 | |
| 1654 (defun paredit-join-sexps () | |
| 1655 "Join the S-expressions adjacent on either side of the point. | |
| 1656 Both must be lists, strings, or atoms; error if there is a mismatch." | |
| 1657 (interactive) | |
| 1658 ;++ How ought this to handle comments intervening symbols or strings? | |
| 1659 (save-excursion | |
| 1660 (if (or (paredit-in-comment-p) | |
| 1661 (paredit-in-string-p) | |
| 1662 (paredit-in-char-p)) | |
| 1663 (error "Invalid context in which to join S-expressions.") | |
| 1664 (let ((left-point (save-excursion (paredit-point-at-sexp-end))) | |
| 1665 (right-point (save-excursion | |
| 1666 (paredit-point-at-sexp-start)))) | |
| 1667 (let ((left-char (char-before left-point)) | |
| 1668 (right-char (char-after right-point))) | |
| 1669 (let ((left-syntax (char-syntax left-char)) | |
| 1670 (right-syntax (char-syntax right-char))) | |
| 1671 (cond ((>= left-point right-point) | |
| 1672 (error "Can't join a datum with itself.")) | |
| 1673 ((and (eq left-syntax ?\) ) | |
| 1674 (eq right-syntax ?\( ) | |
| 1675 (eq left-char (matching-paren right-char)) | |
| 1676 (eq right-char (matching-paren left-char))) | |
| 1677 ;; Leave intermediate formatting alone. | |
| 1678 (goto-char right-point) | |
| 1679 (delete-char 1) | |
| 1680 (goto-char left-point) | |
| 1681 (backward-delete-char 1) | |
| 1682 (backward-up-list) | |
| 1683 (indent-sexp)) | |
| 1684 ((and (eq left-syntax ?\" ) | |
| 1685 (eq right-syntax ?\" )) | |
| 1686 ;; Delete any intermediate formatting. | |
| 1687 (delete-region (1- left-point) | |
| 1688 (1+ right-point))) | |
| 1689 ((and (memq left-syntax '(?w ?_)) ; Word or symbol | |
| 1690 (memq right-syntax '(?w ?_))) | |
| 1691 (delete-region left-point right-point)) | |
| 1692 (t | |
| 1693 (error "Mismatched S-expressions to join."))))))))) | |
| 1694 | |
| 1695 ;;;; Utilities | |
| 1696 | |
| 1697 (defun paredit-in-string-escape-p () | |
| 1698 "True if the point is on a character escape of a string. | |
| 1699 This is true only if the character is preceded by an odd number of | |
| 1700 backslashes. | |
| 1701 This assumes that `paredit-in-string-p' has already returned true." | |
| 1702 (let ((oddp nil)) | |
| 1703 (save-excursion | |
| 1704 (while (eq (char-before) ?\\ ) | |
| 1705 (setq oddp (not oddp)) | |
| 1706 (backward-char))) | |
| 1707 oddp)) | |
| 1708 | |
| 1709 (defun paredit-in-char-p (&optional arg) | |
| 1710 "True if the point is immediately after a character literal. | |
| 1711 A preceding escape character, not preceded by another escape character, | |
| 1712 is considered a character literal prefix. (This works for elisp, | |
| 1713 Common Lisp, and Scheme.) | |
| 1714 Assumes that `paredit-in-string-p' is false, so that it need not handle | |
| 1715 long sequences of preceding backslashes in string escapes. (This | |
| 1716 assumes some other leading character token -- ? in elisp, # in Scheme | |
| 1717 and Common Lisp.)" | |
| 1718 (let ((arg (or arg (point)))) | |
| 1719 (and (eq (char-before arg) ?\\ ) | |
| 1720 (not (eq (char-before (1- arg)) ?\\ ))))) | |
| 1721 | |
| 1722 (defun paredit-forward-and-indent () | |
| 1723 "Move forward an S-expression, indenting it fully. | |
| 1724 Indent with `lisp-indent-line' and then `indent-sexp'." | |
| 1725 (forward-sexp) ; Go forward, and then find the | |
| 1726 (save-excursion ; beginning of this next | |
| 1727 (backward-sexp) ; S-expression. | |
| 1728 (lisp-indent-line) ; Indent its opening line, and | |
| 1729 (indent-sexp))) ; the rest of it. | |
| 1730 | |
| 1731 (defun paredit-skip-whitespace (trailing-p &optional limit) | |
| 1732 "Skip past any whitespace, or until the point LIMIT is reached. | |
| 1733 If TRAILING-P is nil, skip leading whitespace; otherwise, skip trailing | |
| 1734 whitespace." | |
| 1735 (funcall (if trailing-p 'skip-chars-forward 'skip-chars-backward) | |
| 1736 " \t\n " ; This should skip using the syntax table, but LF | |
| 1737 limit)) ; is a comment end, not newline, in Lisp mode. | |
| 1738 | |
| 1739 (defalias 'paredit-region-active-p | |
| 1740 (xcond ((paredit-xemacs-p) 'region-active-p) | |
| 1741 ((paredit-gnu-emacs-p) | |
| 1742 (lambda () | |
| 1743 (and mark-active transient-mark-mode))))) | |
| 1744 | |
| 1745 (defun kill-region-new (start end) | |
| 1746 "Kill the region between START and END. | |
| 1747 Do not append to any current kill, and | |
| 1748 do not let the next kill append to this one." | |
| 1749 (interactive "r") ;Eh, why not? | |
| 1750 ;; KILL-REGION sets THIS-COMMAND to tell the next kill that the last | |
| 1751 ;; command was a kill. It also checks LAST-COMMAND to see whether it | |
| 1752 ;; should append. If we bind these locally, any modifications to | |
| 1753 ;; THIS-COMMAND will be masked, and it will not see LAST-COMMAND to | |
| 1754 ;; indicate that it should append. | |
| 1755 (let ((this-command nil) | |
| 1756 (last-command nil)) | |
| 1757 (kill-region start end))) | |
| 1758 | |
| 1759 ;;;;; S-expression Parsing Utilities | |
| 1760 | |
| 1761 ;++ These routines redundantly traverse S-expressions a great deal. | |
| 1762 ;++ If performance issues arise, this whole section will probably have | |
| 1763 ;++ to be refactored to preserve the state longer, like paredit.scm | |
| 1764 ;++ does, rather than to traverse the definition N times for every key | |
| 1765 ;++ stroke as it presently does. | |
| 1766 | |
| 1767 (defun paredit-current-parse-state () | |
| 1768 "Return parse state of point from beginning of defun." | |
| 1769 (let ((point (point))) | |
| 1770 (beginning-of-defun) | |
| 1771 ;; Calling PARSE-PARTIAL-SEXP will advance the point to its second | |
| 1772 ;; argument (unless parsing stops due to an error, but we assume it | |
| 1773 ;; won't in paredit-mode). | |
| 1774 (parse-partial-sexp (point) point))) | |
| 1775 | |
| 1776 (defun paredit-in-string-p (&optional state) | |
| 1777 "True if the parse state is within a double-quote-delimited string. | |
| 1778 If no parse state is supplied, compute one from the beginning of the | |
| 1779 defun to the point." | |
| 1780 ;; 3. non-nil if inside a string (the terminator character, really) | |
| 1781 (and (nth 3 (or state (paredit-current-parse-state))) | |
| 1782 t)) | |
| 1783 | |
| 1784 (defun paredit-string-start+end-points (&optional state) | |
| 1785 "Return a cons of the points of open and close quotes of the string. | |
| 1786 The string is determined from the parse state STATE, or the parse state | |
| 1787 from the beginning of the defun to the point. | |
| 1788 This assumes that `paredit-in-string-p' has already returned true, i.e. | |
| 1789 that the point is already within a string." | |
| 1790 (save-excursion | |
| 1791 ;; 8. character address of start of comment or string; nil if not | |
| 1792 ;; in one | |
| 1793 (let ((start (nth 8 (or state (paredit-current-parse-state))))) | |
| 1794 (goto-char start) | |
| 1795 (forward-sexp 1) | |
| 1796 (cons start (1- (point)))))) | |
| 1797 | |
| 1798 (defun paredit-in-comment-p (&optional state) | |
| 1799 "True if parse state STATE is within a comment. | |
| 1800 If no parse state is supplied, compute one from the beginning of the | |
| 1801 defun to the point." | |
| 1802 ;; 4. nil if outside a comment, t if inside a non-nestable comment, | |
| 1803 ;; else an integer (the current comment nesting) | |
| 1804 (and (nth 4 (or state (paredit-current-parse-state))) | |
| 1805 t)) | |
| 1806 | |
| 1807 (defun paredit-point-at-sexp-boundary (n) | |
| 1808 (cond ((< n 0) (paredit-point-at-sexp-start)) | |
| 1809 ((= n 0) (point)) | |
| 1810 ((> n 0) (paredit-point-at-sexp-end)))) | |
| 1811 | |
| 1812 (defun paredit-point-at-sexp-start () | |
| 1813 (forward-sexp) | |
| 1814 (backward-sexp) | |
| 1815 (point)) | |
| 1816 | |
| 1817 (defun paredit-point-at-sexp-end () | |
| 1818 (backward-sexp) | |
| 1819 (forward-sexp) | |
| 1820 (point)) | |
| 1821 | |
| 1822 ;;;; Initialization | |
| 1823 | |
| 1824 (paredit-define-keys) | |
| 1825 (paredit-annotate-mode-with-examples) | |
| 1826 (paredit-annotate-functions-with-examples) | |
| 1827 | |
| 1828 (provide 'paredit) |