1 |
;;; sgml-mode.el --- SGML- and HTML-editing modes |
;;; sgml-mode.el --- SGML- and HTML-editing modes |
2 |
|
|
3 |
;; Copyright (C) 1992, 1995, 1996, 1998, 2001, 2002, 2003, 2004 |
;; Copyright (C) 1992, 1995, 1996, 1998, 2001, 2002, 2003, 2004, 2005 |
4 |
;; Free Software Foundation, Inc. |
;; Free Software Foundation, Inc. |
5 |
|
|
6 |
;; Author: James Clark <jjc@jclark.com> |
;; Author: James Clark <jjc@jclark.com> |
394 |
(concat "<" face ">")) |
(concat "<" face ">")) |
395 |
(error "Face not configured for %s mode" mode-name))) |
(error "Face not configured for %s mode" mode-name))) |
396 |
|
|
397 |
|
(defun sgml-fill-nobreak () |
398 |
|
;; Don't break between a tag name and its first argument. |
399 |
|
(save-excursion |
400 |
|
(skip-chars-backward " \t") |
401 |
|
(and (not (zerop (skip-syntax-backward "w_"))) |
402 |
|
(skip-chars-backward "/?!") |
403 |
|
(eq (char-before) ?<)))) |
404 |
|
|
405 |
;;;###autoload |
;;;###autoload |
406 |
(define-derived-mode sgml-mode text-mode "SGML" |
(define-derived-mode sgml-mode text-mode "SGML" |
407 |
"Major mode for editing SGML documents. |
"Major mode for editing SGML documents. |
432 |
(set (make-local-variable 'paragraph-separate) |
(set (make-local-variable 'paragraph-separate) |
433 |
(concat paragraph-start "$")) |
(concat paragraph-start "$")) |
434 |
(set (make-local-variable 'adaptive-fill-regexp) "[ \t]*") |
(set (make-local-variable 'adaptive-fill-regexp) "[ \t]*") |
435 |
|
(add-hook 'fill-nobreak-predicate 'sgml-fill-nobreak nil t) |
436 |
(set (make-local-variable 'indent-line-function) 'sgml-indent-line) |
(set (make-local-variable 'indent-line-function) 'sgml-indent-line) |
437 |
(set (make-local-variable 'comment-start) "<!-- ") |
(set (make-local-variable 'comment-start) "<!-- ") |
438 |
(set (make-local-variable 'comment-end) " -->") |
(set (make-local-variable 'comment-end) " -->") |
1149 |
Point is assumed to be outside of any tag. If we discover that it's |
Point is assumed to be outside of any tag. If we discover that it's |
1150 |
not the case, the first tag returned is the one inside which we are." |
not the case, the first tag returned is the one inside which we are." |
1151 |
(let ((here (point)) |
(let ((here (point)) |
1152 |
|
(stack nil) |
1153 |
(ignore nil) |
(ignore nil) |
1154 |
(context nil) |
(context nil) |
1155 |
tag-info) |
tag-info) |
1156 |
;; CONTEXT keeps track of the tag-stack |
;; CONTEXT keeps track of the tag-stack |
1157 |
;; IGNORE keeps track of the nesting level of point relative to the |
;; STACK keeps track of the end tags we've seen (and thus the start-tags |
1158 |
;; first (outermost) tag on the context. This is the list of |
;; we'll have to ignore) when skipping over matching open..close pairs. |
1159 |
;; enclosing start-tags we'll have to ignore. |
;; IGNORE is a list of tags that can be ignored because they have been |
1160 |
|
;; closed implicitly. |
1161 |
(skip-chars-backward " \t\n") ; Make sure we're not at indentation. |
(skip-chars-backward " \t\n") ; Make sure we're not at indentation. |
1162 |
(while |
(while |
1163 |
(and (not (eq until 'now)) |
(and (not (eq until 'now)) |
1164 |
(or ignore |
(or stack |
1165 |
(not (if until (eq until 'empty) context)) |
(not (if until (eq until 'empty) context)) |
1166 |
(not (sgml-at-indentation-p)) |
(not (sgml-at-indentation-p)) |
1167 |
(and context |
(and context |
1185 |
;; start-tag |
;; start-tag |
1186 |
((eq (sgml-tag-type tag-info) 'open) |
((eq (sgml-tag-type tag-info) 'open) |
1187 |
(cond |
(cond |
1188 |
((null ignore) |
((null stack) |
1189 |
(if (and context |
(if (member-ignore-case (sgml-tag-name tag-info) ignore) |
|
(sgml-unclosed-tag-p (sgml-tag-name tag-info)) |
|
|
(eq t (compare-strings |
|
|
(sgml-tag-name tag-info) nil nil |
|
|
(sgml-tag-name (car context)) nil nil t))) |
|
1190 |
;; There was an implicit end-tag. |
;; There was an implicit end-tag. |
1191 |
nil |
nil |
1192 |
(push tag-info context))) |
(push tag-info context) |
1193 |
|
;; We're changing context so the tags implicitly closed inside |
1194 |
|
;; the previous context aren't implicitly closed here any more. |
1195 |
|
;; [ Well, actually it depends, but we don't have the info about |
1196 |
|
;; when it doesn't and when it does. --Stef ] |
1197 |
|
(setq ignore nil))) |
1198 |
((eq t (compare-strings (sgml-tag-name tag-info) nil nil |
((eq t (compare-strings (sgml-tag-name tag-info) nil nil |
1199 |
(car ignore) nil nil t)) |
(car stack) nil nil t)) |
1200 |
(setq ignore (cdr ignore))) |
(setq stack (cdr stack))) |
1201 |
(t |
(t |
1202 |
;; The open and close tags don't match. |
;; The open and close tags don't match. |
1203 |
(if (not sgml-xml-mode) |
(if (not sgml-xml-mode) |
1204 |
(unless (sgml-unclosed-tag-p (sgml-tag-name tag-info)) |
(unless (sgml-unclosed-tag-p (sgml-tag-name tag-info)) |
1205 |
(message "Unclosed tag <%s>" (sgml-tag-name tag-info)) |
(message "Unclosed tag <%s>" (sgml-tag-name tag-info)) |
1206 |
(let ((tmp ignore)) |
(let ((tmp stack)) |
1207 |
;; We could just assume that the tag is simply not closed |
;; We could just assume that the tag is simply not closed |
1208 |
;; but it's a bad assumption when tags *are* closed but |
;; but it's a bad assumption when tags *are* closed but |
1209 |
;; not properly nested. |
;; not properly nested. |
1214 |
(setq tmp (cdr tmp))) |
(setq tmp (cdr tmp))) |
1215 |
(if (cdr tmp) (setcdr tmp (cddr tmp))))) |
(if (cdr tmp) (setcdr tmp (cddr tmp))))) |
1216 |
(message "Unmatched tags <%s> and </%s>" |
(message "Unmatched tags <%s> and </%s>" |
1217 |
(sgml-tag-name tag-info) (pop ignore)))))) |
(sgml-tag-name tag-info) (pop stack))))) |
1218 |
|
|
1219 |
|
(if (and (null stack) (sgml-unclosed-tag-p (sgml-tag-name tag-info))) |
1220 |
|
;; This is a top-level open of an implicitly closed tag, so any |
1221 |
|
;; occurrence of such an open tag at the same level can be ignored |
1222 |
|
;; because it's been implicitly closed. |
1223 |
|
(push (sgml-tag-name tag-info) ignore))) |
1224 |
|
|
1225 |
;; end-tag |
;; end-tag |
1226 |
((eq (sgml-tag-type tag-info) 'close) |
((eq (sgml-tag-type tag-info) 'close) |
1227 |
(if (sgml-empty-tag-p (sgml-tag-name tag-info)) |
(if (sgml-empty-tag-p (sgml-tag-name tag-info)) |
1228 |
(message "Spurious </%s>: empty tag" (sgml-tag-name tag-info)) |
(message "Spurious </%s>: empty tag" (sgml-tag-name tag-info)) |
1229 |
(push (sgml-tag-name tag-info) ignore))) |
(push (sgml-tag-name tag-info) stack))) |
1230 |
)) |
)) |
1231 |
|
|
1232 |
;; return context |
;; return context |