diff options
| -rw-r--r-- | doc/lispref/ChangeLog | 8 | ||||
| -rw-r--r-- | doc/lispref/errors.texi | 5 | ||||
| -rw-r--r-- | doc/lispref/positions.texi | 16 | ||||
| -rw-r--r-- | lisp/ChangeLog | 8 | ||||
| -rw-r--r-- | lisp/emacs-lisp/lisp.el | 116 | ||||
| -rw-r--r-- | test/ChangeLog | 4 | ||||
| -rw-r--r-- | test/automated/syntax-tests.el | 97 |
7 files changed, 221 insertions, 33 deletions
diff --git a/doc/lispref/ChangeLog b/doc/lispref/ChangeLog index 2ae1faffc4e..25fa8ca4946 100644 --- a/doc/lispref/ChangeLog +++ b/doc/lispref/ChangeLog @@ -1,3 +1,11 @@ +2014-04-09 Daniel Colascione <dancol@dancol.org> + + * errors.texi (Standard Errors): Document required error + parameters for `scan-error'. + + * positions.texi (List Motion): Explain new `up-list' arguments. + Mention `backward-up-list'. + 2014-04-08 Daniel Colascione <dancol@dancol.org> * minibuf.texi (Programmed Completion): Improve phrasing, remove diff --git a/doc/lispref/errors.texi b/doc/lispref/errors.texi index e00496e3478..dba8d219774 100644 --- a/doc/lispref/errors.texi +++ b/doc/lispref/errors.texi @@ -157,7 +157,10 @@ The message is @samp{Attempt to modify a protected file}. @item scan-error The message is @samp{Scan error}. This happens when certain syntax-parsing functions find invalid syntax or mismatched -parentheses. @xref{List Motion}, and @xref{Parsing Expressions}. +parentheses. Conventionally raised with three argument: a +human-readable error message, the start of the obstacle that cannot be +moved over, and the end of the obstacle. @xref{List Motion}, and +@xref{Parsing Expressions}. @item search-failed The message is @samp{Search failed}. @xref{Searching and Matching}. diff --git a/doc/lispref/positions.texi b/doc/lispref/positions.texi index f83173e2038..5a77b37e7e1 100644 --- a/doc/lispref/positions.texi +++ b/doc/lispref/positions.texi @@ -647,9 +647,19 @@ parentheses. (Other syntactic entities such as words or paired string quotes are ignored.) @end deffn -@deffn Command up-list &optional arg -This function moves forward out of @var{arg} (default 1) levels of parentheses. -A negative argument means move backward but still to a less deep spot. +@deffn Command up-list &optional arg escape-strings no-syntax-crossing +This function moves forward out of @var{arg} (default 1) levels of +parentheses. A negative argument means move backward but still to a +less deep spot. If @var{escape-strings} is non-nil (as it is +interactively), move out of enclosing strings as well. If +@var{no-syntax-crossing} is non-nil (as it is interactively), prefer +to break out of any enclosing string instead of moving to the start of +a list broken across multiple strings. On error, location of point is +unspecified. +@end deffn + +@deffn Command backward-up-list &optional arg escape-strings no-syntax-crossing +This function is just like @code{up-list}, but with a negated argument. @end deffn @deffn Command down-list &optional arg diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 8f27ffbf636..bab1edaffda 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,11 @@ +2014-04-09 Daniel Colascione <dancol@dancol.org> + + * emacs-lisp/lisp.el (backward-up-list): Add `escape-strings', + `no-syntax-crossing' arguments. Forward to `up-list'. + (up-list): Add `escape-strings', `no-syntax-crossing' arguments. + Implement logic for escaping from strings. Use narrowing to deal + with corner cases. + 2014-04-09 Leo Liu <sdl.web@gmail.com> * net/rcirc.el (rcirc-connection-info): New variable. diff --git a/lisp/emacs-lisp/lisp.el b/lisp/emacs-lisp/lisp.el index 0487515a142..3ff65ff11cd 100644 --- a/lisp/emacs-lisp/lisp.el +++ b/lisp/emacs-lisp/lisp.el @@ -57,10 +57,14 @@ Should take the same arguments and behave similarly to `forward-sexp'.") (defun forward-sexp (&optional arg) "Move forward across one balanced expression (sexp). -With ARG, do it that many times. Negative arg -N means -move backward across N balanced expressions. -This command assumes point is not in a string or comment. -Calls `forward-sexp-function' to do the work, if that is non-nil." +With ARG, do it that many times. Negative arg -N means move +backward across N balanced expressions. This command assumes +point is not in a string or comment. Calls +`forward-sexp-function' to do the work, if that is non-nil. If +unable to move over a sexp, signal `scan-error' with three +arguments: a message, the start of the obstacle (usually a +parenthesis or list marker of some kind), and end of the +obstacle." (interactive "^p") (or arg (setq arg 1)) (if forward-sexp-function @@ -140,38 +144,92 @@ This command assumes point is not in a string or comment." (goto-char (or (scan-lists (point) inc -1) (buffer-end arg))) (setq arg (- arg inc))))) -(defun backward-up-list (&optional arg) +(defun backward-up-list (&optional arg escape-strings no-syntax-crossing) "Move backward out of one level of parentheses. This command will also work on other parentheses-like expressions -defined by the current language mode. -With ARG, do this that many times. -A negative argument means move forward but still to a less deep spot. -This command assumes point is not in a string or comment." - (interactive "^p") - (up-list (- (or arg 1)))) - -(defun up-list (&optional arg) +defined by the current language mode. With ARG, do this that +many times. A negative argument means move forward but still to +a less deep spot. If ESCAPE-STRINGS is non-nil (as it is +interactively), move out of enclosing strings as well. If +NO-SYNTAX-CROSSING is non-nil (as it is interactively), prefer to +break out of any enclosing string instead of moving to the start +of a list broken across multiple strings. On error, location of +point is unspecified." + (interactive "^p\nd\nd") + (up-list (- (or arg 1)) escape-strings no-syntax-crossing)) + +(defun up-list (&optional arg escape-strings no-syntax-crossing) "Move forward out of one level of parentheses. This command will also work on other parentheses-like expressions -defined by the current language mode. -With ARG, do this that many times. -A negative argument means move backward but still to a less deep spot. -This command assumes point is not in a string or comment." - (interactive "^p") +defined by the current language mode. With ARG, do this that +many times. A negative argument means move backward but still to +a less deep spot. If ESCAPE-STRINGS is non-nil (as it is +interactively), move out of enclosing strings as well. If +NO-SYNTAX-CROSSING is non-nil (as it is interactively), prefer to +break out of any enclosing string instead of moving to the start +of a list broken across multiple strings. On error, location of +point is unspecified." + (interactive "^p\nd\nd") (or arg (setq arg 1)) (let ((inc (if (> arg 0) 1 -1)) - pos) + (pos nil)) (while (/= arg 0) - (if (null forward-sexp-function) - (goto-char (or (scan-lists (point) inc 1) (buffer-end arg))) - (condition-case err - (while (progn (setq pos (point)) - (forward-sexp inc) - (/= (point) pos))) - (scan-error (goto-char (nth (if (> arg 0) 3 2) err)))) - (if (= (point) pos) - (signal 'scan-error - (list "Unbalanced parentheses" (point) (point))))) + (condition-case err + (save-restriction + ;; If we've been asked not to cross string boundaries + ;; and we're inside a string, narrow to that string so + ;; that scan-lists doesn't find a match in a different + ;; string. + (when no-syntax-crossing + (let* ((syntax (syntax-ppss)) + (string-comment-start (nth 8 syntax))) + (when string-comment-start + (save-excursion + (goto-char string-comment-start) + (narrow-to-region + (point) + (if (nth 3 syntax) ; in string + (condition-case nil + (progn (forward-sexp) (point)) + (scan-error (point-max))) + (forward-comment 1) + (point))))))) + (if (null forward-sexp-function) + (goto-char (or (scan-lists (point) inc 1) + (buffer-end arg))) + (condition-case err + (while (progn (setq pos (point)) + (forward-sexp inc) + (/= (point) pos))) + (scan-error (goto-char (nth (if (> arg 0) 3 2) err)))) + (if (= (point) pos) + (signal 'scan-error + (list "Unbalanced parentheses" (point) (point)))))) + (scan-error + (let ((syntax nil)) + (or + ;; If we bumped up against the end of a list, see whether + ;; we're inside a string: if so, just go to the beginning + ;; or end of that string. + (and escape-strings + (or syntax (setf syntax (syntax-ppss))) + (nth 3 syntax) + (goto-char (nth 8 syntax)) + (progn (when (> inc 0) + (forward-sexp)) + t)) + ;; If we narrowed to a comment above and failed to escape + ;; it, the error might be our fault, not an indication + ;; that we're out of syntax. Try again from beginning or + ;; end of the comment. + (and no-syntax-crossing + (or syntax (setf syntax (syntax-ppss))) + (nth 4 syntax) + (goto-char (nth 8 syntax)) + (or (< inc 0) + (forward-comment 1)) + (setf arg (+ arg inc))) + (signal (car err) (cdr err)))))) (setq arg (- arg inc))))) (defun kill-sexp (&optional arg) diff --git a/test/ChangeLog b/test/ChangeLog index c27b9b5f437..ebba4f01e93 100644 --- a/test/ChangeLog +++ b/test/ChangeLog @@ -1,3 +1,7 @@ +2014-04-09 Daniel Colascione <dancol@dancol.org> + + * automated/syntax-tests.el: New file. + 2014-04-09 Glenn Morris <rgm@gnu.org> * automated/python-tests.el (python-triple-quote-pairing): diff --git a/test/automated/syntax-tests.el b/test/automated/syntax-tests.el new file mode 100644 index 00000000000..9b97001a14e --- /dev/null +++ b/test/automated/syntax-tests.el @@ -0,0 +1,97 @@ +;;; syntax-tests.el --- Testing syntax rules and basic movement -*- lexical-binding: t -*- + +;; Copyright (C) 2014 Free Software Foundation, Inc. + +;; Author: Daniel Colascione <dancol@dancol.org> +;; Keywords: + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; + +;;; Code: +(require 'ert) +(require 'cl-lib) + +(defun run-up-list-test (fn data start instructions) + (cl-labels ((posof (thing) + (and (symbolp thing) + (= (length (symbol-name thing)) 1) + (- (aref (symbol-name thing) 0) ?a -1)))) + (with-temp-buffer + (set-syntax-table (make-syntax-table)) + ;; Use a syntax table in which single quote is a string + ;; character so that we can embed the test data in a lisp string + ;; literal. + (modify-syntax-entry ?\' "\"") + (insert data) + (goto-char (posof start)) + (dolist (instruction instructions) + (cond ((posof instruction) + (funcall fn) + (should (eql (point) (posof instruction)))) + ((symbolp instruction) + (should-error (funcall fn) + :type instruction)) + (t (cl-assert nil nil "unknown ins"))))))) + +(defmacro define-up-list-test (name fn data start &rest expected) + `(ert-deftest ,name () + (run-up-list-test ,fn ,data ',start ',expected))) + +(define-up-list-test up-list-basic + (lambda () (up-list)) + (or "(1 1 (1 1) 1 (1 1) 1)") + ;; abcdefghijklmnopqrstuv + i k v scan-error) + +(define-up-list-test up-list-with-forward-sexp-function + (lambda () + (let ((forward-sexp-function + (lambda (&optional arg) + (let ((forward-sexp-function nil)) + (forward-sexp arg))))) + (up-list))) + (or "(1 1 (1 1) 1 (1 1) 1)") + ;; abcdefghijklmnopqrstuv + i k v scan-error) + +(define-up-list-test up-list-out-of-string + (lambda () (up-list 1 t)) + (or "1 (1 '2 2 (2 2 2' 1) 1") + ;; abcdefghijklmnopqrstuvwxy + o r u scan-error) + +(define-up-list-test up-list-cross-string + (lambda () (up-list 1 t)) + (or "(1 '2 ( 2' 1 '2 ) 2' 1)") + ;; abcdefghijklmnopqrstuvwxy + i r u x scan-error) + +(define-up-list-test up-list-no-cross-string + (lambda () (up-list 1 t t)) + (or "(1 '2 ( 2' 1 '2 ) 2' 1)") + ;; abcdefghijklmnopqrstuvwxy + i k x scan-error) + +(define-up-list-test backward-up-list-basic + (lambda () (backward-up-list)) + (or "(1 1 (1 1) 1 (1 1) 1)") + ;; abcdefghijklmnopqrstuv + i f a scan-error) + +(provide 'syntax-tests) +;;; syntax-tests.el ends here |