@@ -1,3 +1,9 @@ +* New in version 20090130 + +** Updated: paredit.el and redshank.el. + +** Fixed: The core file for PowerPC machines was missing. + * New in version 20090127 ** Fixed: The version number for SLIME should have been 2009-01-23, not NEWS @@ -8,9 +8,9 @@ that's only a double-click away for Mac OS X users. This package includes the following code items: - - Aquamacs 1.3b - - SBCL (Steel Bank Common Lisp) 1.0.16 - - SLIME (Superior Lisp Interaction Mode for Emacs) CVS 2008-04-24 + - Aquamacs 1.6 + - SBCL (Steel Bank Common Lisp) 1.0.24 + - SLIME (Superior Lisp Interaction Mode for Emacs) CVS 2008-01-23 - paredit.el - redshank.el - cldoc.el README @@ -1,105 +1,193 @@ ;;; -*- Mode: Emacs-Lisp; outline-regexp: "*\n;;;;+" -*- ;;;;;; Paredit: Parenthesis-Editing Minor Mode -;;;;;; Version 20 +;;;;;; Version 21 -;;; This code is written by Taylor R. Campbell (except where explicitly -;;; noted) and placed in the Public Domain. All warranties are -;;; disclaimed. - -;;; Add this to your .emacs after adding paredit.el to /path/to/elisp/: +;;; Copyright (c) 2008, Taylor R. Campbell +;;; +;;; Redistribution and use in source and binary forms, with or without +;;; modification, are permitted provided that the following conditions +;;; are met: +;;; +;;; * Redistributions of source code must retain the above copyright +;;; notice, this list of conditions and the following disclaimer. +;;; +;;; * Redistributions in binary form must reproduce the above copyright +;;; notice, this list of conditions and the following disclaimer in +;;; the documentation and/or other materials provided with the +;;; distribution. +;;; +;;; * Neither the names of the authors nor the names of contributors +;;; may be used to endorse or promote products derived from this +;;; software without specific prior written permission. +;;; +;;; THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS +;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY +;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE +;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, +;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING +;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +;;; This file is permanently stored at +;;; <http://mumble.net/~campbell/emacs/paredit-21.el>. ;;; -;;; (add-to-list 'load-path "/path/to/elisp/") +;;; The currently released version of paredit is available at +;;; <http://mumble.net/~campbell/emacs/paredit.el>. +;;; +;;; The latest beta version of paredit is available at +;;; <http://mumble.net/~campbell/emacs/paredit-beta.el>. +;;; +;;; Release notes are available at +;;; <http://mumble.net/~campbell/emacs/paredit.release>. +* +;;; Install paredit by placing `paredit.el' in `/path/to/elisp', a +;;; directory of your choice, and adding to your .emacs file: +;;; +;;; (add-to-list 'load-path "/path/to/elisp") ;;; (autoload 'paredit-mode "paredit" ;;; "Minor mode for pseudo-structurally editing Lisp code." ;;; t) -;;; (add-hook '...-mode-hook (lambda () (paredit-mode +1))) ;;; -;;; Usually the ... will be lisp or scheme or both. Alternatively, you -;;; can manually toggle this mode with M-x paredit-mode. Customization -;;; of paredit can be accomplished with `eval-after-load': +;;; Toggle Paredit Mode with `M-x paredit-mode RET', or enable it +;;; always in a major mode `M' (e.g., `lisp' or `scheme') with: +;;; +;;; (add-hook M-mode-hook (lambda () (paredit-mode +1))) +;;; +;;; Customize paredit using `eval-after-load': ;;; ;;; (eval-after-load 'paredit ;;; '(progn ...redefine keys, &c....)) ;;; -;;; 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. +;;; Paredit should run in GNU Emacs 21 or later and XEmacs 21.5 or +;;; later. Paredit 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. +;;; +;;; Questions, bug reports, comments, feature suggestions, &c., may be +;;; addressed via email to the author's surname at mumble.net or via +;;; IRC to the user named Riastradh on irc.freenode.net in the #paredit +;;; channel. +;;; +;;; Please contact the author rather than forking your own versions, to +;;; prevent the dissemination of random variants floating about the +;;; internet unbeknownst to the author. Laziness is not an excuse: +;;; your laziness costs me confusion and time trying to support +;;; paredit, so if you fork paredit, you make the world a worse place. +;;; +;;; *** WARNING *** IMPORTANT *** DO NOT SUBMIT BUGS BEFORE READING *** +;;; +;;; If you plan to submit a bug report, where some sequence of keys in +;;; Paredit Mode, or some sequence of paredit commands, doesn't do what +;;; you wanted, then it is helpful to isolate an example in a very +;;; small buffer, and it is **ABSOLUTELY**ESSENTIAL** that you supply, +;;; along with the sequence of keys or commands, +;;; +;;; (1) the version of Emacs, +;;; (2) the version of paredit.el[*], and +;;; (3) the **COMPLETE** state of the buffer used to reproduce the +;;; problem, including major mode, minor modes, local key +;;; bindings, entire contents of the buffer, leading line breaks +;;; or spaces, &c. +;;; +;;; It is often extremely difficult to reproduce problems, especially +;;; with commands like `paredit-kill'. If you do not supply **ALL** of +;;; this information, then it is highly probable that I cannot +;;; reproduce your problem no matter how hard I try, and the effect of +;;; submitting a bug without this information is only to waste your +;;; time and mine. So, please, include all of the above information. +;;; +;;; [*] If you are using a beta version of paredit, be sure that you +;;; are using the *latest* edition of the beta version, available +;;; at <http://mumble.net/~campbell/emacs/paredit-beta.el>. If you +;;; are not using a beta version, then upgrade either to that or to +;;; the latest release version; I cannot support older versions, +;;; and I can't fathom any reason why you might be using them. So +;;; the answer to item (2) should be either `release' or `beta'. * -;;; This mode changes the keybindings for a number of simple keys, -;;; notably (, ), ", \, and ;. The bracket keys (round or square) are -;;; defined to insert parenthesis pairs and move past the close, +;;; The paredit minor mode, Paredit Mode, binds a number of simple +;;; keys, notably `(', `)', `"', and `\', to commands that more +;;; carefully insert S-expression structures in the buffer. The +;;; parenthesis delimiter keys (round or square) are defined to insert +;;; parenthesis pairs and move past the closing delimiter, ;;; respectively; the double-quote key is multiplexed to do both, and -;;; also insert an escape if within a string; backslashes prompt the -;;; user for the next character to input, because a lone backslash can -;;; break structure inadvertently; and semicolons ensure that they do -;;; not accidentally comment valid structure. (Use M-; to comment an -;;; expression.) These all have their ordinary behaviour when inside -;;; comments, and, outside comments, if truly necessary, you can insert -;;; them literally with C-q. +;;; also to insert an escape if within a string; and backslashes prompt +;;; the user for the next character to input, because a lone backslash +;;; can break structure inadvertently. These all have their ordinary +;;; behaviour when inside comments, and, outside comments, if truly +;;; necessary, you can insert them literally with `C-q'. ;;; -;;; These keybindings are set up for my preference. One particular -;;; preference which I've seen vary greatly from person to person is -;;; whether the command to move past a closing delimiter ought to -;;; insert a newline. Since I find this behaviour to be more common -;;; than that which inserts no newline, I have ) bound to it, and the -;;; more involved M-) to perform the less common action. This bothers -;;; some users, though, and they prefer the other way around. This -;;; code, which you can use `eval-after-load' to put in your .emacs, -;;; will exchange the bindings: +;;; The key bindings are designed so that when typing new code in +;;; Paredit Mode, you can generally use exactly the same keystrokes as +;;; you would have used without Paredit Mode. Earlier versions of +;;; paredit.el did not conform to this, because Paredit Mode bound `)' +;;; to a command that would insert a newline. Now `)' is bound to a +;;; command that does not insert a newline, and `M-)' is bound to the +;;; command that inserts a newline. To revert to the former behaviour, +;;; add the following forms to an `eval-after-load' form for paredit.el +;;; in your .emacs file: ;;; ;;; (define-key paredit-mode-map (kbd ")") -;;; 'paredit-close-parenthesis) +;;; 'paredit-close-round-and-newline) ;;; (define-key paredit-mode-map (kbd "M-)") -;;; 'paredit-close-parenthesis-and-newline) +;;; 'paredit-close-round) ;;; -;;; 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. +;;; Paredit Mode also binds the usual keys for deleting and killing, so +;;; that they will not destroy any S-expression structure by killing or +;;; deleting only one side of a parenthesis or quote pair. If the +;;; point is on a closing delimiter, `DEL' will move left over it; if +;;; it is on an opening delimiter, `C-d' will move right over it. Only +;;; if the point is between a pair of delimiters 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 delimiter, 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 -;;; elsewhere in some S-expression. It is performed only by the -;;; advanced S-expression frobnication commands, and only on the forms -;;; that were immediately operated upon (& their subforms). +;;; The behaviour of the commands for deleting and killing can be +;;; overridden by passing a `C-u' prefix argument: `C-u DEL' will +;;; delete a character backward, `C-u C-d' will delete a character +;;; forward, and `C-u C-k' will kill text from the point to the end of +;;; the line, irrespective of the S-expression structure in the buffer. +;;; This can be used to fix mistakes in a buffer, but should generally +;;; be avoided. ;;; -;;; This code is written for clarity, not efficiency. S-expressions -;;; are frequently walked over redundantly. If you have problems with -;;; some of the commands taking too long to execute, tell me, but first -;;; make sure that what you're doing is reasonable: it is stylistically -;;; bad to have huge, long, hideously nested code anyway. +;;; Paredit performs automatic reindentation as locally as possible, to +;;; avoid interfering with custom indentation used elsewhere in some +;;; S-expression. Only the advanced S-expression manipulation commands +;;; automatically reindent, and only the forms that were immediately +;;; operated upon (and their subforms). ;;; -;;; Questions, bug reports, comments, feature suggestions, &c., can be -;;; addressed to the author via mail on the host mumble.net to campbell -;;; or via IRC on irc.freenode.net in the #paredit channel under the -;;; nickname Riastradh. +;;; This code is written for clarity, not efficiency. It frequently +;;; walks over S-expressions redundantly. If you have problems with +;;; the time it takes to execute some of the commands, let me know, but +;;; first be sure that what you're doing is reasonable: it is +;;; preferable to avoid immense S-expressions in code anyway. ;;; This assumes Unix-style LF line endings. -(defconst paredit-version 20) +(defconst paredit-version 21) +(defconst paredit-beta-p nil) * (eval-and-compile (defun paredit-xemacs-p () - ;; No idea I got this definition from. Edward O'Connor (hober on - ;; IRC) suggested the current definition. + ;; No idea where I got this definition from. Edward O'Connor + ;; (hober in #emacs) suggested the current definition. ;; (and (boundp 'running-xemacs) ;; running-xemacs) (featurep 'xemacs)) (defun paredit-gnu-emacs-p () + ;++ This could probably be improved. (not (paredit-xemacs-p))) (defmacro xcond (&rest clauses) @@ -116,7 +204,7 @@ Signal an error if no clause matches." (condition-case condition (backward-sexp) (error (if (eq (car condition) 'error) - (paredit-warn "%s%s%s%s" + (paredit-warn "%s%s%s%s%s" "Paredit is unable to discriminate" " S-expression parse errors from" " other errors. " @@ -206,26 +294,26 @@ Deprecated: use `paredit-mode' instead." (progn (setq paredit-commands `( "Basic Insertion Commands" - ("(" paredit-open-parenthesis + ("(" paredit-open-round ("(a b |c d)" "(a b (|) c d)") ("(foo \"bar |baz\" quux)" "(foo \"bar (|baz\" quux)")) - (")" paredit-close-parenthesis-and-newline + (")" paredit-close-round + ("(a b |c )" "(a b c)|") + ("; Hello,| world!" + "; Hello,)| world!")) + ("M-)" paredit-close-round-and-newline ("(defun f (x| ))" "(defun f (x)\n |)") ("; (Foo.|" "; (Foo.)|")) - ("M-)" paredit-close-parenthesis - ("(a b |c )" "(a b c)|") - ("; Hello,| world!" - "; Hello,)| world!")) - ("[" paredit-open-bracket + ("[" paredit-open-square ("(a b |c d)" "(a b [|] c d)") ("(foo \"bar |baz\" quux)" "(foo \"bar [baz\" quux)")) - ("]" paredit-close-bracket + ("]" paredit-close-square ("(define-key keymap [frob| ] 'frobnicate)" "(define-key keymap [frob]| 'frobnicate)") ("; [Bar.|" @@ -246,11 +334,6 @@ Deprecated: use `paredit-mode' instead." "(string #\\x|)") ("\"foo|bar\"\n ; Escaping character... (\")" "\"foo\\\"|bar\"")) - (";" paredit-semicolon - ("|(frob grovel)" - ";|\n(frob grovel)") - ("(frob grovel) |" - "(frob grovel) ;|")) ("M-;" paredit-comment-dwim ("(foo |bar) ; baz" "(foo bar) ; |baz") @@ -329,7 +412,7 @@ Deprecated: use `paredit-mode' instead." ; no need given C-M-f & C-M-b. * "Depth-Changing Commands" - ("M-(" paredit-wrap-sexp + ("M-(" paredit-wrap-round ("(foo |bar baz)" "(foo (|bar) baz)")) ("M-s" paredit-splice-sexp @@ -384,6 +467,7 @@ Deprecated: use `paredit-mode' instead." ("hello-\n| world" "hello-|world")) ("C-c C-M-l" paredit-recentre-on-sexp) + ("M-q" paredit-reindent-defun) )) nil) ; end of PROGN * @@ -469,11 +553,13 @@ Deprecated: use `paredit-mode' instead." (defun paredit-insert-html-examples () "Insert HTML for a paredit quick reference table." (interactive) - (let ((insert-lines (lambda (&rest lines) - (mapc (lambda (line) (insert line) (newline)) - lines))) - (html-keys (lambda (keys) - (mapconcat 'paredit-html-quote keys ", "))) + (let ((insert-lines + (lambda (&rest lines) + (mapc (lambda (line) (insert line) (newline)) + lines))) + (html-keys + (lambda (keys) + (mapconcat 'paredit-html-quote keys ", "))) (html-example (lambda (example) (concat "<table><tr><td><pre>" @@ -563,68 +649,93 @@ If in a character literal, do nothing. This prevents changing what was If there was a margin comment after the closing delimiter, preserve it on the same line.") (interactive) - (paredit-move-past-close-and-newline ,close))))) - -(define-paredit-pair ?\( ?\) "parenthesis") -(define-paredit-pair ?\[ ?\] "bracket") -(define-paredit-pair ?\{ ?\} "brace") -(define-paredit-pair ?\< ?\> "brocket") + (paredit-move-past-close-and-newline ,close)) + (defun ,(paredit-conc-name "paredit-wrap-" name) + (&optional argument) + ,(concat "Wrap the following S-expression. +See `paredit-wrap-sexp' for more details.") + (interactive "P") + (paredit-wrap-sexp argument ,open ,close)) + (add-to-list 'paredit-wrap-commands + ',(paredit-conc-name "paredit-wrap-" name))))) + +(defvar paredit-wrap-commands '(paredit-wrap-sexp) + "List of paredit commands that wrap S-expressions. +Used by `paredit-yank-pop'; for internal paredit use only.") + +(define-paredit-pair ?\( ?\) "round") +(define-paredit-pair ?\[ ?\] "square") +(define-paredit-pair ?\{ ?\} "curly") +(define-paredit-pair ?\< ?\> "angled") + +;;; Aliases for the old names. + +(defalias 'paredit-open-parenthesis 'paredit-open-round) +(defalias 'paredit-close-parenthesis 'paredit-close-round) +(defalias 'paredit-close-parenthesis-and-newline + 'paredit-close-round-and-newline) + +(defalias 'paredit-open-bracket 'paredit-open-square) +(defalias 'paredit-close-bracket 'paredit-close-square) +(defalias 'paredit-close-bracket-and-newline + 'paredit-close-square-and-newline) * (defun paredit-move-past-close (close) (cond ((or (paredit-in-string-p) (paredit-in-comment-p)) (insert close)) ((not (paredit-in-char-p)) - (paredit-move-past-close-and-reindent) + (paredit-move-past-close-and-reindent close) (paredit-blink-paren-match nil)))) (defun paredit-move-past-close-and-newline (close) - (cond ((or (paredit-in-string-p) - (paredit-in-comment-p)) - (insert close)) - (t (if (paredit-in-char-p) (forward-char)) - (paredit-move-past-close-and-reindent) - (let ((comment.point (paredit-find-comment-on-line))) - (newline) - (if comment.point - (save-excursion - (forward-line -1) - (end-of-line) - (indent-to (cdr comment.point)) - (insert (car comment.point))))) - (lisp-indent-line) - (paredit-ignore-sexp-errors (indent-sexp)) - (paredit-blink-paren-match t)))) + (if (or (paredit-in-string-p) + (paredit-in-comment-p)) + (insert close) + (if (paredit-in-char-p) (forward-char)) + (paredit-move-past-close-and-reindent close) + (let ((comment.point (paredit-find-comment-on-line))) + (newline) + (if comment.point + (save-excursion + (forward-line -1) + (end-of-line) + (indent-to (cdr comment.point)) + (insert (car comment.point))))) + (lisp-indent-line) + (paredit-ignore-sexp-errors (indent-sexp)) + (paredit-blink-paren-match t))) (defun paredit-find-comment-on-line () "Find a margin comment on the current line. +Return nil if there is no such comment or if there is anything but + whitespace until such a comment. If such a comment exists, delete the comment (including all leading whitespace) and return a cons whose car is the comment as a string and whose cdr is the point of the comment's initial semicolon, relative to the start of the line." (save-excursion - (catch 'return - (while t - (if (search-forward ";" (point-at-eol) t) - (if (not (or (paredit-in-string-p) - (paredit-in-char-p))) - (let* ((start (progn (backward-char) ;before semicolon - (point))) - (comment (buffer-substring start - (point-at-eol)))) - (paredit-skip-whitespace nil (point-at-bol)) - (delete-region (point) (point-at-eol)) - (throw 'return - (cons comment (- start (point-at-bol)))))) - (throw 'return nil)))))) + (paredit-skip-whitespace t (point-at-eol)) + (and (eq ?\; (char-after)) + (not (eq ?\; (char-after (1+ (point))))) + (not (or (paredit-in-string-p) + (paredit-in-char-p))) + (let* ((start ;Move to before the semicolon. + (progn (backward-char) (point))) + (comment + (buffer-substring start (point-at-eol)))) + (paredit-skip-whitespace nil (point-at-bol)) + (delete-region (point) (point-at-eol)) + (cons comment (- start (point-at-bol))))))) * (defun paredit-insert-pair (n open close forward) - (let* ((regionp (and (paredit-region-active-p) - (paredit-region-safe-for-insert-p))) - (end (and regionp - (not n) - (prog1 (region-end) - (goto-char (region-beginning)))))) + (let* ((regionp + (and (paredit-region-active-p) + (paredit-region-safe-for-insert-p))) + (end + (and regionp + (not n) + (prog1 (region-end) (goto-char (region-beginning)))))) (let ((spacep (paredit-space-for-delimiter-p nil open))) (if spacep (insert " ")) (insert open) @@ -645,8 +756,8 @@ If such a comment exists, delete the comment (including all leading (end (region-end))) (goto-char beginning) (let* ((beginning-state (paredit-current-parse-state)) - (end-state (parse-partial-sexp beginning end - nil nil beginning-state))) + (end-state + (parse-partial-sexp beginning end nil nil beginning-state))) (and (= (nth 0 beginning-state) ; 0. depth in parens (nth 0 end-state)) (eq (nth 3 beginning-state) ; 3. non-nil if inside a @@ -662,14 +773,20 @@ If such a comment exists, delete the comment (including all leading ;; close when want an open the string or an open when we want to ;; close the string), do insert a space. (and (not (if endp (eobp) (bobp))) - (memq (char-syntax (if endp - (char-after) - (char-before))) + (memq (char-syntax (if endp (char-after) (char-before))) (list ?w ?_ ?\" (let ((matching (matching-paren delimiter))) (and matching (char-syntax matching))))))) * -(defun paredit-move-past-close-and-reindent () +(defun paredit-move-past-close-and-reindent (close) + (let ((open (paredit-missing-close))) + (if open + (if (eq close (matching-paren open)) + (save-excursion + (message "Missing closing delimiter: %c" close) + (insert close)) + (error "Mismatched missing closing delimiter: %c ... %c" + open close)))) (let ((orig (point))) (up-list) (if (catch 'return ; This CATCH returns T if it @@ -685,18 +802,26 @@ If such a comment exists, delete the comment (including all leading ((save-excursion (forward-line -1) (end-of-line) (paredit-in-comment-p)) - ;; Moving the closing parenthesis any further + ;; Moving the closing delimiter any further ;; would put it into a comment, so we just - ;; indent the closing parenthesis where it is - ;; and abort the loop, telling its continuation - ;; that no leading whitespace should be deleted. + ;; indent the closing delimiter where it is and + ;; abort the loop, telling its continuation that + ;; no leading whitespace should be deleted. (lisp-indent-line) (throw 'return nil)) (t (delete-indentation))))))) (paredit-delete-leading-whitespace)))) +(defun paredit-missing-close () + (save-excursion + (paredit-handle-sexp-errors (backward-up-list) + (error "Not inside a list.")) + (let ((open (char-after))) + (paredit-handle-sexp-errors (progn (forward-sexp) nil) + open)))) + (defun paredit-delete-leading-whitespace () - ;; This assumes that we're on the closing parenthesis already. + ;; This assumes that we're on the closing delimiter already. (save-excursion (backward-char) (while (let ((syn (char-syntax (char-before)))) @@ -826,7 +951,7 @@ If not in a string, act as `paredit-doublequote'; if no prefix argument nil)) ; express the rubout char? ; ?\^? works, but ugh...) -;;; The placement of this function in this file is totally random. +;;; The placement of these functions in this file is totally random. (defun paredit-newline () "Insert a newline and indent it. @@ -842,37 +967,24 @@ If in a string, just insert a literal newline." (forward-char)) (newline-and-indent) ;; Indent the following S-expression, but don't signal an error if - ;; there's only a closing parenthesis after the point. + ;; there's only a closing delimiter after the point. (paredit-ignore-sexp-errors (indent-sexp)))) + +(defun paredit-reindent-defun (&optional argument) + "Reindent the definition that the point is on. +If the point is in a string or a comment, fill the paragraph instead, + and with a prefix argument, justify as well." + (interactive "P") + (if (or (paredit-in-string-p) + (paredit-in-comment-p)) + (fill-paragraph argument) + (save-excursion + (beginning-of-defun) + (indent-sexp)))) * ;;;; Comment Insertion -(defun paredit-semicolon (&optional n) - "Insert a semicolon, moving any code after the point to a new line. -If in a string, comment, or character literal, insert just a literal - semicolon, and do not move anything to the next line. -With a prefix argument N, insert N semicolons." - (interactive "P") - (if (not (or (paredit-in-string-p) - (paredit-in-comment-p) - (paredit-in-char-p) - ;; No more code on the line after the point. - (save-excursion - (paredit-skip-whitespace t (point-at-eol)) - (or (eolp) - ;; Let the user prefix semicolons to existing - ;; comments. - (eq (char-after) ?\;))))) - ;; Don't use NEWLINE-AND-INDENT, because that will delete all of - ;; the horizontal whitespace first, but we just want to move the - ;; code following the point onto the next line while preserving - ;; the point on this line. - ;++ Why indent only the line? - (save-excursion (newline) (lisp-indent-line))) - (insert (make-string (if n (prefix-numeric-value n) 1) - ?\; ))) - -(defun paredit-comment-dwim (&optional arg) +(defun paredit-comment-dwim (&optional argument) "Call the Lisp comment command you want (Do What I Mean). This is like `comment-dwim', but it is specialized for Lisp editing. If transient mark mode is enabled and the mark is active, comment or @@ -890,17 +1002,34 @@ 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) + (paredit-initialize-comment-dwim) (cond ((paredit-region-active-p) (comment-or-uncomment-region (region-beginning) (region-end) - arg)) + argument)) ((paredit-comment-on-line-p) - (if arg - (comment-kill (if (integerp arg) arg nil)) + (if argument + (comment-kill (if (integerp argument) argument nil)) (comment-indent))) (t (paredit-insert-comment)))) + +;;; This is all a horrible, horrible hack, primarily for GNU Emacs 21, +;;; in which there is no `comment-or-uncomment-region'. + +(defun paredit-initialize-comment-dwim () + (require 'newcomment) + (if (not (fboundp 'comment-or-uncomment-region)) + (defalias 'comment-or-uncomment-region + (lambda (beginning end &optional argument) + (interactive "*r\nP") + (funcall (if (save-excursion (goto-char beginning) + (comment-forward (point-max)) + (<= end (point))) + 'uncomment-region + 'comment-region) + beginning end argument)))) + (defalias 'paredit-initialize-comment-dwim 'comment-normalize-vars) + (comment-normalize-vars)) * (defun paredit-comment-on-line-p () (save-excursion @@ -957,17 +1086,24 @@ At the top level, where indentation is calculated to be at column 0, * ;;;; Character Deletion -(defun paredit-forward-delete (&optional arg) +(defun paredit-forward-delete (&optional argument) "Delete a character forward or move forward over a delimiter. If on an opening S-expression delimiter, move forward into the S-expression. If on a closing S-expression delimiter, refuse to delete unless the S-expression is empty, in which case delete the whole S-expression. -With a prefix argument, simply delete a character forward, without - regard for delimiter balancing." +With a numeric prefix argument N, delete N characters forward. +With a `C-u' prefix argument, simply delete a character forward, + without regard for delimiter balancing." (interactive "P") - (cond ((or arg (eobp)) + (cond ((or (consp argument) (eobp)) (delete-char 1)) + ((integerp argument) + (if (< argument 0) + (paredit-backward-delete argument) + (while (> argument 0) + (paredit-forward-delete) + (setq argument (- argument 1))))) ((paredit-in-string-p) (paredit-forward-delete-in-string)) ((paredit-in-comment-p) @@ -983,15 +1119,20 @@ With a prefix argument, simply delete a character forward, without ((let ((syn (char-syntax (char-after)))) (or (eq syn ?\( ) (eq syn ?\" ))) - (forward-char)) + (if (save-excursion + (paredit-handle-sexp-errors (progn (forward-sexp) t) + nil)) + (forward-char) + (message "Deleting spurious opening delimiter.") + (delete-char 1))) ((and (not (paredit-in-char-p (1- (point)))) (eq (char-syntax (char-after)) ?\) ) (eq (char-before) (matching-paren (char-after)))) (backward-delete-char 1) ; Empty list -- delete both (delete-char 1)) ; delimiters. ;; Just delete a single character, if it's not a closing - ;; parenthesis. (The character literal case is already - ;; handled by now.) + ;; delimiter. (The character literal case is already handled + ;; by now.) ((not (eq (char-syntax (char-after)) ?\) )) (delete-char 1)))) @@ -1018,17 +1159,25 @@ With a prefix argument, simply delete a character forward, without (backward-delete-char 1) (delete-char 1))))) * -(defun paredit-backward-delete (&optional arg) +(defun paredit-backward-delete (&optional argument) "Delete a character backward or move backward over a delimiter. If on a closing S-expression delimiter, move backward into the S-expression. If on an opening S-expression delimiter, refuse to delete unless the S-expression is empty, in which case delete the whole S-expression. -With a prefix argument, simply delete a character backward, without - regard for delimiter balancing." +With a numeric prefix argument N, delete N characters backward. +With a `C-u' prefix argument, simply delete a character backward, + without regard for delimiter balancing." (interactive "P") - (cond ((or arg (bobp)) - (backward-delete-char 1)) ;++ should this untabify? + (cond ((or (consp argument) (bobp)) + ;++ Should this untabify? + (backward-delete-char 1)) + ((integerp argument) + (if (< argument 0) + (paredit-forward-delete (- 0 argument)) + (while (> argument 0) + (paredit-backward-delete) + (setq argument (- argument 1))))) ((paredit-in-string-p) (paredit-backward-delete-in-string)) ((paredit-in-comment-p) @@ -1041,13 +1190,18 @@ With a prefix argument, simply delete a character backward, without ((let ((syn (char-syntax (char-before)))) (or (eq syn ?\) ) (eq syn ?\" ))) - (backward-char)) + (if (save-excursion + (paredit-handle-sexp-errors (progn (backward-sexp) t) + nil)) + (backward-char) + (message "Deleting spurious closing delimiter.") + (backward-delete-char 1))) ((and (eq (char-syntax (char-before)) ?\( ) (eq (char-after) (matching-paren (char-before)))) (backward-delete-char 1) ; Empty list -- delete both (delete-char 1)) ; delimiters. - ;; Delete it, unless it's an opening parenthesis. The case - ;; of character literals is already handled by now. + ;; Delete it, unless it's an opening delimiter. The case of + ;; character literals is already handled by now. ((not (eq (char-syntax (char-before)) ?\( )) (backward-delete-char-untabify 1)))) @@ -1076,15 +1230,18 @@ With a prefix argument, simply delete a character backward, without * ;;;; Killing -(defun paredit-kill (&optional arg) +(defun paredit-kill (&optional argument) "Kill a line as if with `kill-line', but respecting delimiters. In a string, act exactly as `kill-line' but do not kill past the closing string delimiter. On a line with no S-expressions on it starting after the point or within a comment, act exactly as `kill-line'. -Otherwise, kill all S-expressions that start after the point." +Otherwise, kill all S-expressions that start after the point. +With a `C-u' prefix argument, just do the standard `kill-line'. +With a numeric prefix argument N, do `kill-line' that many times." (interactive "P") - (cond (arg (kill-line)) + (cond (argument + (kill-line (if (integerp argument) argument 1))) ((paredit-in-string-p) (paredit-kill-line-in-string)) ((or (paredit-in-comment-p) @@ -1263,7 +1420,7 @@ Otherwise, kill all S-expressions that start after the point." (backward-char 1))))) (backward-kill-word 1)) * -;;; Word-Killing Auxiliaries +;;;;;; Word-Killing Auxiliaries (defun paredit-kill-word-state (parse-state adjacent-char-fn) (cond ((paredit-in-comment-p parse-state) 'comment) @@ -1355,34 +1512,86 @@ With a prefix argument N, encompass all N S-expressions forward." (lines-on-sexps (count-lines start-point end-point))) (goto-line (+ start-line (/ lines-on-sexps 2))) (recenter))))) + +(defun paredit-focus-on-defun () + "Moves display to the top of the definition at point." + (interactive) + (beginning-of-defun) + (recenter 0)) * ;;;; Depth-Changing Commands: Wrapping, Splicing, & Raising -(defun paredit-wrap-sexp (&optional n) - "Wrap the following S-expression in a list. -If a prefix argument N is given, wrap N S-expressions. +(defun paredit-wrap-sexp (&optional argument open close) + "Wrap the following S-expression. +If a `C-u' prefix argument is given, wrap all S-expressions following + the point until the end of the buffer or of the enclosing list. +If a numeric prefix argument N is given, wrap N S-expressions. Automatically indent the newly wrapped S-expression. As a special case, if the point is at the end of a list, simply insert - a pair of parentheses, rather than insert a lone opening parenthesis - and then signal an error, in the interest of preserving structure." + a parenthesis pair, rather than inserting a lone opening delimiter + and then signalling an error, in the interest of preserving + structure. +By default OPEN and CLOSE are round delimiters." (interactive "P") - (paredit-handle-sexp-errors - (paredit-insert-pair (or n - (and (not (paredit-region-active-p)) - 1)) - ?\( ?\) - 'goto-char) - (insert ?\) ) - (backward-char)) + (paredit-lose-if-not-in-sexp 'paredit-wrap-sexp) + (let ((open (or open ?\( )) + (close (or close ?\) ))) + (paredit-handle-sexp-errors + ((lambda (n) (paredit-insert-pair n open close 'goto-char)) + (cond ((integerp argument) argument) + ((consp argument) (paredit-count-sexps-forward)) + ((paredit-region-active-p) nil) + (t 1))) + (insert close) + (backward-char))) (save-excursion (backward-up-list) (indent-sexp))) +(defun paredit-count-sexps-forward () + (save-excursion + (let ((n 0)) + (paredit-ignore-sexp-errors + (while (not (eobp)) + (forward-sexp) + (setq n (+ n 1)))) + n))) + +(defun paredit-yank-pop (&optional argument) + "Replace just-yanked text with the next item in the kill ring. +If this command follows a `yank', just run `yank-pop'. +If this command follows a `paredit-wrap-sexp', or any other paredit + wrapping command (see `paredit-wrap-commands'), run `yank' and + reindent the enclosing S-expression. +If this command is repeated, run `yank-pop' and reindent the enclosing + S-expression. + +The argument is passed on to `yank' or `yank-pop'; see their + documentation for details." + (interactive "*p") + (cond ((eq last-command 'yank) + (yank-pop argument)) + ((memq last-command paredit-wrap-commands) + (yank argument) + ;; `yank' futzes with `this-command'. + (setq this-command 'paredit-yank-pop) + (save-excursion (backward-up-list) (indent-sexp))) + ((eq last-command 'paredit-yank-pop) + ;; Pretend we just did a `yank', so that we can use + ;; `yank-pop' without duplicating its definition. + (setq last-command 'yank) + (yank-pop argument) + ;; Return to our original state. + (setq last-command 'paredit-yank-pop) + (setq this-command 'paredit-yank-pop) + (save-excursion (backward-up-list) (indent-sexp))) + (t (error "Last command was not a yank or a wrap: %s" last-command)))) +* ;;; Thanks to Marco Baringer for the suggestion of a prefix argument ;;; for PAREDIT-SPLICE-SEXP. (I, Taylor R. Campbell, however, still ;;; implemented it, in case any of you lawyer-folk get confused by the ;;; remark in the top of the file about explicitly noting code written ;;; by other people.) -(defun paredit-splice-sexp (&optional arg) +(defun paredit-splice-sexp (&optional argument) "Splice the list that the point is on by removing its delimiters. With a prefix argument as in `C-u', kill all S-expressions backward in the current list before splicing all S-expressions forward into the @@ -1393,47 +1602,53 @@ With two prefix arguments as in `C-u C-u', kill all S-expressions 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. -This always creates a new entry on the kill ring." +Inside a string, unescape all backslashes, or signal an error if doing + so would invalidate the buffer's structure." (interactive "P") - (save-excursion - (paredit-kill-surrounding-sexps-for-splice arg) - (backward-up-list) ; Go up to the beginning... + (if (paredit-in-string-p) + (paredit-splice-string argument) (save-excursion - (forward-sexp) ; Go forward an expression, to - (backward-delete-char 1)) ; delete the end delimiter. - (delete-char 1) ; ...to delete the open char. - (paredit-ignore-sexp-errors - (backward-up-list) ; Reindent, now that the - (indent-sexp)))) ; structure has changed. - -(defun paredit-kill-surrounding-sexps-for-splice (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 + (paredit-kill-surrounding-sexps-for-splice argument) + (backward-up-list) ; Go up to the beginning... + (save-excursion + (forward-sexp) ; Go forward an expression, to + (backward-delete-char 1)) ; delete the end delimiter. + (delete-char 1) ; ...to delete the open char. + (paredit-ignore-sexp-errors + (backward-up-list) ; Reindent, now that the + (indent-sexp))))) ; structure has changed. + +(defun paredit-kill-surrounding-sexps-for-splice (argument) + (cond ((or (paredit-in-string-p) + (paredit-in-comment-p)) + (error "Invalid context for splicing S-expressions.")) + ((or (not argument) (eq argument 0)) nil) + ((or (numberp argument) (eq argument '-)) + ;; Kill S-expressions before/after the point by saving the + ;; point, moving across them, and killing the region. + (let* ((argument (if (eq argument '-) -1 argument)) + (saved (paredit-point-at-sexp-boundary (- argument)))) + (goto-char saved) + (paredit-ignore-sexp-errors (backward-sexp argument)) + (paredit-hack-kill-region saved (point)))) + ((consp argument) + (let ((v (car argument))) + (if (= v 4) ;One `C-u'. ;; Move backward until we hit the open paren; then ;; kill that selected region. - (let ((end (paredit-point-at-sexp-start))) + (let ((end (point))) (paredit-ignore-sexp-errors (while (not (bobp)) (backward-sexp))) - (kill-region-new (point) end)) + (paredit-hack-kill-region (point) end)) ;; Move forward until we hit the close paren; then ;; kill that selected region. - (let ((beginning (paredit-point-at-sexp-end))) + (let ((beginning (point))) (paredit-ignore-sexp-errors (while (not (eobp)) (forward-sexp))) - (kill-region-new beginning (point)))))) - (t (error "Bizarre prefix argument: %s" arg)))) + (paredit-hack-kill-region beginning (point)))))) + (t (error "Bizarre prefix argument `%s'." argument)))) * (defun paredit-splice-sexp-killing-backward (&optional n) "Splice the list the point is on by removing its delimiters, and @@ -1458,14 +1673,14 @@ With a prefix argument N, kill only the following N S-expressions." With a prefix argument N, raise the following N S-expressions. If N is negative, raise the preceding N S-expressions." (interactive "p") + (paredit-lose-if-not-in-sexp 'paredit-raise-sexp) ;; Select the S-expressions we want to raise in a buffer substring. (let* ((bound (save-excursion (forward-sexp n) (point))) - (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))))) + (sexps (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) @@ -1475,6 +1690,73 @@ With a prefix argument N, raise the following N S-expressions. If N (while (> n 0) (paredit-forward-and-indent) (setq n (1- n))))))) + +(defun paredit-convolute-sexp (&optional n) + "Convolute S-expressions. +Save the S-expressions preceding point and delete them. +Splice the S-expressions following point. +Wrap the enclosing list in a new list prefixed by the saved text. +With a prefix argument N, move up N lists before wrapping." + (interactive "p") + (paredit-lose-if-not-in-sexp 'paredit-convolute-sexp) + (let (open close) ;++ Is this a good idea? + (let ((prefix + (let ((end (point))) + (paredit-ignore-sexp-errors + (while (not (bobp)) (backward-sexp))) + (prog1 (buffer-substring (point) end) + (backward-up-list) + (save-excursion (forward-sexp) + (setq close (char-before)) + (backward-delete-char 1)) + (setq open (char-after)) + (delete-region (point) end))))) + (backward-up-list n) + (paredit-insert-pair 1 open close 'goto-char) + (insert prefix) + (backward-up-list) + (paredit-ignore-sexp-errors (indent-sexp))))) +* +(defun paredit-splice-string (argument) + (let ((original-point (point)) + (start+end (paredit-string-start+end-points))) + (let ((start (car start+end)) + (end (cdr start+end))) + ;; START and END both lie before the respective quote + ;; characters, which we want to delete; thus we increment START + ;; by one to extract the string, and we increment END by one to + ;; delete the string. + (let* ((escaped-string + (cond ((not (consp argument)) + (buffer-substring (1+ start) end)) + ((= 4 (car argument)) + (buffer-substring original-point end)) + (t + (buffer-substring (1+ start) original-point)))) + (unescaped-string + (paredit-unescape-string escaped-string))) + (if (not unescaped-string) + (error "Unspliceable string.") + (save-excursion + (goto-char start) + (delete-region start (1+ end)) + (insert unescaped-string)) + (if (not (and (consp argument) + (= 4 (car argument)))) + (goto-char (- original-point 1)))))))) + +(defun paredit-unescape-string (string) + (with-temp-buffer + (insert string) + (goto-char (point-min)) + (while (and (not (eobp)) + ;; nil -> no bound; t -> no errors. + (search-forward "\\" nil t)) + (delete-char -1) + (forward-char)) + (condition-case condition + (progn (check-parens) (buffer-string)) + (error nil)))) * ;;;; Slurpage & Barfage @@ -1490,7 +1772,7 @@ If in a string, move the opening double-quote forward by one (save-excursion (cond ((or (paredit-in-comment-p) (paredit-in-char-p)) - (error "Invalid context for slurpage")) + (error "Invalid context for slurping S-expressions.")) ((paredit-in-string-p) (paredit-forward-slurp-into-string)) (t @@ -1505,7 +1787,11 @@ If in a string, move the opening double-quote forward by one (paredit-handle-sexp-errors ; list if it's not in this, (progn (paredit-forward-and-indent) (throw 'return nil)) - (up-list)))) + (up-list) + (setq close ; adjusting for mixed + (prog1 (char-before) ; delimiters as necessary, + (backward-delete-char 1) + (insert close)))))) (insert close))) ; to insert that delimiter. (defun paredit-forward-slurp-into-string () @@ -1524,6 +1810,7 @@ If in a string, move the opening double-quote forward by one Automatically reindent the newly barfed S-expression with respect to its new enclosing form." (interactive) + (paredit-lose-if-not-in-sexp 'paredit-forward-slurp-sexp) (save-excursion (up-list) ; Up to the end of the list to (let ((close (char-before))) ; save and delete the closing @@ -1551,7 +1838,7 @@ If in a string, move the opening double-quote backward by one (save-excursion (cond ((or (paredit-in-comment-p) (paredit-in-char-p)) - (error "Invalid context for slurpage")) + (error "Invalid context for slurping S-expressions.")) ((paredit-in-string-p) (paredit-backward-slurp-into-string)) (t @@ -1564,12 +1851,14 @@ If in a string, move the opening double-quote backward by one (catch 'return (while t (paredit-handle-sexp-errors - (progn (backward-sexp) - (throw 'return nil)) - (backward-up-list)))) + (progn (backward-sexp) (throw 'return nil)) + (backward-up-list) + (setq open + (prog1 (char-after) + (save-excursion (insert open) (delete-char 1))))))) (insert open)) ;; Reindent the line at the beginning of wherever we inserted the - ;; opening parenthesis, and then indent the whole S-expression. + ;; opening delimiter, and then indent the whole S-expression. (backward-up-list) (lisp-indent-line) (indent-sexp)) @@ -1593,6 +1882,7 @@ If in a string, move the opening double-quote backward by one Automatically reindent the barfed S-expression and the form from which it was barfed." (interactive) + (paredit-lose-if-not-in-sexp 'paredit-forward-slurp-sexp) (save-excursion (backward-up-list) (let ((open (char-after))) @@ -1603,8 +1893,7 @@ Automatically reindent the barfed S-expression and the form from which (eq (char-after) ?\; )) (forward-line 1)) (if (eobp) - (error - "Barfing all subexpressions with no close-paren?")) + (error "Barfing all subexpressions with no close-paren?")) ;** Don't use `insert' here. Consider, e.g., barfing from ;** (foo|) ;** and how `save-excursion' works. @@ -1623,7 +1912,7 @@ Automatically reindent the barfed S-expression and the form from which (save-excursion (insert " \""))) ((or (paredit-in-comment-p) (paredit-in-char-p)) - (error "Invalid context for `paredit-split-sexp'")) + (error "Invalid context for splitting S-expression.")) (t (let ((open (save-excursion (backward-up-list) (char-after))) (close (save-excursion (up-list) @@ -1644,10 +1933,9 @@ Both must be lists, strings, or atoms; error if there is a mismatch." (if (or (paredit-in-comment-p) (paredit-in-string-p) (paredit-in-char-p)) - (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)))) + (error "Invalid context for joining S-expressions.") + (let ((left-point (paredit-point-at-sexp-end)) + (right-point (paredit-point-at-sexp-start))) (let ((left-char (char-before left-point)) (right-char (char-after right-point))) (let ((left-syntax (char-syntax left-char)) @@ -1676,6 +1964,47 @@ Both must be lists, strings, or atoms; error if there is a mismatch." (t (error "Mismatched S-expressions to join."))))))))) * +;;;; Variations on the Lurid Theme + +;;; I haven't the imagination to concoct clever names for these. + +(defun paredit-add-to-previous-list () + "Add the S-expression following point to the list preceding point." + (interactive) + (paredit-lose-if-not-in-sexp 'paredit-add-to-previous-list) + (save-excursion + (backward-down-list) + (paredit-forward-slurp-sexp))) + +(defun paredit-add-to-next-list () + "Add the S-expression preceding point to the list following point. +If no S-expression precedes point, move up the tree until one does." + (interactive) + (paredit-lose-if-not-in-sexp 'paredit-add-to-next-list) + (save-excursion + (down-list) + (paredit-backward-slurp-sexp))) + +(defun paredit-join-with-previous-list () + "Join the list the point is on with the previous list in the buffer." + (interactive) + (paredit-lose-if-not-in-sexp 'paredit-join-with-previous-list) + (save-excursion + (while (paredit-handle-sexp-errors (save-excursion (backward-sexp) nil) + (backward-up-list) + t)) + (paredit-join-sexps))) + +(defun paredit-join-with-next-list () + "Join the list the point is on with the next list in the buffer." + (interactive) + (paredit-lose-if-not-in-sexp 'paredit-join-with-next-list) + (save-excursion + (while (paredit-handle-sexp-errors (save-excursion (forward-sexp) nil) + (up-list) + t)) + (paredit-join-sexps))) +* ;;;; Utilities (defun paredit-in-string-escape-p () @@ -1690,7 +2019,7 @@ This assumes that `paredit-in-string-p' has already returned true." (backward-char))) oddp)) -(defun paredit-in-char-p (&optional arg) +(defun paredit-in-char-p (&optional argument) "True if the point is immediately after a character literal. A preceding escape character, not preceded by another escape character, is considered a character literal prefix. (This works for elisp, @@ -1699,9 +2028,9 @@ Assumes that `paredit-in-string-p' is false, so that it need not handle long sequences of preceding backslashes in string escapes. (This assumes some other leading character token -- ? in elisp, # in Scheme and Common Lisp.)" - (let ((arg (or arg (point)))) - (and (eq (char-before arg) ?\\ ) - (not (eq (char-before (1- arg)) ?\\ ))))) + (let ((argument (or argument (point)))) + (and (eq (char-before argument) ?\\ ) + (not (eq (char-before (1- argument)) ?\\ ))))) (defun paredit-forward-and-indent () "Move forward an S-expression, indenting it fully. @@ -1726,7 +2055,7 @@ If TRAILING-P is nil, skip leading whitespace; otherwise, skip trailing (lambda () (and mark-active transient-mark-mode))))) -(defun kill-region-new (start end) +(defun paredit-hack-kill-region (start end) "Kill the region between START and END. Do not append to any current kill, and do not let the next kill append to this one." @@ -1794,14 +2123,22 @@ If no parse state is supplied, compute one from the beginning of the ((> n 0) (paredit-point-at-sexp-end)))) (defun paredit-point-at-sexp-start () - (forward-sexp) - (backward-sexp) - (point)) + (save-excursion + (forward-sexp) + (backward-sexp) + (point))) (defun paredit-point-at-sexp-end () - (backward-sexp) - (forward-sexp) - (point)) + (save-excursion + (backward-sexp) + (forward-sexp) + (point))) + +(defun paredit-lose-if-not-in-sexp (command) + (if (or (paredit-in-string-p) + (paredit-in-comment-p) + (paredit-in-char-p)) + (error "Invalid context for command `%s'." command))) * ;;;; Initialization site-lisp/paredit.el @@ -1,7 +1,7 @@ ;;; -*- Mode: Emacs-Lisp; outline-regexp: ";;;+ [^\n]\\|(" -*- ;;;;;; redshank.el --- Common Lisp Editing Extensions -;; Copyright (C) 2006, 2007 Michael Weber +;; Copyright (C) 2006, 2007, 2008 Michael Weber ;; Author: Michael Weber <michaelw@foldr.org> ;; Keywords: languages, lisp @@ -9,21 +9,19 @@ ;; Redshank, n. A common Old World limicoline bird (Totanus ;; calidris), having the legs and feet pale red. The spotted ;; redshank (T. fuscus) is larger, and has orange-red legs. -;; Called also redleg and _clee_. +;; Called also redleg and _CLEE_. ;;;; Commentary ;;; Setup ;; Add this to your Emacs configuration: ;; -;; (add-to-list 'load-path "/path/to/redshank/") -;; (autoload 'redshank-mode "redshank" -;; "Minor mode for editing and refactoring (Common) Lisp code." -;; t) -;; (autoload 'turn-on-redshank-mode "redshank" -;; "Turn on Redshank mode. Please see function `redshank-mode'." -;; t) -;; (add-hook '...-mode-hook 'turn-on-redshank-mode) +;; (require 'redshank-loader +;; "/path/redshank/redshank-loader") +;; +;; (eval-after-load "redshank-loader" +;; `(redshank-setup '(lisp-mode-hook +;; slime-repl-mode-hook) t)) ;; ;; Also, this mode can be enabled with M-x redshank-mode. ;; @@ -41,14 +39,10 @@ ;; '(progn ...redefine keys, etc....)) ;; ;; Some of the skeleton functions (like `redshank-in-package-skeleton' or -;; `redshank-mode-line-skeleton') are good candidates for autoinsert: +;; `redshank-mode-line-skeleton') are good candidates for autoinsert. +;; See `redshank-setup' (in file redshank-loader.el) for examples. ;; -;; (add-to-list 'auto-insert-alist '(lisp-mode . redshank-in-package-skeleton)) -;; (add-to-list 'auto-insert-alist '(asdf-mode . redshank-asdf-defsystem-skeleton)) -;; (add-to-list 'auto-mode-alist '("\\.asdf?\\'" . asdf-mode)) -;; -;; -;; This code was tested with Paredit 20, and should run at least in +;; This code was tested with Paredit 21, and should run at least in ;; GNU Emacs 22 and later. ;;; To Do @@ -107,24 +101,44 @@ are not available." :type 'boolean :group 'redshank) +(defcustom redshank-canonical-slot-name-function 'identity + "*Function which, given a slot-name, returns a canonicalized +slot name. Use it to enforce certain slot naming style." + :type '(radio + (function-item redshank-canonical-slot-name/%) + (function-item identity) + (function :tag "Other")) + :group 'redshank) + (defcustom redshank-accessor-name-function 'redshank-accessor-name/get "*Function which, given a slot-name, returns the accessor name." :type '(radio (function-item redshank-accessor-name/get) (function-item redshank-accessor-name/of) + (function-item redshank-accessor-name/ref) (function-item redshank-accessor-name/%) (function :tag "Other")) :group 'redshank) -(defcustom redshank-canonical-slot-name-function 'identity - "*Function which, given a slot-name, returns a canonicalized -slot name. Use it to enforce certain slot naming style." +(defcustom redshank-initarg-name-function 'redshank-initarg-name/keyword + "*Function which, given a slot-name, returns a fitting initarg name." :type '(radio - (function-item redshank-canonical-slot-name/%) - (function-item identity) + (function-item redshank-initarg-name/keyword) + (function-item redshank-initarg-name/symbol) (function :tag "Other")) :group 'redshank) +(defcustom redshank-canonical-package-designator-function + 'redshank-package-designator/uninterned-symbol + "*Function which, given a package-name, returns a canonicalized +package designator." + :type '(radio + (function-item redshank-package-designator/uninterned-symbol) + (function-item redshank-package-designator/keyword) + (function-item redshank-package-designator/symbol) + (function-item redshank-package-designator/string) + (function :tag "Other")) + :group 'redshank) (defcustom redshank-licence-names '("BSD-style" "GPL" "LGPL" "LLGPL" "MIT" "MIT-style") "List of (short) licence names." @@ -153,6 +167,20 @@ _darcs, .git)." :type 'string :group 'redshank) +(defvar redshank-form-generator-alist + '((lisp-mode + ("defclass" . redshank-defclass-skeleton) + ("defpackage" . redshank-defpackage-skeleton) + ("in-package" . redshank-in-package-skeleton) + ("defsystem" . redshank-asdf-defsystem-skeleton) + (t . redshank-lisp-generate-form)) + (emacs-lisp-mode + (t . redshank-elisp-generate-form))) + "Alist of shape \((MODE . MODE-ALIST)...). MODE-ALIST is an +alist of shape \((KEY . GENERATOR)...), where key is a either +a string, a function, or the symbol T, and GENERATOR a nullary +function.") + (eval-and-compile (defvar redshank-path (let ((path (or (locate-library "redshank") load-file-name))) @@ -170,6 +198,7 @@ Emacs Lisp package.")) [ "Condify" redshank-condify-form t ] [ "Extract to Defun" redshank-extract-to-defun ,CONNECTEDP ] [ "Extract to Enclosing Let" redshank-letify-form-up t ] + [ "Enclose form with Lambda" redshank-enclose-form-with-lambda ] [ "Rewrite Negated Predicate" redshank-rewrite-negated-predicate t ] [ "Splice Progn" redshank-maybe-splice-progn t ] [ "Wrap into Eval-When" redshank-eval-whenify-form t ] @@ -193,11 +222,14 @@ Emacs Lisp package.")) ("e" . redshank-eval-whenify-form) ("f" . redshank-complete-form) ("l" . redshank-letify-form-up) + ("C-l" . redshank-enclose-form-with-lambda) ("n" . redshank-rewrite-negated-predicate) ("p" . redshank-maybe-splice-progn) ("x" . redshank-extract-to-defun) ("C" . redshank-defclass-skeleton) ("P" . redshank-defpackage-skeleton) + ("I" . redshank-in-package-skeleton) + ("M" . redshank-mode-line-skeleton) ("S" . redshank-defclass-slot-skeleton)) "Standard key bindings for the Redshank minor mode.") @@ -210,10 +242,14 @@ Emacs Lisp package.")) (define-key map (kbd "M-<mouse-1>") 'redshank-ignore-event) (define-key map (kbd "M-<drag-mouse-1>") 'redshank-ignore-event) (define-key map (kbd "M-<down-mouse-1>") 'redshank-copy-thing-at-point) + (define-key map (kbd "M-S-<mouse-1>") 'redshank-ignore-event) + (define-key map (kbd "M-S-<drag-mouse-1>") 'redshank-ignore-event) + (define-key map (kbd "M-S-<down-mouse-1>") 'redshank-generate-thing-at-point) (easy-menu-define menu-bar-redshank map "Redshank" redshank-menu) map) "Keymap for the Redshank minor mode.") +;;;###autoload (define-minor-mode redshank-mode "Minor mode for editing and refactoring (Common) Lisp code. @@ -223,6 +259,7 @@ Emacs Lisp package.")) (when redshank-mode (easy-menu-add menu-bar-redshank redshank-mode-map))) +;;;###autoload (defun turn-on-redshank-mode () "Turn on Redshank mode. Please see function `redshank-mode'. @@ -238,19 +275,23 @@ This function is designed to be added to hooks, for example: (slime-connected-p) (slime-eval `(cl:packagep (cl:find-package :redshank))))) +(defun redshank-accessor-name/% (slot-name) + "Removes preceding percent signs (%) from slot names." + (if (string-match "^%+\\(.*\\)$" slot-name) + (match-string-no-properties 1 slot-name) + slot-name)) + (defun redshank-accessor-name/get (slot-name) "GET-SLOT style accessor names." - (concat "get-" slot-name)) + (concat "get-" (redshank-accessor-name/% slot-name))) (defun redshank-accessor-name/of (slot-name) "SLOT-OF style accessor names." - (concat slot-name "-of")) + (concat (redshank-accessor-name/% slot-name) "-of")) -(defun redshank-accessor-name/% (slot-name) - "Removes preceding percent signs (%) from slot names." - (string-match "^%+\\(.*\\)$" slot-name) - (or (match-string 1 slot-name) - slot-name)) +(defun redshank-accessor-name/ref (slot-name) + "SLOT-REF style accessor names." + (concat (redshank-accessor-name/% slot-name) "-ref")) (defun redshank-accessor-name (slot-name) (if (functionp redshank-accessor-name-function) @@ -271,6 +312,18 @@ ensure certain style in naming your slots, for instance (funcall redshank-canonical-slot-name-function slot-name) slot-name)) +(defun redshank-initarg-name (slot-name) + (if (functionp redshank-initarg-name-function) + (funcall redshank-initarg-name-function slot-name) + (redshank-initarg-name/keyword slot-name))) + +(defun redshank-initarg-name/keyword (slot-name) + (concat ":" (redshank-accessor-name/% slot-name))) + +(defun redshank-initarg-name/symbol (slot-name) + (concat "'" (redshank-accessor-name/% slot-name))) + +;;; (defun redshank--looking-at-or-inside (spec) (let ((form-regex (concat "(" spec "\\S_")) (here.point (point))) @@ -312,6 +365,36 @@ LABELS or FLET.)" (defun redshank--symbol-namep (symbol) (and (stringp symbol) (not (string= symbol "")))) + +(defun redshank--trim-whitespace (string) + (when (string-match "^\\s *\\(.*?\\)\\s *$" string) + (match-string-no-properties 1 string))) + +(defun redshank-canonical-package-name (package-name) + (and package-name (not (string= "" package-name)) + ;; very naive + (lexical-let ((package-name (redshank--trim-whitespace package-name))) + (if (string-match "^#?:\\(.*\\)$" package-name) + (match-string-no-properties 1 package-name) + package-name)))) + +(defun redshank-canonical-package-designator (package-name) + (and package-name (not (string= "" package-name)) + (funcall redshank-canonical-package-designator-function + (redshank-canonical-package-name package-name)))) + +(defun redshank-package-designator/uninterned-symbol (package-name) + (concat "#:" (downcase package-name))) + +(defun redshank-package-designator/keyword (package-name) + (concat ":" (downcase package-name))) + +(defun redshank-package-designator/symbol (package-name) + (downcase package-name)) + +(defun redshank-package-designator/string (package-name) + (prin1-to-string (upcase package-name))) + * (defun redshank--end-of-sexp-column () "Move point to end of current form, neglecting trailing whitespace." @@ -373,6 +456,44 @@ but does otherwise nothing." (paredit-doublequote) nil)) * +;; lenient variant of `slime-read-package-name' +(defun redshank-read-package-name (prompt &optional initial-value) + "Read a package name from the minibuffer, prompting with PROMPT." + (let ((completion-ignore-case t)) + (redshank-canonical-package-name + (completing-read prompt (when (and (featurep 'slime) + (redshank-connected-p)) + (slime-bogus-completion-alist + (slime-eval + `(swank:list-all-package-names t)))) + nil nil initial-value nil initial-value)))) + +(defun redshank-find-potential-buffer-package () + (redshank-canonical-package-name + (or slime-buffer-package + (and (fboundp 'slime-find-buffer-package) + (slime-find-buffer-package)) + (let ((case-fold-search t) + (regexp (concat "^(\\(cl:\\|common-lisp:\\)?defpackage\\>[ \t']*" + "\\([^()]+\\)"))) + (save-excursion + (when (or (re-search-backward regexp nil t) + (re-search-forward regexp nil t)) + (match-string-no-properties 2))))))) + +(defun redshank--assoc-match (key alist) + (loop for entry in alist do + (cond ((stringp (car entry)) + (when (eq t (compare-strings (car entry) 0 nil + key 0 nil + case-fold-search)) + (return entry))) + ((functionp (car entry)) + (when (funcall (car entry) key) + (return entry))) + ((eq t (car entry)) + (return entry))))) +* ;;; ASDF (defun redshank-walk-filesystem (spec enter-fn leave-fn) (when (and (funcall enter-fn @@ -479,7 +600,7 @@ Uses `slime-read-system-name' if it is available." `(cl:progn (cl:pushnew (cl:pathname ,redshank-path) swank::*load-path* :test 'cl:equal) - (swank:swank-require :redshank)))) + (cl:ignore-errors (swank:swank-require :redshank))))) (defun redshank-slime-install () "Install Redshank hook for SLIME connections." @@ -560,12 +681,39 @@ involves macro-exanding code, and as such might have side effects." (insert form-string ")\n") (goto-char (point-min)) (indent-sexp) - (kill-region-new (point-min) (point-max)) + (paredit-hack-kill-region (point-min) (point-max)) (message (substitute-command-keys "Extracted function `%s' now on kill ring; \\[yank] to insert at point.") ; name)) (delete-region start end) (princ (list* name free-vars) (current-buffer))))) + +(defun redshank-enclose-form-with-lambda (arglist) + "Enclose form with lambda expression with parameter VAR. +With prefix argument ARG, enclose ARG upward forms. + +Example: + \(foo x (bar y| z) qux) + +\\[redshank-enclose-form-with-lambda] RET RET yields: + + \(foo x (lambda (y) (bar y| z)) qux)" + (interactive + (let ((arglist (thing-at-point 'symbol))) + (when (and (stringp arglist) + (string-match "[(]" arglist)) + (setq arglist "")) + (list (read-string "Lambda arglist: " arglist)))) + (save-excursion + (call-interactively 'backward-up-list) + (paredit-wrap-sexp +1) + (insert "lambda (" arglist ")") + (if (> (- (line-end-position) (line-beginning-position)) + (current-fill-column)) + (newline) + (insert " ")) + (backward-up-list) + (indent-sexp))) * (defun redshank-condify-form () "Transform a Common Lisp IF form into an equivalent COND form." @@ -686,20 +834,20 @@ If point is not in a slot form, fall back to `slime-complete-form'. \\<redshank-mode-map>\\[redshank-complete-form] \(defclass foo () - (... - (slot-n |) + \(... + \(slot-n |) ...)) -> \(defclass foo () - (... - (slot-n :accessor get-slot-n :initarg :slot-n)| + \(... + \(slot-n :accessor get-slot-n :initarg :slot-n)| ...))" (interactive "*") (if (not (redshank--defclass-slot-form-at-point-p)) (call-interactively 'slime-complete-form) (backward-up-list) (down-list) - (let ((slot-name (thing-at-point 'symbol))) + (let ((slot-name (substring-no-properties (thing-at-point 'symbol)))) (when slot-name (forward-sexp) (just-one-space) @@ -709,7 +857,7 @@ If point is not in a slot form, fall back to `slime-complete-form'. (forward-sexp))) (delete-region start (point))) (insert ":accessor " (redshank-accessor-name slot-name) - " :initarg :" slot-name) + " :initarg " (redshank-initarg-name slot-name)) (up-list) (when redshank-reformat-defclass-forms (save-excursion @@ -753,55 +901,119 @@ This should be bound to a mouse click event type." (when (redshank--region-active-p) (delete-region (region-beginning) (region-end))) (unless (or (bolp) + (and (minibufferp) + (= (point) (minibuffer-prompt-end))) (save-excursion (backward-char) - (looking-at "\\s-\\|\\s("))) + (looking-at "\\s-\\|\\s\("))) (insert " ")) - (insert contents) - (unless (or (eolp) (looking-at "\\s-\\|\\s)")) - (insert " "))) + (let ((contents.start (point))) + (insert contents) + (unless (or (eolp) + (and (minibufferp) + (= (point) (minibuffer-prompt-end))) + (looking-at "\\s-\\|\\s\)")) + (insert " ")) + (save-excursion + (goto-char contents.start) + (indent-sexp)))) (t (message "Don't know what to copy?")))))) +;;; +(defvar redshank-thing-at-point) + +(defun redshank-elisp-generate-form (&optional name) + (interactive "*") + (require 'eldoc) + (let* ((sym (intern-soft (or name redshank-thing-at-point))) + (args (eldoc-function-argstring sym))) + (save-match-data + (string-match "\\`[^ )]* ?" args) + (setq args (substring args (match-end 0))) + (insert (format "(%s " sym)) + (let ((point (point))) + (insert args) + (goto-char point))))) + +(defun redshank-lisp-generate-form (&optional name) + (interactive "*") + (insert "(" (or name redshank-thing-at-point) " )") + (backward-char +1) + (when (fboundp 'slime-complete-form) + (slime-complete-form))) + +(defun redshank-generate-thing-at-point (event) + "Generates a (mode-specific) form corresponding to the symbol at point. +The actual generator function is determined by +`redshank-form-generator-alist'. + +Generators can access the actual value dispatched on via +REDSHANK-THING-AT-POINT." + (interactive "*e") + (let* ((echo-keystrokes 0) + (start-posn (event-start event)) + (start-point (posn-point start-posn)) + (start-window (posn-window start-posn)) + (redshank-thing-at-point + (with-current-buffer (window-buffer start-window) + (save-excursion + (goto-char start-point) + (thing-at-point 'symbol)))) + (mode-table (assq major-mode redshank-form-generator-alist)) + (generator (redshank--assoc-match redshank-thing-at-point + (cdr mode-table)))) + (if generator + (if (interactive-p) + (call-interactively (cdr generator)) + (funcall (cdr generator))) + (message "Don't know a generator for `%s'." redshank-thing-at-point)))) + ;;;; Skeletons (define-skeleton redshank-mode-line-skeleton "Inserts mode line." nil (concat ";;; -*- Mode:Lisp; Syntax:ANSI-Common-Lisp;" (if buffer-file-coding-system - (concat " Coding:" - (symbol-name - (coding-system-get buffer-file-coding-system - 'mime-charset))) + (let ((coding (coding-system-get buffer-file-coding-system + 'mime-charset))) + (if coding (concat " Coding:" (symbol-name coding)) + "")) "") " -*-") & \n & \n _) (define-skeleton redshank-in-package-skeleton "Inserts mode line and Common Lisp IN-PACKAGE form." - (slime-read-package-name "Package: ") + (redshank-canonical-package-designator + (redshank-read-package-name "Package: " + (redshank-find-potential-buffer-package))) '(if (bobp) (redshank-mode-line-skeleton)) '(paredit-open-parenthesis) - "in-package #:" str + "in-package " str '(paredit-close-parenthesis) \n \n _) (define-skeleton redshank-defpackage-skeleton "Inserts a Common Lisp DEFPACKAGE skeleton." - (skeleton-read "Package: " (or (ignore-errors - (file-name-sans-extension - (file-name-nondirectory - (buffer-file-name)))) - "TEMP")) - '(paredit-open-parenthesis) "defpackage #:" str + (redshank-canonical-package-designator + (skeleton-read "Package: " (or (ignore-errors + (file-name-sans-extension + (file-name-nondirectory + (buffer-file-name)))) + "TEMP"))) + '(paredit-open-parenthesis) "defpackage " str \n '(paredit-open-parenthesis) - ":nicknames" ("Nickname: " " #:" str) + ":nicknames" ((redshank-canonical-package-designator + (skeleton-read "Nickname: ")) " " str) & '(paredit-close-parenthesis) & \n | '(progn (backward-up-list) (kill-sexp)) '(paredit-open-parenthesis) - ":use #:cl" ((downcase (slime-read-package-name "USEd package: ")) " #:" str) + ":use " (redshank-canonical-package-designator "cl") + ((redshank-canonical-package-designator + (redshank-read-package-name "USEd package: ")) " " str) '(paredit-close-parenthesis) '(paredit-close-parenthesis) \n \n _) @@ -854,11 +1066,11 @@ This should be bound to a mouse click event type." ((skeleton-read "Slot: ") '(paredit-open-parenthesis) str - ;; Ugly, but skeleton-read _must_ have the first str literal + ;; Ugly, but skeleton-read _must_ have the first str literal '(backward-delete-char (length str)) - (redshank-canonical-slot-name str) + (redshank-canonical-slot-name str) " :accessor " (redshank-accessor-name str) - " :initarg :" str + " :initarg " (redshank-initarg-name str) '(paredit-close-parenthesis) \n) & '(join-line) '(paredit-close-parenthesis) ;; \n "(:default-initargs " - ")" ;; add to your liking... @@ -872,11 +1084,11 @@ This should be bound to a mouse click event type." '(indent-according-to-mode) '(paredit-open-parenthesis) str - ;; Ugly, but skeleton-read _must_ have the first str literal + ;; Ugly, but skeleton-read _must_ have the first str literal '(backward-delete-char (length str)) - (redshank-canonical-slot-name str) + (redshank-canonical-slot-name str) " :accessor " (redshank-accessor-name str) - " :initarg :" str + " :initarg " (redshank-initarg-name str) '(paredit-close-parenthesis) \n) & '(join-line) _) @@ -897,12 +1109,22 @@ This should be bound to a mouse click event type." (redshank-align-defclass-slots)))) * ;;;; ASDF mode +;;;###autoload (define-derived-mode asdf-mode lisp-mode "ASDF" "Major mode for ASDF files. This mode is derived from `lisp-mode' and activates minor mode `redshank-mode' by default. \\{asdf-mode-map}" - (redshank-mode +1)) + (add-hook 'asdf-mode-hook 'turn-on-redshank-mode)) + +;;;###autoload +(defun turn-on-asdf-mode () + "Turn on ASDF mode. Please see function `asdf-mode'. + +This function is designed to be added to hooks, for example: + \(add-hook 'lisp-mode-hook 'turn-on-asdf-mode)" + (interactive) + (asdf-mode)) ;;;; Initialization (eval-after-load "slime" site-lisp/redshank.el 7817f8d5e57882a4e60b81d280d48cd56858bba4 John Wiegley johnw@newartisans.com http://github.com/jwiegley/ready-lisp/commit/94b90d6401d471b4e0960fd8c43533239e801fcd 94b90d6401d471b4e0960fd8c43533239e801fcd 2009-01-29T20:35:47-08:00 2009-01-29T20:35:47-08:00 Updated paredit.el and redshank.el, and added notes to the NEWS and README. 2797e7fe4ecdbdcc4ff7d9e77d9c7b6182d9eade John Wiegley johnw@newartisans.com