diff options
| -rw-r--r-- | paredit.el | 809 |
1 files changed, 493 insertions, 316 deletions
@@ -1,7 +1,7 @@ ;;; -*- Mode: Emacs-Lisp; outline-regexp: " \n;;;;+" -*- ;;;;;; Paredit: Parenthesis-Editing Minor Mode -;;;;;; Version 19 +;;;;;; Version 20 ;;; This code is written by Taylor R. Campbell (except where explicitly ;;; noted) and placed in the Public Domain. All warranties are @@ -22,22 +22,12 @@ ;;; (eval-after-load 'paredit ;;; '(progn ...redefine keys, &c....)) ;;; -;;; The REPL of SLIME (the Superior Lisp Interaction Mode for Emacs, -;;; <http://common-lisp.net/projects/slime/>) requires a binding that -;;; paredit mode overrides, namely RET, which paredit mode defines to -;;; have fancy newline-and-indent behaviour, and which SLIME's REPL -;;; mode defines to send a REPL input. A simple workaround is to -;;; undefine RET in paredit's keymap and to define it in all keymaps -;;; where you want to use it, but which SLIME can override; e.g., -;;; -;;; (define-key paredit-mode-map (kbd "RET") nil) -;;; (define-key lisp-mode-shared-map (kbd "RET") 'paredit-newline) -;;; -;;; This is written for GNU Emacs. It is known not to work in XEmacs -;;; in ways that the author is not willing to spend time kludging over -;;; with compatibility workarounds. The author wrote it with GNU Emacs -;;; 22.0.50; it may work in slightly earlier versions, but not older -;;; than 21 or so. +;;; This should run in GNU Emacs 21 or later and XEmacs 21.5 or later. +;;; It is highly unlikely to work in earlier versions of GNU Emacs, and +;;; it may have obscure problems in earlier versions of XEmacs due to +;;; the way its syntax parser reports conditions, as a result of which +;;; the code that uses the syntax parser must mask *all* error +;;; conditions, not just those generated by the syntax parser. ;;; This mode changes the keybindings for a number of simple keys, ;;; notably (, ), ", \, and ;. The bracket keys (round or square) are @@ -66,15 +56,18 @@ ;;; (define-key paredit-mode-map (kbd "M-)") ;;; 'paredit-close-parenthesis-and-newline) ;;; -;;; Paredit also changes several standard editing keybindings including -;;; RET, C-j, C-d, DEL, & C-k. RET & C-j are transposed from their -;;; usual paired meaning, where RET inserts a newline and C-j fancily -;;; adds a new line with indentation &c., but I find the transposition -;;; more convenient. (You are free to change this, of course.) C-d, -;;; DEL, & C-k are instrumented to respect the S-expression structure. -;;; You can, however, pass a prefix argument to them to get their -;;; usual behaviour if necessary; e.g., C-u C-k will kill the whole -;;; line, regardless of what S-expression structure there is on it. +;;; Paredit also changes the bindings of keys for deleting and killing, +;;; so that they will not destroy any S-expression structure by killing +;;; or deleting only one side of a bracket or quote pair. If the point +;;; is on a closing bracket, DEL will move left over it; if it is on an +;;; opening bracket, C-d will move right over it. Only if the point is +;;; between a pair of brackets will C-d or DEL delete them, and in that +;;; case it will delete both simultaneously. M-d and M-DEL kill words, +;;; but skip over any S-expression structure. C-k kills from the start +;;; of the line, either to the line's end, if it contains only balanced +;;; expressions; to the first closing bracket, if the point is within a +;;; form that ends on the line; or up to the end of the last expression +;;; that starts on the line after the point. ;;; ;;; Automatic reindentation is performed as locally as possible, to ;;; ensure that Emacs does not interfere with custom indentation used @@ -95,7 +88,56 @@ ;;; This assumes Unix-style LF line endings. -(defconst paredit-version 19) +(defconst paredit-version 20) + +(eval-and-compile + + (defun paredit-xemacs-p () + ;; No idea I got this definition from. Edward O'Connor (hober on + ;; IRC) suggested the current definition. + ;; (and (boundp 'running-xemacs) + ;; running-xemacs) + (featurep 'xemacs)) + + (defun paredit-gnu-emacs-p () + (not (paredit-xemacs-p))) + + (defmacro xcond (&rest clauses) + "Exhaustive COND. +Signal an error if no clause matches." + `(cond ,@clauses + (t (error "XCOND lost.")))) + + (defalias 'paredit-warn (if (fboundp 'warn) 'warn 'message)) + + (defvar paredit-sexp-error-type + (with-temp-buffer + (insert "(") + (condition-case condition + (backward-sexp) + (error (if (eq (car condition) 'error) + (paredit-warn "%s%s%s%s" + "Paredit is unable to discriminate" + " S-expression parse errors from" + " other errors. " + " This may cause obscure problems. " + " Please upgrade Emacs.")) + (car condition))))) + + (defmacro paredit-handle-sexp-errors (body &rest handler) + `(condition-case () + ,body + (,paredit-sexp-error-type ,@handler))) + + (put 'paredit-handle-sexp-errors 'lisp-indent-function 1) + + (defmacro paredit-ignore-sexp-errors (&rest body) + `(paredit-handle-sexp-errors (progn ,@body) + nil)) + + (put 'paredit-ignore-sexp-errors 'lisp-indent-function 0) + + nil) ;;;; Minor Mode Definition @@ -110,12 +152,17 @@ ;; DEFINE-MINOR-MODE inserts will have already set PAREDIT-MODE to ;; true. If this is the case, then first check the parentheses, and ;; if there are any imbalanced ones we must inhibit the activation of - ;; paredit mode. - (if paredit-mode - (condition-case condition - (check-parens) - (error (setq paredit-mode nil) - (signal (car condition) (cdr condition)))))) + ;; paredit mode. We skip the check, though, if the user supplied a + ;; prefix argument interactively. + (if (and paredit-mode + (not current-prefix-arg)) + (if (not (fboundp 'check-parens)) + (paredit-warn "`check-parens' is not defined; %s" + "be careful of malformed S-expressions.") + (condition-case condition + (check-parens) + (error (setq paredit-mode nil) + (signal (car condition) (cdr condition))))))) ;;; Old functions from when there was a different mode for emacs -nw. @@ -132,6 +179,14 @@ Deprecated: use `paredit-mode' instead." Deprecated: use `paredit-mode' instead." (interactive) (paredit-mode -1)) + +(defvar paredit-backward-delete-key + (xcond ((paredit-xemacs-p) "BS") + ((paredit-gnu-emacs-p) "DEL"))) + +(defvar paredit-forward-delete-keys + (xcond ((paredit-xemacs-p) '("DEL")) + ((paredit-gnu-emacs-p) '("<delete>" "<deletechar>")))) ;;;; Paredit Keys @@ -208,17 +263,14 @@ Deprecated: use `paredit-mode' instead." ("|(defun hello-world ...)" ";;; |\n(defun hello-world ...)")) - ;; Unconventional, but I prefer C-j & RET this way, and you can - ;; change it if you want anyway. - ("RET" paredit-newline + ("C-j" paredit-newline ("(let ((n (frobbotz))) |(display (+ n 1)\nport))" ,(concat "(let ((n (frobbotz)))" "\n |(display (+ n 1)" "\n port))"))) - ("C-j" newline) "Deleting & Killing" - (("C-d" "<deletechar>") + (("C-d" ,@paredit-forward-delete-keys) paredit-forward-delete ("(quu|x \"zot\")" "(quu| \"zot\")") ("(quux |\"zot\")" @@ -226,7 +278,8 @@ Deprecated: use `paredit-mode' instead." "(quux \"|ot\")") ("(foo (|) bar)" "(foo | bar)") ("|(foo bar)" "(|foo bar)")) - ("DEL" paredit-backward-delete + (,paredit-backward-delete-key + paredit-backward-delete ("(\"zot\" q|uux)" "(\"zot\" |uux)") ("(\"zot\"| quux)" "(\"zot|\" quux)" @@ -250,7 +303,8 @@ Deprecated: use `paredit-mode' instead." (";;;| Frobnicate\n(defun frobnicate ...)" ";;;|\n(defun frobnicate ...)" ";;;\n(| frobnicate ...)")) - ("M-DEL" paredit-backward-kill-word + (,(concat "M-" paredit-backward-delete-key) + paredit-backward-kill-word ("(foo bar) ; baz\n(quux)|" "(foo bar) ; baz\n(|)" "(foo bar) ; |\n()" @@ -281,11 +335,11 @@ Deprecated: use `paredit-mode' instead." ("M-s" paredit-splice-sexp ("(foo (bar| baz) quux)" "(foo bar| baz quux)")) - (("<M-up>" "ESC M-O A") + (("M-<up>" "ESC <up>") paredit-splice-sexp-killing-backward ("(foo (let ((x 5)) |(sqrt n)) bar)" "(foo (sqrt n) bar)")) - (("<M-down>" "ESC M-O B") + (("M-<down>" "ESC <down>") paredit-splice-sexp-killing-forward ("(a (b c| d e) f)" "(a b c f)")) @@ -295,23 +349,23 @@ Deprecated: use `paredit-mode' instead." "|body")) "Barfage & Slurpage" - (("C-)" "<M-right>" "ESC <right>" "ESC M-O C") + (("C-)" "C-<right>") paredit-forward-slurp-sexp ("(foo (bar |baz) quux zot)" "(foo (bar |baz quux) zot)") ("(a b ((c| d)) e f)" "(a b ((c| d) e) f)")) - (("C-}" "<M-left>" "ESC <left>" "ESC M-O D") + (("C-}" "C-<left>") paredit-forward-barf-sexp ("(foo (bar |baz quux) zot)" "(foo (bar |baz) quux zot)")) - (("C-(" "<C-M-left>" "ESC <C-left>" "ESC M-O d") + (("C-(" "C-M-<left>" "ESC C-<left>") paredit-backward-slurp-sexp ("(foo bar (baz| quux) zot)" "(foo (bar baz| quux) zot)") ("(a b ((c| d)) e f)" "(a (b (c| d)) e f)")) - (("C-{" "<C-M-right>" "ESC <C-right>" "ESC M-O c") + (("C-{" "C-M-<right>" "ESC C-<right>") paredit-backward-barf-sexp ("(foo (bar baz |quux) zot)" "(foo bar (baz |quux) zot)")) @@ -335,9 +389,7 @@ Deprecated: use `paredit-mode' instead." ;;;;; Command Examples -; (put 'paredit-do-commands 'lisp-indent-function 2) - -(eval-when-compile +(eval-and-compile (defmacro paredit-do-commands (vars string-case &rest body) (let ((spec (nth 0 vars)) (keys (nth 1 vars)) @@ -346,14 +398,16 @@ Deprecated: use `paredit-mode' instead." `(dolist (,spec paredit-commands) (if (stringp ,spec) ,string-case - (let ((,keys (let ((k (car spec))) + (let ((,keys (let ((k (car ,spec))) (cond ((stringp k) (list k)) ((listp k) k) (t (error "Invalid paredit command %s." ,spec))))) - (,fn (cadr spec)) - (,examples (cddr spec))) - ,@body)))))) + (,fn (cadr ,spec)) + (,examples (cddr ,spec))) + ,@body))))) + + (put 'paredit-do-commands 'lisp-indent-function 2)) (defun paredit-define-keys () (paredit-do-commands (spec keys fn examples) @@ -390,7 +444,7 @@ Deprecated: use `paredit-mode' instead." "\n (no examples)\n")) contents)))) (put 'paredit-mode 'function-documentation - (apply #'concat (reverse contents)))) + (apply 'concat (reverse contents)))) ;; PUT returns the huge string we just constructed, which we don't ;; want it to return. nil) @@ -418,28 +472,17 @@ Deprecated: use `paredit-mode' instead." (let ((insert-lines (lambda (&rest lines) (mapc (lambda (line) (insert line) (newline)) lines))) - (html-keys - (lambda (keys) - (mapconcat (lambda (key) - (if (and (eq (elt key 0) ?\<) - (eq (elt key (- (length key) - 1)) - ?\>)) - (substring key 1 (- (length key) 1)) - key)) - keys - ", "))) + (html-keys (lambda (keys) + (mapconcat 'paredit-html-quote keys ", "))) (html-example (lambda (example) - (concat "<table><td><table>" - "<tr><td><pre>" - (mapconcat 'identity + (concat "<table><tr><td><pre>" + (mapconcat 'paredit-html-quote example (concat "</pre></td></tr><tr><td>" " --->" "</td></tr><tr><td><pre>")) - "</pre></td></tr>" - "</table></td></table>"))) + "</pre></td></tr></table>"))) (firstp t)) (paredit-do-commands (spec keys fn examples) (progn (if (not firstp) @@ -469,15 +512,28 @@ Deprecated: use `paredit-mode' instead." "</td>") " </tr>"))))) (insert "</table>\n")) + +(defun paredit-html-quote (string) + (with-temp-buffer + (dotimes (i (length string)) + (insert (let ((c (elt string i))) + (cond ((eq c ?\<) "<") + ((eq c ?\>) ">") + ((eq c ?\&) "&") + ((eq c ?\') "'") + ((eq c ?\") """) + (t c))))) + (buffer-string))) ;;;; Delimiter Insertion -(eval-when-compile - (defun paredit-name (&rest strings) +(eval-and-compile + (defun paredit-conc-name (&rest strings) (intern (apply 'concat strings))) + (defmacro define-paredit-pair (open close name) `(progn - (defun ,(paredit-name "paredit-open-" name) (&optional n) + (defun ,(paredit-conc-name "paredit-open-" name) (&optional n) ,(concat "Insert a balanced " name " pair. With a prefix argument N, put the closing " name " after N S-expressions forward. @@ -493,7 +549,7 @@ If in a character literal, do nothing. This prevents changing what was (insert ,open)) ((not (paredit-in-char-p)) (paredit-insert-pair n ,open ,close 'goto-char)))) - (defun ,(paredit-name "paredit-close-" name) () + (defun ,(paredit-conc-name "paredit-close-" name) () ,(concat "Move past one closing delimiter and reindent. \(Agnostic to the specific closing delimiter.) If in a string or comment, insert a single closing " name ". @@ -501,7 +557,7 @@ If in a character literal, do nothing. This prevents changing what was in the character literal to a meaningful delimiter unintentionally.") (interactive) (paredit-move-past-close ,close)) - (defun ,(paredit-name "paredit-close-" name "-and-newline") () + (defun ,(paredit-conc-name "paredit-close-" name "-and-newline") () ,(concat "Move past one closing delimiter, add a newline," " and reindent. If there was a margin comment after the closing delimiter, preserve it @@ -537,8 +593,7 @@ If there was a margin comment after the closing delimiter, preserve it (indent-to (cdr comment.point)) (insert (car comment.point))))) (lisp-indent-line) - (condition-case () (indent-sexp) - (scan-error nil)) + (paredit-ignore-sexp-errors (indent-sexp)) (paredit-blink-paren-match t)))) (defun paredit-find-comment-on-line () @@ -570,14 +625,15 @@ If such a comment exists, delete the comment (including all leading (not n) (prog1 (region-end) (goto-char (region-beginning)))))) - (if (or n regionp) (paredit-skip-whitespace t)) (let ((spacep (paredit-space-for-delimiter-p nil open))) (if spacep (insert " ")) (insert open) (save-excursion ;; Move past the desired region. - (cond (n (funcall forward (save-excursion (forward-sexp n) - (point)))) + (cond (n (funcall forward + (save-excursion + (forward-sexp (prefix-numeric-value n)) + (point)))) (regionp (funcall forward (+ end (if spacep 2 1))))) (insert close) (if (paredit-space-for-delimiter-p t close) @@ -650,16 +706,17 @@ If such a comment exists, delete the comment (including all leading (not (paredit-in-char-p (1- (point)))))) (backward-delete-char 1)))) -(defun paredit-blink-paren-match (absolutely-p) - (if (or absolutely-p blink-matching-paren) - (condition-case () - (save-excursion - (backward-sexp) - (forward-sexp) - (let ((blink-matching-paren-on-screen t) - (show-paren-mode nil)) - (blink-matching-open))) - (scan-error nil)))) +(defun paredit-blink-paren-match (another-line-p) + (if (and blink-matching-paren + (or (not show-paren-mode) another-line-p)) + (paredit-ignore-sexp-errors + (save-excursion + (backward-sexp) + (forward-sexp) + ;; SHOW-PAREN-MODE inhibits any blinking, so we disable it + ;; locally here. + (let ((show-paren-mode nil)) + (blink-matching-open)))))) (defun paredit-doublequote (&optional n) "Insert a pair of double-quotes. @@ -692,15 +749,16 @@ If not in a string, act as `paredit-doublequote'; if no prefix argument is specified and the region is not active or `transient-mark-mode' is disabled, the default is to wrap one S-expression, however, not zero." - (interactive "p") + (interactive "P") (if (not (paredit-in-string-p)) - (paredit-doublequote (or n 1)) + (paredit-doublequote (or n + (and (not (paredit-region-active-p)) + 1))) (let ((start+end (paredit-string-start+end-points))) (goto-char (1+ (cdr start+end))) (newline) (lisp-indent-line) - (condition-case () (indent-sexp) - (scan-error nil))))) + (paredit-ignore-sexp-errors (indent-sexp))))) (defun paredit-forward-for-quote (end) (let ((state (paredit-current-parse-state))) @@ -746,7 +804,7 @@ If not in a string, act as `paredit-doublequote'; if no prefix argument (not (paredit-in-comment-p))) (let ((delp t)) (unwind-protect (setq delp - (call-interactively #'paredit-escape)) + (call-interactively 'paredit-escape)) ;; We need this in an UNWIND-PROTECT so that the backlash is ;; left in there *only* if PAREDIT-ESCAPE return NIL normally ;; -- in any other case, such as the user hitting C-g or an @@ -785,8 +843,7 @@ If in a string, just insert a literal newline." (newline-and-indent) ;; Indent the following S-expression, but don't signal an error if ;; there's only a closing parenthesis after the point. - (condition-case () (indent-sexp) - (scan-error nil)))) + (paredit-ignore-sexp-errors (indent-sexp)))) ;;;; Comment Insertion @@ -833,6 +890,7 @@ At the top level, where indentation is calculated to be at column 0, and if the point is after all code on the line, insert a single- semicolon margin comment at `comment-column'." (interactive "*P") + (require 'newcomment) (comment-normalize-vars) (cond ((paredit-region-active-p) (comment-or-uncomment-region (region-beginning) @@ -1077,29 +1135,45 @@ Otherwise, kill all S-expressions that start after the point." (if (and (not end-of-list-p) (eq (point-at-eol) eol)) eol - (point))))))) + (point))))))) +;;; Please do not try to understand this code unless you have a VERY +;;; good reason to do so. I gave up trying to figure it out well +;;; enough to explain it, long ago. + (defun paredit-forward-sexps-to-kill (beginning eol) - (let ((end-of-list-p nil)) + (let ((end-of-list-p nil) + (firstp t)) ;; Move to the end of the last S-expression that started on this ;; line, or to the closing delimiter if the last S-expression in ;; this list is on the line. (catch 'return (while t + ;; This and the `kill-whole-line' business below fix a bug that + ;; inhibited any S-expression at the very end of the buffer + ;; (with no trailing newline) from being deleted. It's a + ;; bizarre fix that I ought to document at some point, but I am + ;; too busy at the moment to do so. + (if (and kill-whole-line (eobp)) (throw 'return nil)) (save-excursion - (condition-case () - (forward-sexp) - (scan-error - (up-list) - (setq end-of-list-p (eq (point-at-eol) eol)) - (throw 'return nil))) - (if (or (eobp) - (not (condition-case () - (progn (backward-sexp) t) - (scan-error nil))) + (paredit-handle-sexp-errors (forward-sexp) + (up-list) + (setq end-of-list-p (eq (point-at-eol) eol)) + (throw 'return nil)) + (if (or (and (not firstp) + (not kill-whole-line) + (eobp)) + (paredit-handle-sexp-errors + (progn (backward-sexp) nil) + t) (not (eq (point-at-eol) eol))) (throw 'return nil))) - (forward-sexp))) + (forward-sexp) + (if (and firstp + (not kill-whole-line) + (eobp)) + (throw 'return nil)) + (setq firstp nil))) end-of-list-p)) (defun paredit-kill-sexps-on-whole-line (beginning) @@ -1127,106 +1201,135 @@ Otherwise, kill all S-expressions that start after the point." (memq syn-after '(?_ ?w))))) ; constituents. (insert " ")))) +;;;;; Killing Words + +;;; This is tricky and asymmetrical because backward parsing is +;;; extraordinarily difficult or impossible, so we have to implement +;;; killing in both directions by parsing forward. + (defun paredit-forward-kill-word () "Kill a word forward, skipping over intervening delimiters." (interactive) (let ((beginning (point))) (skip-syntax-forward " -") - (if (eq (char-syntax (char-after)) ?w) - (progn (goto-char beginning) ; Easy case: no intervening - (kill-word 1)) ; delimiters. - (let* ((parse-state (paredit-current-parse-state)) - (state (paredit-kill-word-state parse-state))) - (catch 'exit - (while t - ;; Go character-by-character forward. If we encounter a - ;; state change -- that is, if we move into or out of a - ;; comment or string, or encounter a bracket --, then reset - ;; the beginning point to after wherever the state changed, - ;; so that we don't destroy any intervening delimiters. - (setq parse-state ; PPS advances the point. - (parse-partial-sexp (point) (1+ (point)) - nil nil parse-state)) - (let ((old-state state) - (new-state (paredit-kill-word-state parse-state))) - (setq state new-state) - (if (not (eq old-state new-state)) - (setq beginning - (paredit-kill-word-hack-comments old-state)))) - ;; Finally, if we found a word, kill up to there and exit. - ;; BEGINNING will be the first point in this state. - (cond ((eq (char-syntax (char-after)) ?w) - (goto-char beginning) - (kill-word 1) - (throw 'exit nil))))))))) + (let* ((parse-state (paredit-current-parse-state)) + (state (paredit-kill-word-state parse-state 'char-after))) + (while (not (or (eobp) + (eq ?w (char-syntax (char-after))))) + (setq parse-state + (progn (forward-char 1) (paredit-current-parse-state)) +;; (parse-partial-sexp (point) (1+ (point)) +;; nil nil parse-state) + ) + (let* ((old-state state) + (new-state + (paredit-kill-word-state parse-state 'char-after))) + (cond ((not (eq old-state new-state)) + (setq parse-state + (paredit-kill-word-hack old-state + new-state + parse-state)) + (setq state + (paredit-kill-word-state parse-state + 'char-after)) + (setq beginning (point))))))) + (goto-char beginning) + (kill-word 1))) (defun paredit-backward-kill-word () "Kill a word backward, skipping over any intervening delimiters." (interactive) - (if (eq (char-syntax (char-before)) ?w) - ;; We're *on* the word, so we don't need to do anything else. - (backward-kill-word 1) - (let ((beginning (point))) - (backward-word 1) - (let* ((word-start (point)) - (parse-state (paredit-current-parse-state)) - (state (paredit-kill-word-state parse-state))) + (if (not (or (bobp) + (eq (char-syntax (char-before)) ?w))) + (let ((end (point))) + (backward-word 1) (forward-word 1) - (setq parse-state - (parse-partial-sexp word-start (point) - nil nil parse-state)) - (while (and (eq state (paredit-kill-word-state parse-state)) - (< (point) beginning)) - (setq parse-state ; PPS advances the point. - (parse-partial-sexp (point) (1+ (point)) - nil nil parse-state))) - (if (or (and (eq state 'comment) (bolp)) - (and (eq state 'string) (eq (char-before) ?\" ))) - (backward-char 1)) - (kill-region word-start (point)))))) - -(defun paredit-kill-word-state (parse-state) + (goto-char (min end (point))) + (let* ((parse-state (paredit-current-parse-state)) + (state + (paredit-kill-word-state parse-state 'char-before))) + (while (and (< (point) end) + (progn + (setq parse-state + (parse-partial-sexp (point) (1+ (point)) + nil nil parse-state)) + (or (eq state + (paredit-kill-word-state parse-state + 'char-before)) + (progn (backward-char 1) nil))))) + (if (and (eq state 'comment) + (eq ?\# (char-after (point))) + (eq ?\| (char-before (point)))) + (backward-char 1))))) + (backward-kill-word 1)) + +;;; Word-Killing Auxiliaries + +(defun paredit-kill-word-state (parse-state adjacent-char-fn) (cond ((paredit-in-comment-p parse-state) 'comment) ((paredit-in-string-p parse-state) 'string) - ((memq (char-syntax (char-after)) + ((memq (char-syntax (funcall adjacent-char-fn)) '(?\( ?\) )) - 'bracket-sequence) + 'delimiter) (t 'other))) -(defun paredit-kill-word-hack-comments (state) - (cond ((and (eq state 'comment) - (eq (char-after) ?\#)) - (1+ (point))) - ((and (not (eq state 'comment)) - (eq (char-before) ?\;)) +;;; This optionally advances the point past any comment delimiters that +;;; should probably not be touched, based on the last state change and +;;; the characters around the point. It returns a new parse state, +;;; starting from the PARSE-STATE parameter. + +(defun paredit-kill-word-hack (old-state new-state parse-state) + (cond ((and (not (eq old-state 'comment)) + (not (eq new-state 'comment)) + (not (paredit-in-string-escape-p)) + (eq ?\# (char-before)) + (eq ?\| (char-after))) + (forward-char 1) + (paredit-current-parse-state) +;; (parse-partial-sexp (point) (1+ (point)) +;; nil nil parse-state) + ) + ((and (not (eq old-state 'comment)) + (eq new-state 'comment) + (eq ?\; (char-before))) (skip-chars-forward ";") - (point)) - (t (point)))) + (paredit-current-parse-state) +;; (parse-partial-sexp (point) (save-excursion +;; (skip-chars-forward ";")) +;; nil nil parse-state) + ) + (t parse-state))) ;;;; Cursor and Screen Movement -(defun paredit-forward () +(eval-and-compile + (defmacro defun-saving-mark (name bvl doc &rest body) + `(defun ,name ,bvl + ,doc + ,(xcond ((paredit-xemacs-p) + '(interactive "_")) + ((paredit-gnu-emacs-p) + '(interactive))) + ,@body))) + +(defun-saving-mark paredit-forward () "Move forward an S-expression, or up an S-expression forward. If there are no more S-expressions in this one before the closing delimiter, move past that closing delimiter; otherwise, move forward past the S-expression following the point." - (interactive) - (condition-case () + (paredit-handle-sexp-errors (forward-sexp) ;++ Is it necessary to use UP-LIST and not just FORWARD-CHAR? - (scan-error (if (paredit-in-string-p) (forward-char) (up-list))))) + (if (paredit-in-string-p) (forward-char) (up-list)))) -(defun paredit-backward () +(defun-saving-mark paredit-backward () "Move backward an S-expression, or up an S-expression backward. If there are no more S-expressions in this one before the opening delimiter, move past that opening delimiter backward; otherwise, move move backward past the S-expression preceding the point." - (interactive) - (condition-case () + (paredit-handle-sexp-errors (backward-sexp) - (scan-error (if (paredit-in-string-p) - (backward-char) - (backward-up-list))))) + (if (paredit-in-string-p) (backward-char) (backward-up-list)))) ;;; Why is this not in lisp.el? @@ -1262,11 +1365,15 @@ Automatically indent the newly wrapped S-expression. As a special case, if the point is at the end of a list, simply insert a pair of parentheses, rather than insert a lone opening parenthesis and then signal an error, in the interest of preserving structure." - (interactive "p") - (condition-case () - (paredit-insert-pair (or n 1) ?\( ?\) 'goto-char) - (scan-error (insert ?\) ) - (backward-char))) + (interactive "P") + (paredit-handle-sexp-errors + (paredit-insert-pair (or n + (and (not (paredit-region-active-p)) + 1)) + ?\( ?\) + 'goto-char) + (insert ?\) ) + (backward-char)) (save-excursion (backward-up-list) (indent-sexp))) ;;; Thanks to Marco Baringer for the suggestion of a prefix argument @@ -1285,7 +1392,8 @@ With two prefix arguments as in `C-u C-u', kill all S-expressions backward into the enclosing list. With a numerical prefix argument N, kill N S-expressions backward in the current list before splicing the remaining S-expressions into the - enclosing list. If N is negative, kill forward." + enclosing list. If N is negative, kill forward. +This always creates a new entry on the kill ring." (interactive "P") (save-excursion (paredit-kill-surrounding-sexps-for-splice arg) @@ -1294,41 +1402,38 @@ With a numerical prefix argument N, kill N S-expressions backward in (forward-sexp) ; Go forward an expression, to (backward-delete-char 1)) ; delete the end delimiter. (delete-char 1) ; ...to delete the open char. - (condition-case () - (progn (backward-up-list) ; Reindent, now that the - (indent-sexp)) ; structure has changed. - (scan-error nil)))) + (paredit-ignore-sexp-errors + (backward-up-list) ; Reindent, now that the + (indent-sexp)))) ; structure has changed. (defun paredit-kill-surrounding-sexps-for-splice (arg) - (if (and arg (not (eq arg 0))) - (cond ((numberp arg) - ;; Kill ARG S-expressions before/after the point by saving - ;; the point, moving across them, and killing the region. - (let ((saved (point))) - (condition-case () - (backward-sexp arg) - (scan-error nil)) - (if (< arg 0) - (kill-region saved (point)) - (kill-region (point) saved)))) - ((consp arg) - (let ((v (car arg))) - (if (= v 4) ; one prefix argument - ;; Move backward until we hit the open paren; then - ;; kill that selected region. - (let ((end (point))) - (condition-case () - (while (not (bobp)) (backward-sexp)) - (scan-error nil)) - (kill-region (point) end)) - ;; Move forward until we hit the close paren; then - ;; kill that selected region. - (let ((beginning (point))) - (condition-case () - (while (not (eobp)) (forward-sexp)) - (scan-error nil)) - (kill-region beginning (point)))))) - (t (error "Bizarre prefix argument: %s" arg))))) + (cond ((paredit-in-string-p) (error "Splicing illegal in strings.")) + ((or (not arg) (eq arg 0)) nil) + ((or (numberp arg) (eq arg '-)) + ;; Kill ARG S-expressions before/after the point by saving + ;; the point, moving across them, and killing the region. + (let* ((arg (if (eq arg '-) -1 arg)) + (saved (paredit-point-at-sexp-boundary (- arg)))) + (paredit-ignore-sexp-errors (backward-sexp arg)) + (kill-region-new saved (point)))) + ((consp arg) + (let ((v (car arg))) + (if (= v 4) ; one prefix argument + ;; Move backward until we hit the open paren; then + ;; kill that selected region. + (let ((end (paredit-point-at-sexp-start))) + (paredit-ignore-sexp-errors + (while (not (bobp)) + (backward-sexp))) + (kill-region-new (point) end)) + ;; Move forward until we hit the close paren; then + ;; kill that selected region. + (let ((beginning (paredit-point-at-sexp-end))) + (paredit-ignore-sexp-errors + (while (not (eobp)) + (forward-sexp))) + (kill-region-new beginning (point)))))) + (t (error "Bizarre prefix argument: %s" arg)))) (defun paredit-splice-sexp-killing-backward (&optional n) "Splice the list the point is on by removing its delimiters, and @@ -1355,18 +1460,12 @@ With a prefix argument N, raise the following N S-expressions. If N (interactive "p") ;; Select the S-expressions we want to raise in a buffer substring. (let* ((bound (save-excursion (forward-sexp n) (point))) - (sexps (if (and n (< n 0)) - ;; We backward & forward over one S-expression in - ;; order to get to the exact beginning or exact end - ;; of it, not wherever the point happened to be. - (buffer-substring bound - (save-excursion (backward-sexp) - (forward-sexp) - (point))) - (buffer-substring (save-excursion (forward-sexp) - (backward-sexp) - (point)) - bound)))) + (sexps (save-excursion ;++ Is this necessary? + (if (and n (< n 0)) + (buffer-substring bound + (paredit-point-at-sexp-end)) + (buffer-substring (paredit-point-at-sexp-start) + bound))))) ;; Move up to the list we're raising those S-expressions out of and ;; delete it. (backward-up-list) @@ -1383,19 +1482,41 @@ With a prefix argument N, raise the following N S-expressions. If N "Add the S-expression following the current list into that list by moving the closing delimiter. Automatically reindent the newly slurped S-expression with respect to - its new enclosing form." + its new enclosing form. +If in a string, move the opening double-quote forward by one + S-expression and escape any intervening characters as necessary, + without altering any indentation or formatting." (interactive) (save-excursion - (up-list) ; Up to the end of the list to - (let ((close (char-before))) ; save and delete the closing - (backward-delete-char 1) ; delimiter. - (catch 'return ; Go to the end of the desired - (while t ; S-expression, going up a - (condition-case () ; list if it's not in this, - (progn (paredit-forward-and-indent) - (throw 'return nil)) - (scan-error (up-list))))) - (insert close)))) ; to insert that delimiter. + (cond ((or (paredit-in-comment-p) + (paredit-in-char-p)) + (error "Invalid context for slurpage")) + ((paredit-in-string-p) + (paredit-forward-slurp-into-string)) + (t + (paredit-forward-slurp-into-list))))) + +(defun paredit-forward-slurp-into-list () + (up-list) ; Up to the end of the list to + (let ((close (char-before))) ; save and delete the closing + (backward-delete-char 1) ; delimiter. + (catch 'return ; Go to the end of the desired + (while t ; S-expression, going up a + (paredit-handle-sexp-errors ; list if it's not in this, + (progn (paredit-forward-and-indent) + (throw 'return nil)) + (up-list)))) + (insert close))) ; to insert that delimiter. + +(defun paredit-forward-slurp-into-string () + (goto-char (1+ (cdr (paredit-string-start+end-points)))) + ;; Signal any errors that we might get first, before mucking with the + ;; buffer's contents. + (save-excursion (forward-sexp)) + (let ((close (char-before))) + (backward-delete-char 1) + (paredit-forward-for-quote (save-excursion (forward-sexp) (point))) + (insert close))) (defun paredit-forward-barf-sexp () "Remove the last S-expression in the current list from that list @@ -1407,10 +1528,9 @@ Automatically reindent the newly barfed S-expression with respect to (up-list) ; Up to the end of the list to (let ((close (char-before))) ; save and delete the closing (backward-delete-char 1) ; delimiter. - (condition-case () ; Go back to where we want to - (backward-sexp) ; insert the delimiter. - (scan-error nil)) ; Ignore scan errors, and - (paredit-skip-whitespace nil) ; skip leading whitespace. + (paredit-ignore-sexp-errors ; Go back to where we want to + (backward-sexp)) ; insert the delimiter. + (paredit-skip-whitespace nil) ; Skip leading whitespace. (cond ((bobp) (error "Barfing all subexpressions with no open-paren?")) ((paredit-in-comment-p) ; Don't put the close-paren in @@ -1423,24 +1543,49 @@ Automatically reindent the newly barfed S-expression with respect to "Add the S-expression preceding the current list into that list by moving the closing delimiter. Automatically reindent the whole form into which new S-expression was - slurped." + slurped. +If in a string, move the opening double-quote backward by one + S-expression and escape any intervening characters as necessary, + without altering any indentation or formatting." (interactive) (save-excursion - (backward-up-list) - (let ((open (char-after))) - (delete-char 1) - (catch 'return - (while t - (condition-case () - (progn (backward-sexp) - (throw 'return nil)) - (scan-error (backward-up-list))))) - (insert open)) - ;; Reindent the line at the beginning of wherever we inserted the - ;; opening parenthesis, and then indent the whole S-expression. - (backward-up-list) - (lisp-indent-line) - (indent-sexp))) + (cond ((or (paredit-in-comment-p) + (paredit-in-char-p)) + (error "Invalid context for slurpage")) + ((paredit-in-string-p) + (paredit-backward-slurp-into-string)) + (t + (paredit-backward-slurp-into-list))))) + +(defun paredit-backward-slurp-into-list () + (backward-up-list) + (let ((open (char-after))) + (delete-char 1) + (catch 'return + (while t + (paredit-handle-sexp-errors + (progn (backward-sexp) + (throw 'return nil)) + (backward-up-list)))) + (insert open)) + ;; Reindent the line at the beginning of wherever we inserted the + ;; opening parenthesis, and then indent the whole S-expression. + (backward-up-list) + (lisp-indent-line) + (indent-sexp)) + +(defun paredit-backward-slurp-into-string () + (goto-char (car (paredit-string-start+end-points))) + ;; Signal any errors that we might get first, before mucking with the + ;; buffer's contents. + (save-excursion (backward-sexp)) + (let ((open (char-after)) + (target (point))) + (message "open = %S" open) + (delete-char 1) + (backward-sexp) + (insert open) + (paredit-forward-for-quote target))) (defun paredit-backward-barf-sexp () "Remove the first S-expression in the current list from that list @@ -1448,32 +1593,25 @@ Automatically reindent the whole form into which new S-expression was Automatically reindent the barfed S-expression and the form from which it was barfed." (interactive) - ;; SAVE-EXCURSION here does the wrong thing, but manually saving and - ;; restoring the point does the right thing. Here's an example of - ;; how SAVE-EXCURSION breaks: - ;; (foo|) C-{ - ;; foo|() - ;; It should be: - ;; foo(|) - (let ((beginning (point))) - (unwind-protect - (progn - (backward-up-list) - (let ((open (char-after))) - (delete-char 1) - (condition-case () (paredit-forward-and-indent) - (scan-error nil)) - (while (progn (paredit-skip-whitespace t) - (eq (char-after) ?\; )) - (forward-line 1)) - (if (eobp) - (error - "Barfing all subexpressions with no close-paren?")) - (insert open)) - (backward-up-list) - (lisp-indent-line) - (indent-sexp)) - (goto-char beginning)))) + (save-excursion + (backward-up-list) + (let ((open (char-after))) + (delete-char 1) + (paredit-ignore-sexp-errors + (paredit-forward-and-indent)) + (while (progn (paredit-skip-whitespace t) + (eq (char-after) ?\; )) + (forward-line 1)) + (if (eobp) + (error + "Barfing all subexpressions with no close-paren?")) + ;** Don't use `insert' here. Consider, e.g., barfing from + ;** (foo|) + ;** and how `save-excursion' works. + (insert-before-markers open)) + (backward-up-list) + (lisp-indent-line) + (indent-sexp))) ;;;; Splitting & Joining @@ -1501,34 +1639,42 @@ Automatically reindent the barfed S-expression and the form from which "Join the S-expressions adjacent on either side of the point. Both must be lists, strings, or atoms; error if there is a mismatch." (interactive) + ;++ How ought this to handle comments intervening symbols or strings? (save-excursion (if (or (paredit-in-comment-p) (paredit-in-string-p) (paredit-in-char-p)) - (error "Invalid S-expression join.") - (let ((left-point (save-excursion (backward-sexp) - (forward-sexp) - (point))) - (right-point (save-excursion (forward-sexp) - (backward-sexp) - (point)))) - (let ((left-syntax (char-syntax (char-before left-point))) - (right-syntax (char-syntax (char-after right-point)))) - (cond ((or (and (eq left-syntax ?\) ) - (eq right-syntax ?\( )) - (and (eq left-syntax ?\" ) - (eq right-syntax ?\" ))) - (goto-char right-point) - (delete-char 1) - (goto-char left-point) - (backward-delete-char 1) - (if (not (paredit-in-string-p)) - (progn (backward-up-list) (indent-sexp)))) - ((and (memq left-syntax '(?w ?_)) ; Word or symbol - (memq right-syntax '(?w ?_))) - ;++ What about intervening comments? - (delete-region left-point right-point)) - (t (error "Mismatched S-expressions to join.")))))))) + (error "Invalid context in which to join S-expressions.") + (let ((left-point (save-excursion (paredit-point-at-sexp-end))) + (right-point (save-excursion + (paredit-point-at-sexp-start)))) + (let ((left-char (char-before left-point)) + (right-char (char-after right-point))) + (let ((left-syntax (char-syntax left-char)) + (right-syntax (char-syntax right-char))) + (cond ((>= left-point right-point) + (error "Can't join a datum with itself.")) + ((and (eq left-syntax ?\) ) + (eq right-syntax ?\( ) + (eq left-char (matching-paren right-char)) + (eq right-char (matching-paren left-char))) + ;; Leave intermediate formatting alone. + (goto-char right-point) + (delete-char 1) + (goto-char left-point) + (backward-delete-char 1) + (backward-up-list) + (indent-sexp)) + ((and (eq left-syntax ?\" ) + (eq right-syntax ?\" )) + ;; Delete any intermediate formatting. + (delete-region (1- left-point) + (1+ right-point))) + ((and (memq left-syntax '(?w ?_)) ; Word or symbol + (memq right-syntax '(?w ?_))) + (delete-region left-point right-point)) + (t + (error "Mismatched S-expressions to join."))))))))) ;;;; Utilities @@ -1570,13 +1716,29 @@ Indent with `lisp-indent-line' and then `indent-sexp'." "Skip past any whitespace, or until the point LIMIT is reached. If TRAILING-P is nil, skip leading whitespace; otherwise, skip trailing whitespace." - (funcall (if trailing-p #'skip-chars-forward #'skip-chars-backward) + (funcall (if trailing-p 'skip-chars-forward 'skip-chars-backward) " \t\n " ; This should skip using the syntax table, but LF limit)) ; is a comment end, not newline, in Lisp mode. -(defun paredit-region-active-p () - "Return T if the region is active and NIL if not." - (and mark-active transient-mark-mode)) +(defalias 'paredit-region-active-p + (xcond ((paredit-xemacs-p) 'region-active-p) + ((paredit-gnu-emacs-p) + (lambda () + (and mark-active transient-mark-mode))))) + +(defun kill-region-new (start end) + "Kill the region between START and END. +Do not append to any current kill, and + do not let the next kill append to this one." + (interactive "r") ;Eh, why not? + ;; KILL-REGION sets THIS-COMMAND to tell the next kill that the last + ;; command was a kill. It also checks LAST-COMMAND to see whether it + ;; should append. If we bind these locally, any modifications to + ;; THIS-COMMAND will be masked, and it will not see LAST-COMMAND to + ;; indicate that it should append. + (let ((this-command nil) + (last-command nil)) + (kill-region start end))) ;;;;; S-expression Parsing Utilities @@ -1604,7 +1766,7 @@ If no parse state is supplied, compute one from the beginning of the t)) (defun paredit-string-start+end-points (&optional state) - "Return a cons of the points of the open and quotes of the string. + "Return a cons of the points of open and close quotes of the string. The string is determined from the parse state STATE, or the parse state from the beginning of the defun to the point. This assumes that `paredit-in-string-p' has already returned true, i.e. @@ -1625,6 +1787,21 @@ If no parse state is supplied, compute one from the beginning of the ;; else an integer (the current comment nesting) (and (nth 4 (or state (paredit-current-parse-state))) t)) + +(defun paredit-point-at-sexp-boundary (n) + (cond ((< n 0) (paredit-point-at-sexp-start)) + ((= n 0) (point)) + ((> n 0) (paredit-point-at-sexp-end)))) + +(defun paredit-point-at-sexp-start () + (forward-sexp) + (backward-sexp) + (point)) + +(defun paredit-point-at-sexp-end () + (backward-sexp) + (forward-sexp) + (point)) ;;;; Initialization |