From 4e5ba81795e4ecad01c23b233694476d1508fa3a Mon Sep 17 00:00:00 2001 From: Taylor R Campbell Date: Sat, 6 Jul 2013 21:56:16 +0000 Subject: Make slurping `(|) foo' yield `(|foo)', not `(| foo)'. Likewise for backward slurping and slurping into strings. Add some tests. --- paredit.el | 144 +++++++++++++++++++++++++++++++++++++++---------------------- test.el | 98 +++++++++++++++++++++++++++++++++++++++++ 2 files changed, 190 insertions(+), 52 deletions(-) diff --git a/paredit.el b/paredit.el index 30834d5..0d952cd 100644 --- a/paredit.el +++ b/paredit.el @@ -2254,31 +2254,50 @@ If in a string, move the opening double-quote forward by one (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 - (delete-char -1) ; delimiter. - (let ((start (point))) - (catch 'return ; Go to the end of the desired - (while t ; S-expression, going up a - (paredit-handle-sexp-errors ; list if it's not in this, - (progn (forward-sexp) (throw 'return nil)) - (up-list) - (setq close ; adjusting for mixed - (prog1 (char-before) ; delimiters as necessary, - (delete-char -1) - (insert close)))))) - (insert close) ; to insert that delimiter. - (indent-region start (point) nil)))) - + (let ((nestedp nil)) + (save-excursion + (up-list) ; Up to the end of the list to + (let ((close (char-before))) ; save and delete the closing + (delete-char -1) ; delimiter. + (let ((start (point))) + (catch 'return ; Go to the end of the desired + (while t ; S-expression, going up a + (paredit-handle-sexp-errors ; list if it's not in this, + (progn (forward-sexp) (throw 'return nil)) + (setq nestedp t) + (up-list) + (setq close ; adjusting for mixed + (prog1 (char-before) ; delimiters as necessary, + (delete-char -1) + (insert close)))))) + (insert close) ; to insert that delimiter. + (indent-region start (point) nil)))) + (if (and (not nestedp) + (eq (save-excursion (paredit-skip-whitespace nil) (point)) + (save-excursion (backward-up-list) (forward-char) (point))) + (eq (save-excursion (forward-sexp) (backward-sexp) (point)) + (save-excursion (paredit-skip-whitespace t) (point)))) + (delete-region (save-excursion (paredit-skip-whitespace nil) (point)) + (save-excursion (paredit-skip-whitespace t) (point)))))) + (defun paredit-forward-slurp-into-string () - (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))) - (delete-char -1) - (paredit-forward-for-quote (save-excursion (forward-sexp) (point))) - (insert close))) + (let ((start (paredit-enclosing-string-start)) + (end (paredit-enclosing-string-end))) + (goto-char end) + ;; Signal any errors that we might get first, before mucking with + ;; the buffer's contents. + (save-excursion (forward-sexp)) + (let ((close (char-before))) + ;; Skip intervening whitespace if we're slurping into an empty + ;; string. XXX What about nonempty strings? + (if (and (= (+ start 2) end) + (eq (save-excursion (paredit-skip-whitespace t) (point)) + (save-excursion (forward-sexp) (backward-sexp) (point)))) + (delete-region (- (point) 1) + (save-excursion (paredit-skip-whitespace t) (point))) + (delete-char -1)) + (paredit-forward-for-quote (save-excursion (forward-sexp) (point))) + (insert close)))) (defun paredit-forward-barf-sexp () "Remove the last S-expression in the current list from that list @@ -2321,35 +2340,56 @@ If in a string, move the opening double-quote backward by one (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) - (setq open - (prog1 (char-after) - (save-excursion (insert open) (delete-char +1))))))) - (insert open)) - ;; Reindent the line at the beginning of wherever we inserted the - ;; opening delimiter, and then indent the whole S-expression. - (backward-up-list) - (lisp-indent-line) - (indent-sexp)) - + (let ((nestedp nil)) + (save-excursion + (backward-up-list) + (let ((open (char-after))) + (delete-char +1) + (catch 'return + (while t + (paredit-handle-sexp-errors + (progn (backward-sexp) (throw 'return nil)) + (setq nestedp t) + (backward-up-list) + (setq open + (prog1 (char-after) + (save-excursion (insert open) (delete-char +1))))))) + (insert open)) + ;; Reindent the line at the beginning of wherever we inserted the + ;; opening delimiter, and then indent the whole S-expression. + (backward-up-list) + (lisp-indent-line) + (indent-sexp)) + ;; If we slurped into an empty list, don't leave dangling space: + ;; (foo |). + (if (and (not nestedp) + (eq (save-excursion (paredit-skip-whitespace nil) (point)) + (save-excursion (backward-sexp) (forward-sexp) (point))) + (eq (save-excursion (up-list) (backward-char) (point)) + (save-excursion (paredit-skip-whitespace t) (point)))) + (delete-region (save-excursion (paredit-skip-whitespace nil) (point)) + (save-excursion (paredit-skip-whitespace t) (point)))))) + (defun paredit-backward-slurp-into-string () - (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))) - (delete-char +1) - (backward-sexp) - (insert open) - (paredit-forward-for-quote target))) + (let ((start (paredit-enclosing-string-start)) + (end (paredit-enclosing-string-end))) + (goto-char start) + ;; Signal any errors that we might get first, before mucking with + ;; the buffer's contents. + (save-excursion (backward-sexp)) + (let ((open (char-after)) + (target (point))) + ;; Skip intervening whitespace if we're slurping into an empty + ;; string. XXX What about nonempty strings? + (if (and (= (+ start 2) end) + (eq (save-excursion (paredit-skip-whitespace nil) (point)) + (save-excursion (backward-sexp) (forward-sexp) (point)))) + (delete-region (save-excursion (paredit-skip-whitespace nil) (point)) + (+ (point) 1)) + (delete-char +1)) + (backward-sexp) + (insert open) + (paredit-forward-for-quote target)))) (defun paredit-backward-barf-sexp () "Remove the first S-expression in the current list from that list diff --git a/test.el b/test.el index 2125141..c42f018 100644 --- a/test.el +++ b/test.el @@ -1207,6 +1207,104 @@ Four arguments: the paredit command, the text of the buffer ;++ ("(\"|foo\\\;bar\")" error) )) +(paredit-test 'paredit-forward-slurp-sexp + '(("|" error) + ("|()" error) + ;; ("(|)" error) ;++ Urk... + ("()|" error) + ("|() foo" error) + ("(|) foo" "(|foo)") + ("()| foo" error) + ("() |foo" error) + ("() f|oo" error) + ("() fo|o" error) + ("() foo|" error) + ("|(foo) bar" error) + ("(|foo) bar" "(|foo bar)") + ("(f|oo) bar" "(f|oo bar)") + ("(fo|o) bar" "(fo|o bar)") + ("(foo|) bar" "(foo| bar)") + ("(foo)| bar" error) + ("(foo) |bar" error) + ("(foo) b|ar" error) + ("(foo) ba|r" error) + ("(foo) bar|" error) + ("|\"\"" error) + ;; ("\"|\"" error) ;++ Urk... + ("\"\"|" error) + ("|\"\" foo" error) + ("\"|\" foo" "\"|foo\"") + ("\"\"| foo" error) + ("\"\" |foo" error) + ("\"\" f|oo" error) + ("\"\" fo|o" error) + ("\"\" foo|" error) + ("|\"foo\" bar" error) + ("\"|foo\" bar" "\"|foo bar\"") + ("\"f|oo\" bar" "\"f|oo bar\"") + ("\"fo|o\" bar" "\"fo|o bar\"") + ("\"foo|\" bar" "\"foo| bar\"") + ("\"foo\"| bar" error) + ("\"foo\" |bar" error) + ("\"foo\" b|ar" error) + ("\"foo\" ba|r" error) + ("\"foo\" bar|" error) + ("|\"\" \"\"" error) + ("\"|\" \"\"" "\"|\\\"\\\"\"") + ("\"\"| \"\"" error) + ("\"\" |\"\"" error) + ;; ("\"\" \"|\"" error) ;++ Urk... + ("\"\" \"\"|" error))) + +(paredit-test 'paredit-backward-slurp-sexp + '(("|" error) + ("|()" error) + ;; ("(|)" error) ;++ Urk... + ("()|" error) + ("|foo ()" error) + ("f|oo ()" error) + ("fo|o ()" error) + ("foo| ()" error) + ("foo |()" error) + ("foo (|)" "(foo|)") + ("foo ()|" error) + ("|foo (bar)" error) + ("f|oo (bar)" error) + ("fo|o (bar)" error) + ("foo| (bar)" error) + ("foo |(bar)" error) + ("foo (|bar)" "(foo |bar)") + ("foo (b|ar)" "(foo b|ar)") + ("foo (ba|r)" "(foo ba|r)") + ("foo (bar|)" "(foo bar|)") + ("foo (bar)|" error) + ("|\"\"" error) + ;; ("\"|\"" error) ;++ Urk... + ("\"\"|" error) + ("|foo \"\"" error) + ("f|oo \"\"" error) + ("fo|o \"\"" error) + ("foo| \"\"" error) + ("foo |\"\"" error) + ("foo \"|\"" "\"foo|\"") + ("foo \"\"|" error) + ("|foo \"bar\"" error) + ("f|oo \"bar\"" error) + ("fo|o \"bar\"" error) + ("foo| \"bar\"" error) + ("foo |\"bar\"" error) + ("foo \"|bar\"" "\"foo |bar\"") + ("foo \"b|ar\"" "\"foo b|ar\"") + ("foo \"ba|r\"" "\"foo ba|r\"") + ("foo \"bar|\"" "\"foo bar|\"") + ("foo \"bar\"|" error) + ("|\"\" \"\"" error) + ;; ("\"|\" \"\"" error) ;++ Urk... + ("\"\"| \"\"" error) + ("\"\" |\"\"" error) + ("\"\" \"|\"" "\"\\\"\\\"|\"") + ("\"\" \"\"|" error))) + (defun paredit-canary-indent-method (state indent-point normal-indent) (check-parens) nil) -- cgit v1.2.1