mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-15 10:30:25 -08:00
Code Issues Projects Releases Wiki Activity

(sgml-tag-text-p): New fun.

Browse source 
(sgml-parse-tag-backward): Use it to skip spurious < or >.
This commit is contained in:
Stefan Monnier 2004-11-10 14:39:40 +00:00
parent 86523fac0b
commit e9146d5acc
2 changed files with 83 additions and 49 deletions
Download patch file Download diff file Expand all files Collapse all files

15
lisp/ChangeLog
View file

@ -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.

117
lisp/textmodes/sgml-mode.el
View file

@ -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