From: Stefan Monnier <monnier@iro.umontreal.ca>
Date: Wed, 10 Nov 2004 14:39:40 +0000 (+0000)
Subject: (sgml-tag-text-p): New fun.
X-Git-Tag: ttn-vms-21-2-B4~4021
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=e9146d5accb44e7c00a350a95492b3db6f1ee980;p=emacs.git

(sgml-tag-text-p): New fun.
(sgml-parse-tag-backward): Use it to skip spurious < or >.
---

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 00f7d381254..c6587f7d5ea 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,8 @@
+2004-11-10  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+	* textmodes/sgml-mode.el (sgml-tag-text-p): New fun.
+	(sgml-parse-tag-backward): Use it to skip spurious < or >.
+
 2004-11-10  Thien-Thi Nguyen  <ttn@gnu.org>
 
 	* ebuff-menu.el: Doc fixes throughout.
@@ -15,6 +20,10 @@
 
 	* files.el (auto-mode-alist, magic-mode-alist): Use it.
 
+2004-11-09  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+	* international/iso-cvt.el (iso-cvt-define-menu): Clean up namespace.
+
 2004-11-09  Jay Belanger  <belanger@truman.edu>
 
 	* calc/calc-ext.el (calc-init-extensions):  Remove old code.
@@ -37,8 +46,8 @@
 	* calc/calc-poly.el (math-expand-form):  Use declared variable
 	math-mt-many.
 
-	* calc/calc-rewr.el (math-rewrite, math-rewrite-phase):  Use
-	declared variable math-mt-many.
+	* calc/calc-rewr.el (math-rewrite, math-rewrite-phase):
+	Use declared variable math-mt-many.
 	(math-rewrite):  Use declared variable math-mt-func.
 
 	* calc/calc-vec.el (math-read-brackets, math-read-vector)
@@ -104,8 +113,6 @@
 
 2004-11-08  Stefan Monnier  <monnier@iro.umontreal.ca>
 
-	* international/mule.el: Fix some warnings.
-
 	* international/mule-cmds.el: Change coding-system to utf-8.
 	(select-safe-coding-system-interactively):
 	New function extracted from select-safe-coding-system.
diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el
index 4ac96b2e4b0..dd606a53434 100644
--- a/lisp/textmodes/sgml-mode.el
+++ b/lisp/textmodes/sgml-mode.el
@@ -1,6 +1,7 @@
 ;;; sgml-mode.el --- SGML- and HTML-editing modes
 
-;; Copyright (C) 1992,95,96,98,2001,2002, 2003  Free Software Foundation, Inc.
+;; Copyright (C) 1992, 1995, 1996, 1998, 2001, 2002, 2003, 2004
+;;           Free Software Foundation, Inc.
 
 ;; Author: James Clark <jjc@jclark.com>
 ;; Maintainer: FSF
@@ -1053,53 +1054,79 @@ You might want to turn on `auto-fill-mode' to get better results."
     (and (>= start (point-min))
          (equal str (buffer-substring-no-properties start (point))))))
 
+(defun sgml-tag-text-p (start end)
+  "Return non-nil if text between START and END is a tag.
+Checks among other things that the tag does not contain spurious
+unquoted < or > chars inside, which would indicate that it
+really isn't a tag after all."
+  (save-excursion
+    (with-syntax-table sgml-tag-syntax-table
+      (let ((pps (parse-partial-sexp start end 2)))
+	(and (= (nth 0 pps) 0))))))
+
 (defun sgml-parse-tag-backward (&optional limit)
   "Parse an SGML tag backward, and return information about the tag.
 Assume that parsing starts from within a textual context.
 Leave point at the beginning of the tag."
-  (let (tag-type tag-start tag-end name)
-    (or (re-search-backward "[<>]" limit 'move)
-        (error "No tag found"))
-    (when (eq (char-after) ?<)
-      ;; Oops!! Looks like we were not in a textual context after all!.
-      ;; Let's try to recover.
-      (with-syntax-table sgml-tag-syntax-table
-	(forward-sexp)
-	(forward-char -1)))
-    (setq tag-end (1+ (point)))
-    (cond
-     ((sgml-looking-back-at "--")   ; comment
-      (setq tag-type 'comment
-            tag-start (search-backward "<!--" nil t)))
-     ((sgml-looking-back-at "]]")   ; cdata
-      (setq tag-type 'cdata
-            tag-start (re-search-backward "<!\\[[A-Z]+\\[" nil t)))
-     (t
-      (setq tag-start
-            (with-syntax-table sgml-tag-syntax-table
-              (goto-char tag-end)
-              (backward-sexp)
-              (point)))
-      (goto-char (1+ tag-start))
-      (case (char-after)
-        (?!                             ; declaration
-         (setq tag-type 'decl))
-        (??                             ; processing-instruction
-         (setq tag-type 'pi))
-        (?/                             ; close-tag
-         (forward-char 1)
-         (setq tag-type 'close
-               name (sgml-parse-tag-name)))
-        (?%                             ; JSP tags
-         (setq tag-type 'jsp))
-        (t                              ; open or empty tag
-         (setq tag-type 'open
-               name (sgml-parse-tag-name))
-         (if (or (eq ?/ (char-before (- tag-end 1)))
-                 (sgml-empty-tag-p name))
-             (setq tag-type 'empty))))))
-    (goto-char tag-start)
-    (sgml-make-tag tag-type tag-start tag-end name)))
+  (catch 'found
+    (let (tag-type tag-start tag-end name)
+      (or (re-search-backward "[<>]" limit 'move)
+	  (error "No tag found"))
+      (when (eq (char-after) ?<)
+	;; Oops!! Looks like we were not in a textual context after all!.
+	;; Let's try to recover.
+	(with-syntax-table sgml-tag-syntax-table
+	  (let ((pos (point)))
+	    (condition-case nil
+		(forward-sexp)
+	      (scan-error
+	       ;; This < seems to be just a spurious one, let's ignore it.
+	       (goto-char pos)
+	       (throw 'found (sgml-parse-tag-backward limit))))
+	    ;; Check it is really a tag, without any extra < or > inside.
+	    (unless (sgml-tag-text-p pos (point))
+	      (goto-char pos)
+	      (throw 'found (sgml-parse-tag-backward limit)))
+	    (forward-char -1))))
+      (setq tag-end (1+ (point)))
+      (cond
+       ((sgml-looking-back-at "--")	; comment
+	(setq tag-type 'comment
+	      tag-start (search-backward "<!--" nil t)))
+       ((sgml-looking-back-at "]]")	; cdata
+	(setq tag-type 'cdata
+	      tag-start (re-search-backward "<!\\[[A-Z]+\\[" nil t)))
+       (t
+	(setq tag-start
+	      (with-syntax-table sgml-tag-syntax-table
+		(goto-char tag-end)
+		(condition-case nil
+		    (backward-sexp)
+		  (scan-error
+		   ;; This > isn't really the end of a tag. Skip it.
+		   (goto-char (1- tag-end))
+		   (throw 'found (sgml-parse-tag-backward limit))))
+		(point)))
+	(goto-char (1+ tag-start))
+	(case (char-after)
+	  (?!				; declaration
+	   (setq tag-type 'decl))
+	  (??				; processing-instruction
+	   (setq tag-type 'pi))
+	  (?/				; close-tag
+	   (forward-char 1)
+	   (setq tag-type 'close
+		 name (sgml-parse-tag-name)))
+	  (?%				; JSP tags
+	   (setq tag-type 'jsp))
+	  (t				; open or empty tag
+	   (setq tag-type 'open
+		 name (sgml-parse-tag-name))
+	   (if (or (eq ?/ (char-before (- tag-end 1)))
+		   (sgml-empty-tag-p name))
+	       (setq tag-type 'empty))))))
+      (goto-char tag-start)
+      (sgml-make-tag tag-type tag-start tag-end name))))
 
 (defun sgml-get-context (&optional until)
   "Determine the context of the current position.
@@ -1966,5 +1993,5 @@ Can be used as a value for `html-mode-hook'."
 
 (provide 'sgml-mode)
 
-;;; arch-tag: 9675da94-b7f9-4bda-ad19-73ed7b4fb401
+;; arch-tag: 9675da94-b7f9-4bda-ad19-73ed7b4fb401
 ;;; sgml-mode.el ends here