X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/322b7dab59b98b5d8625d2cd29e48f1ce605f769..eed18bf1fd1162872e196091ab795a773f277e8e:/lisp/nxml/xmltok.el

diff --git a/lisp/nxml/xmltok.el b/lisp/nxml/xmltok.el
index a9b24955fa..f80a5fd2fa 100644
--- a/lisp/nxml/xmltok.el
+++ b/lisp/nxml/xmltok.el
@@ -1,9 +1,9 @@
-;;; xmltok.el --- XML tokenization
+;;; xmltok.el --- XML tokenization  -*- lexical-binding:t -*-
 
-;; Copyright (C) 2003, 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2003, 2007-2014 Free Software Foundation, Inc.
 
 ;; Author: James Clark
-;; Keywords: XML
+;; Keywords: wp, hypermedia, languages, XML
 
 ;; This file is part of GNU Emacs.
 
@@ -132,33 +132,6 @@ from referencing the entity in element content and AR is either nil,
 meaning the replacement text included a <, or a string which is the
 normalized attribute value.")
 
-(defvar xmltok-dependent-regions nil
-  "List of descriptors of regions that a parsed token depends on.
-
-A token depends on a region if the region occurs after the token and a
-change in the region may require the token to be reparsed.  This only
-happens with markup that is not well-formed.  For example, if a <?
-occurs without a matching ?>, then the <? is returned as a
-not-well-formed token.  However, this token is dependent on region
-from the end of the token to the end of the buffer: if this ever
-contains ?> then the buffer must be reparsed from the <?.
-
-A region descriptor is a list (FUN START END ARG ...), where FUN is a
-function to be called when the region changes, START and END are
-integers giving the start and end of the region, and ARG... are
-additional arguments to be passed to FUN.  FUN will be called with 5
-arguments followed by the additional arguments if any: the position of
-the start of the changed area in the region, the position of the end
-of the changed area in the region, the length of the changed area
-before the change, the position of the start of the region, the
-position of the end of the region.  FUN must return non-nil if the
-region needs reparsing.  FUN will be called in a `save-excursion'
-with match-data saved.
-
-`xmltok-forward', `xmltok-forward-special' and `xmltok-forward-prolog'
-may add entries to the beginning of this list, but will not clear it.
-`xmltok-forward' and `xmltok-forward-special' will only add entries
-when returning tokens of type not-well-formed.")
 
 (defvar xmltok-errors nil
   "List of errors detected by `xmltok-forward' and `xmltok-forward-prolog'.
@@ -169,6 +142,7 @@ string giving the error message and START and END are integers
 indicating the position of the error.")
 
 (defmacro xmltok-save (&rest body)
+  (declare (indent 0) (debug t))
   `(let (xmltok-type
 	 xmltok-start
 	 xmltok-name-colon
@@ -176,13 +150,9 @@ indicating the position of the error.")
 	 xmltok-replacement
 	 xmltok-attributes
 	 xmltok-namespace-attributes
-	 xmltok-dependent-regions
 	 xmltok-errors)
      ,@body))
 
-(put 'xmltok-save 'lisp-indent-function 0)
-(def-edebug-spec xmltok-save t)
-
 (defsubst xmltok-attribute-name-start (att)
   (aref att 0))
 
@@ -298,14 +268,6 @@ and VALUE-END, otherwise a STRING giving the value."
 				 (or end (point)))
 	      xmltok-errors)))
 
-(defun xmltok-add-dependent (fun &optional start end &rest args)
-  (setq xmltok-dependent-regions
-	(cons (cons fun
-		    (cons (or start xmltok-start)
-			  (cons (or end (point-max))
-				args)))
-	      xmltok-dependent-regions)))
-
 (defun xmltok-forward ()
   (setq xmltok-start (point))
   (let* ((case-fold-search nil)
@@ -447,7 +409,6 @@ Return the type of the token."
 (eval-when-compile
   (let* ((or "\\|")
 	 (open "\\(?:")
-	 (gopen "\\(")
 	 (close "\\)")
 	 (name-start-char "[_[:alpha:]]")
 	 (name-continue-not-start-char "[-.[:digit:]]")
@@ -684,14 +645,8 @@ Return the type of the token."
 		(setq xmltok-type 'empty-element))
 	       ((xmltok-after-lt start cdata-section-open)
 		(setq xmltok-type
-		      (if (search-forward "]]>" nil t)
-			  'cdata-section
-			(xmltok-add-error "No closing ]]>")
-			(xmltok-add-dependent 'xmltok-unclosed-reparse-p
-					      nil
-					      nil
-					      "]]>")
-			'not-well-formed)))
+		      (progn (search-forward "]]>" nil 'move)
+                             'cdata-section)))
 	       ((xmltok-after-lt start processing-instruction-question)
 		(xmltok-scan-after-processing-instruction-open))
 	       ((xmltok-after-lt start comment-open)
@@ -758,68 +713,45 @@ Return the type of the token."
 ;; xmltok-scan-prolog-after-processing-instruction-open
 ;; XXX maybe should include rest of line (up to any <,>) in unclosed PI
 (defun xmltok-scan-after-processing-instruction-open ()
-  (cond ((not (search-forward "?>" nil t))
-	 (xmltok-add-error "No closing ?>"
-			   xmltok-start
-			   (+ xmltok-start 2))
-	 (xmltok-add-dependent 'xmltok-unclosed-reparse-p
-			       nil
-			       nil
-			       "?>")
-	 (setq xmltok-type 'not-well-formed))
-	(t
-	 (cond ((not (save-excursion
-		       (goto-char (+ 2 xmltok-start))
-		       (and (looking-at (xmltok-ncname regexp))
-			    (setq xmltok-name-end (match-end 0)))))
-		(setq xmltok-name-end (+ xmltok-start 2))
-		(xmltok-add-error "<? not followed by name"
-				  (+ xmltok-start 2)
-				  (+ xmltok-start 3)))
-	       ((not (or (memq (char-after xmltok-name-end)
-			       '(?\n ?\t ?\r ? ))
-			 (= xmltok-name-end (- (point) 2))))
-		(xmltok-add-error "Target not followed by whitespace"
-				  xmltok-name-end
-				  (1+ xmltok-name-end)))
-	       ((and (= xmltok-name-end (+ xmltok-start 5))
-		     (save-excursion
-		       (goto-char (+ xmltok-start 2))
-		       (let ((case-fold-search t))
-			 (looking-at "xml"))))
-		(xmltok-add-error "Processing instruction target is xml"
-				  (+ xmltok-start 2)
-				  (+ xmltok-start 5))))
-	 (setq xmltok-type 'processing-instruction))))
+  (search-forward "?>" nil 'move)
+  (cond ((not (save-excursion
+                (goto-char (+ 2 xmltok-start))
+                (and (looking-at (xmltok-ncname regexp))
+                     (setq xmltok-name-end (match-end 0)))))
+         (setq xmltok-name-end (+ xmltok-start 2))
+         (xmltok-add-error "<? not followed by name"
+                           (+ xmltok-start 2)
+                           (+ xmltok-start 3)))
+        ((not (or (memq (char-after xmltok-name-end)
+                        '(?\n ?\t ?\r ? ))
+                  (= xmltok-name-end (- (point) 2))))
+         (xmltok-add-error "Target not followed by whitespace"
+                           xmltok-name-end
+                           (1+ xmltok-name-end)))
+        ((and (= xmltok-name-end (+ xmltok-start 5))
+              (save-excursion
+                (goto-char (+ xmltok-start 2))
+                (let ((case-fold-search t))
+                  (looking-at "xml"))))
+         (xmltok-add-error "Processing instruction target is xml"
+                           (+ xmltok-start 2)
+                           (+ xmltok-start 5))))
+  (setq xmltok-type 'processing-instruction))
 
 (defun xmltok-scan-after-comment-open ()
-  (setq xmltok-type
-	(cond ((not (search-forward "--" nil t))
-	       (xmltok-add-error "No closing -->")
-	       (xmltok-add-dependent 'xmltok-unclosed-reparse-p
-				     nil
-				     nil
-				     ;; not --> because
-				     ;; -- is not allowed
-				     ;; in comments in XML
-				     "--")
-	       'not-well-formed)
-	      ((eq (char-after) ?>)
-	       (goto-char (1+ (point)))
-	       'comment)
-	      (t
-	       (xmltok-add-dependent
-		'xmltok-semi-closed-reparse-p
-		nil
-		(point)
-		"--"
-		2)
-	       ;; just include the <!-- in the token
-	       (goto-char (+ xmltok-start 4))
-	       ;; Need do this after the goto-char because
-	       ;; marked error should just apply to <!--
-	       (xmltok-add-error "First following `--' not followed by `>'")
-	       'not-well-formed))))
+  (let ((found-- (search-forward "--" nil 'move)))
+    (setq xmltok-type
+          (cond ((or (eq (char-after) ?>) (not found--))
+                 (goto-char (1+ (point)))
+                 'comment)
+                (t
+                 ;; just include the <!-- in the token
+                 (goto-char (+ xmltok-start 4))
+                 ;; Need do this after the goto-char because
+                 ;; marked error should just apply to <!--
+                 (xmltok-add-error "First following `--' not followed by `>'")
+                 (goto-char (point-max))
+                 'comment)))))
 
 (defun xmltok-scan-attributes ()
   (let ((recovering nil)
@@ -1054,33 +986,6 @@ Return the type of the token."
 	 (xmltok-valid-char-p n)
 	 n)))
 
-(defun xmltok-unclosed-reparse-p (change-start
-				  change-end
-				  pre-change-length
-				  start
-				  end
-				  delimiter)
-  (let ((len-1 (1- (length delimiter))))
-    (goto-char (max start (- change-start len-1)))
-    (search-forward delimiter (min end (+ change-end len-1)) t)))
-
-;; Handles a <!-- with the next -- not followed by >
-
-(defun xmltok-semi-closed-reparse-p (change-start
-				     change-end
-				     pre-change-length
-				     start
-				     end
-				     delimiter
-				     delimiter-length)
-  (or (<= (- end delimiter-length) change-end)
-      (xmltok-unclosed-reparse-p change-start
-				 change-end
-				 pre-change-length
-				 start
-				 end
-				 delimiter)))
-
 (defun xmltok-valid-char-p (n)
   "Return non-nil if N is the Unicode code of a valid XML character."
   (cond ((< n #x20) (memq n '(#xA #xD #x9)))
@@ -1124,7 +1029,7 @@ comment, processing-instruction-left, processing-instruction-right,
 markup-declaration-open, markup-declaration-close,
 internal-subset-open, internal-subset-close, hash-name, keyword,
 literal, encoding-name.
-Adds to `xmltok-errors' and `xmltok-dependent-regions' as appropriate."
+Adds to `xmltok-errors' as appropriate."
   (let ((case-fold-search nil)
 	xmltok-start
 	xmltok-type
@@ -1138,7 +1043,7 @@ Adds to `xmltok-errors' and `xmltok-dependent-regions' as appropriate."
     (setq xmltok-dtd xmltok-predefined-entity-alist)
     (xmltok-scan-xml-declaration)
     (xmltok-next-prolog-token)
-    (while (condition-case err
+    (while (condition-case nil
 	       (when (xmltok-parse-prolog-item)
 		 (xmltok-next-prolog-token))
 	     (xmltok-markup-declaration-parse-error
@@ -1148,7 +1053,6 @@ Adds to `xmltok-errors' and `xmltok-dependent-regions' as appropriate."
 			(1- xmltok-internal-subset-start)
 			xmltok-internal-subset-start))
     (xmltok-parse-entities)
-    ;; XXX prune dependent-regions for those entirely in prolog
     (nreverse xmltok-prolog-regions)))
 
 (defconst xmltok-bad-xml-decl-regexp
@@ -1438,7 +1342,7 @@ If LIMIT is non-nil, then do not consider characters beyond LIMIT."
 		       (t
 			(let ((xmltok-start (1- (point)))
 			       xmltok-type xmltok-replacement)
-			  (xmltok-scan-after-amp (lambda (start end)))
+			  (xmltok-scan-after-amp (lambda (_start _end)))
 			  (cond ((eq xmltok-type 'char-ref)
 				 (setq value-parts
 				       (cons (buffer-substring-no-properties
@@ -1502,13 +1406,8 @@ If LIMIT is non-nil, then do not consider characters beyond LIMIT."
 (defun xmltok-current-token-string ()
   (buffer-substring-no-properties xmltok-start (point)))
 
-(put 'xmltok-markup-declaration-parse-error
-     'error-conditions
-     '(error xmltok-markup-declaration-parse-error))
-
-(put 'xmltok-markup-declaration-parse-error
-     'error-message
-     "Syntax error in markup declaration")
+(define-error 'xmltok-markup-declaration-parse-error
+  "Syntax error in markup declaration")
 
 (defun xmltok-markup-declaration-parse-error ()
   (signal 'xmltok-markup-declaration-parse-error nil))
@@ -1648,95 +1547,68 @@ If LIMIT is non-nil, then do not consider characters beyond LIMIT."
 	 (end (save-excursion
 		(goto-char safe-end)
 		(search-forward delim nil t))))
-    (or (cond ((not end)
-	       (xmltok-add-dependent 'xmltok-unclosed-reparse-p
-				     nil
-				     nil
-				     delim)
-	       nil)
-	      ((save-excursion
-		 (goto-char end)
-		 (looking-at "[ \t\r\n>%[]"))
-	       (goto-char end)
-	       (setq xmltok-type 'literal))
-	      ((eq (1+ safe-end) end)
-	       (goto-char end)
-	       (xmltok-add-error (format "Missing space after %s" delim)
-				 safe-end)
-	       (setq xmltok-type 'literal))
-	      (t
-	       (xmltok-add-dependent 'xmltok-semi-closed-reparse-p
-				     xmltok-start
-				     (1+ end)
-				     delim
-				     1)
-	       nil))
-	(progn
-	  (xmltok-add-error (format "Missing closing %s" delim))
-	  (goto-char safe-end)
-	  (skip-chars-backward " \t\r\n")
-	  (setq xmltok-type 'not-well-formed)))))
+    (cond ((or (not end)
+               (save-excursion
+                 (goto-char end)
+                 (looking-at "[ \t\r\n>%[]")))
+           (goto-char end))
+          ((eq (1+ safe-end) end)
+           (goto-char end)
+           (xmltok-add-error (format "Missing space after %s" delim)
+                             safe-end)))
+    (setq xmltok-type 'literal)))
 
 (defun xmltok-scan-prolog-after-processing-instruction-open ()
-  (cond ((not (search-forward "?>" nil t))
-	 (xmltok-add-error "No closing ?>"
-			   xmltok-start
-			   (+ xmltok-start 2))
-	 (xmltok-add-dependent 'xmltok-unclosed-reparse-p
-			       nil
-			       nil
-			       "?>")
-	 (setq xmltok-type 'not-well-formed))
-	(t
-	 (let* ((end (point))
-		(target
-		 (save-excursion
-		   (goto-char (+ xmltok-start 2))
-		   (and (looking-at (xmltok-ncname regexp))
-			(or (memq (char-after (match-end 0))
-				  '(?\n ?\t ?\r ? ))
-			    (= (match-end 0) (- end 2)))
-			(match-string-no-properties 0)))))
-	   (cond ((not target)
-		  (xmltok-add-error "\
+  (search-forward "?>" nil 'move)
+  (let* ((end (point))
+         (target
+          (save-excursion
+            (goto-char (+ xmltok-start 2))
+            (and (looking-at (xmltok-ncname regexp))
+                 (or (memq (char-after (match-end 0))
+                           '(?\n ?\t ?\r ? ))
+                     (= (match-end 0) (- end 2)))
+                 (match-string-no-properties 0)))))
+    (cond ((not target)
+           (xmltok-add-error "\
 Processing instruction does not start with a name"
-				    (+ xmltok-start 2)
-				    (+ xmltok-start 3)))
-		 ((not (and (= (length target) 3)
-			    (let ((case-fold-search t))
-			      (string-match "xml" target)))))
-		 ((= xmltok-start 1)
-		  (xmltok-add-error "Invalid XML declaration"
-				    xmltok-start
-				    (point)))
-		 ((save-excursion
-		    (goto-char xmltok-start)
-		    (looking-at (xmltok-xml-declaration regexp)))
-		  (xmltok-add-error "XML declaration not at beginning of file"
-				    xmltok-start
-				    (point)))
-		 (t
-		  (xmltok-add-error "Processing instruction has target of xml"
-				    (+ xmltok-start 2)
-				    (+ xmltok-start 5))))
-	   (xmltok-add-prolog-region 'processing-instruction-left
-				     xmltok-start
-				     (+ xmltok-start
-					2
-					(if target
-					    (length target)
-					  0)))
-	   (xmltok-add-prolog-region 'processing-instruction-right
-				     (if target
-					 (save-excursion
-					   (goto-char (+ xmltok-start
-							 (length target)
-							 2))
-					   (skip-chars-forward " \t\r\n")
-					   (point))
-				       (+ xmltok-start 2))
-				     (point)))
-	 (setq xmltok-type 'processing-instruction))))
+                             (+ xmltok-start 2)
+                             (+ xmltok-start 3)))
+          ((not (and (= (length target) 3)
+                     (let ((case-fold-search t))
+                       (string-match "xml" target)))))
+          ((= xmltok-start 1)
+           (xmltok-add-error "Invalid XML declaration"
+                             xmltok-start
+                             (point)))
+          ((save-excursion
+             (goto-char xmltok-start)
+             (looking-at (xmltok-xml-declaration regexp)))
+           (xmltok-add-error "XML declaration not at beginning of file"
+                             xmltok-start
+                             (point)))
+          (t
+           (xmltok-add-error "Processing instruction has target of xml"
+                             (+ xmltok-start 2)
+                             (+ xmltok-start 5))))
+    (xmltok-add-prolog-region 'processing-instruction-left
+                              xmltok-start
+                              (+ xmltok-start
+                                 2
+                                 (if target
+                                     (length target)
+                                   0)))
+    (xmltok-add-prolog-region 'processing-instruction-right
+                              (if target
+                                  (save-excursion
+                                    (goto-char (+ xmltok-start
+                                                  (length target)
+                                                  2))
+                                    (skip-chars-forward " \t\r\n")
+                                    (point))
+                                (+ xmltok-start 2))
+                              (point)))
+  (setq xmltok-type 'processing-instruction))
 
 (defun xmltok-parse-entities ()
   (let ((todo xmltok-dtd))