/[emacs]/emacs/lisp/textmodes/sgml-mode.el
ViewVC logotype

Diff of /emacs/lisp/textmodes/sgml-mode.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.101 by monnier, Wed Nov 10 14:39:40 2004 UTC revision 1.102 by monnier, Thu Jan 13 14:51:54 2005 UTC
# Line 1  Line 1 
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>
# Line 394  Otherwise, it is set to be buffer-local Line 394  Otherwise, it is set to be buffer-local
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.
# Line 424  Do \\[describe-key] on the following bin Line 432  Do \\[describe-key] on the following bin
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) " -->")
# Line 1140  immediately enclosing the current positi Line 1149  immediately enclosing the current positi
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
# Line 1174  not the case, the first tag returned is Line 1185  not the case, the first tag returned is
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.
# Line 1202  not the case, the first tag returned is Line 1214  not the case, the first tag returned is
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

Legend:
Removed from v.1.101  
changed lines
  Added in v.1.102

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26