;;; 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, 2005
+;; Free Software Foundation, Inc.
;; Author: James Clark <jjc@jclark.com>
;; Maintainer: FSF
"Regular expression that matches a non-empty start tag.
Any terminating `>' or `/' is not matched.")
-(defface sgml-namespace-face
+(defface sgml-namespace
'((t (:inherit font-lock-builtin-face)))
- "`sgml-mode' face used to highlight the namespace part of identifiers.")
-(defvar sgml-namespace-face 'sgml-namespace-face)
+ "`sgml-mode' face used to highlight the namespace part of identifiers."
+ :group 'sgml)
+;; backward-compatibility alias
+(put 'sgml-namespace-face 'face-alias 'sgml-namespace)
+(defvar sgml-namespace-face 'sgml-namespace)
;; internal
(defconst sgml-font-lock-keywords-1
"*When non-nil, tag insertion functions will be XML-compliant.
If this variable is customized, the custom value is used always.
Otherwise, it is set to be buffer-local when the file has
- a DOCTYPE or an XML declaration."
+a DOCTYPE or an XML declaration."
:type 'boolean
- :version "21.4"
+ :version "22.1"
:group 'sgml)
(defvar sgml-empty-tags nil
(concat "<" face ">"))
(error "Face not configured for %s mode" mode-name)))
+(defun sgml-fill-nobreak ()
+ ;; Don't break between a tag name and its first argument.
+ (save-excursion
+ (skip-chars-backward " \t")
+ (and (not (zerop (skip-syntax-backward "w_")))
+ (skip-chars-backward "/?!")
+ (eq (char-before) ?<))))
+
;;;###autoload
(define-derived-mode sgml-mode text-mode "SGML"
"Major mode for editing SGML documents.
(set (make-local-variable 'paragraph-separate)
(concat paragraph-start "$"))
(set (make-local-variable 'adaptive-fill-regexp) "[ \t]*")
+ (add-hook 'fill-nobreak-predicate 'sgml-fill-nobreak nil t)
(set (make-local-variable 'indent-line-function) 'sgml-indent-line)
(set (make-local-variable 'comment-start) "<!-- ")
(set (make-local-variable 'comment-end) " -->")
;; recognized.
(set (make-local-variable 'comment-start-skip) "\\(?:<!\\)?--[ \t]*")
(set (make-local-variable 'comment-end-skip) "[ \t]*--\\([ \t\n]*>\\)?")
- ;; This definition probably is not useful in derived modes.
- (set (make-local-variable 'imenu-generic-expression)
- (concat "<!\\(element\\|entity\\)[ \t\n]+%?[ \t\n]*\\("
- sgml-name-re "\\)")))
+ ;; This definition has an HTML leaning but probably fits well for other modes.
+ (setq imenu-generic-expression
+ `((nil
+ ,(concat "<!\\(element\\|entity\\)[ \t\n]+%?[ \t\n]*\\("
+ sgml-name-re "\\)")
+ 2)
+ ("Id"
+ ,(concat "<[^>]+[ \t\n]+[Ii][Dd]=\\(['\"]"
+ (if sgml-xml-mode "" "?")
+ "\\)\\(" sgml-name-re "\\)\\1")
+ 2)
+ ("Name"
+ ,(concat "<[^>]+[ \t\n]+[Nn][Aa][Mm][Ee]=\\(['\"]"
+ (if sgml-xml-mode "" "?")
+ "\\)\\(" sgml-name-re "\\)\\1")
+ 2))))
;; Some programs (such as Glade 2) generate XML which has
;; -*- mode: xml -*-.
(backward-char)
'(("") " [ " _ " ]]"))
((and (eq v2 t) sgml-xml-mode (member ,str sgml-empty-tags))
- '(("") -1 "/>"))
+ '(("") -1 " />"))
((or (and (eq v2 t) (not sgml-xml-mode)) (string-match "^[/!?]" ,str))
nil)
((symbolp v2)
(goto-char close)
(kill-sexp 1))
(setq open (point))
- (when (sgml-skip-tag-forward 1)
+ (when (and (sgml-skip-tag-forward 1)
+ (not (looking-back "/>")))
(kill-sexp -1)))
;; Delete any resulting empty line. If we didn't kill-sexp,
;; this *should* do nothing, because we're right after the tag.
(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.
Point is assumed to be outside of any tag. If we discover that it's
not the case, the first tag returned is the one inside which we are."
(let ((here (point))
+ (stack nil)
(ignore nil)
(context nil)
tag-info)
;; CONTEXT keeps track of the tag-stack
- ;; IGNORE keeps track of the nesting level of point relative to the
- ;; first (outermost) tag on the context. This is the list of
- ;; enclosing start-tags we'll have to ignore.
+ ;; STACK keeps track of the end tags we've seen (and thus the start-tags
+ ;; we'll have to ignore) when skipping over matching open..close pairs.
+ ;; IGNORE is a list of tags that can be ignored because they have been
+ ;; closed implicitly.
(skip-chars-backward " \t\n") ; Make sure we're not at indentation.
(while
(and (not (eq until 'now))
- (or ignore
+ (or stack
(not (if until (eq until 'empty) context))
(not (sgml-at-indentation-p))
(and context
;; start-tag
((eq (sgml-tag-type tag-info) 'open)
(cond
- ((null ignore)
- (if (and context
- (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)))
+ ((null stack)
+ (if (member-ignore-case (sgml-tag-name tag-info) ignore)
;; There was an implicit end-tag.
nil
- (push tag-info context)))
+ (push tag-info context)
+ ;; We're changing context so the tags implicitly closed inside
+ ;; the previous context aren't implicitly closed here any more.
+ ;; [ Well, actually it depends, but we don't have the info about
+ ;; when it doesn't and when it does. --Stef ]
+ (setq ignore nil)))
((eq t (compare-strings (sgml-tag-name tag-info) nil nil
- (car ignore) nil nil t))
- (setq ignore (cdr ignore)))
+ (car stack) nil nil t))
+ (setq stack (cdr stack)))
(t
;; The open and close tags don't match.
(if (not sgml-xml-mode)
(unless (sgml-unclosed-tag-p (sgml-tag-name tag-info))
(message "Unclosed tag <%s>" (sgml-tag-name tag-info))
- (let ((tmp ignore))
+ (let ((tmp stack))
;; We could just assume that the tag is simply not closed
;; but it's a bad assumption when tags *are* closed but
;; not properly nested.
(setq tmp (cdr tmp)))
(if (cdr tmp) (setcdr tmp (cddr tmp)))))
(message "Unmatched tags <%s> and </%s>"
- (sgml-tag-name tag-info) (pop ignore))))))
+ (sgml-tag-name tag-info) (pop stack)))))
+
+ (if (and (null stack) (sgml-unclosed-tag-p (sgml-tag-name tag-info)))
+ ;; This is a top-level open of an implicitly closed tag, so any
+ ;; occurrence of such an open tag at the same level can be ignored
+ ;; because it's been implicitly closed.
+ (push (sgml-tag-name tag-info) ignore)))
;; end-tag
((eq (sgml-tag-type tag-info) 'close)
(if (sgml-empty-tag-p (sgml-tag-name tag-info))
(message "Spurious </%s>: empty tag" (sgml-tag-name tag-info))
- (push (sgml-tag-name tag-info) ignore)))
+ (push (sgml-tag-name tag-info) stack)))
))
;; return context
(* sgml-basic-offset (length context)))))))
(otherwise
- (error "Unrecognised context %s" (car lcon)))
+ (error "Unrecognized context %s" (car lcon)))
))
("dir" ,@list)
("font" nil "size" ("-1") ("+1") ("-2") ("+2") ,@1-7)
("form" (\n _ \n "<input type=\"submit\" value=\"\""
- (if sgml-xml-mode "/>" ">"))
+ (if sgml-xml-mode " />" ">"))
("action" ,@(cdr href)) ("method" ("get") ("post")))
("h1" ,@align)
("h2" ,@align)
("dir" . "Directory list (obsolete)")
("dl" . "Definition list")
("dt" . "Term to be definined")
- ("em" . "Emphasised")
+ ("em" . "Emphasized")
("embed" . "Embedded data in foreign format")
("fig" . "Figure")
("figa" . "Figure anchor")
<p>Paragraphs only need an opening tag. Line breaks and multiple spaces are
ignored unless the text is <pre>preformatted.</pre> Text can be marked as
-<b>bold</b>, <i>italic</i> or <u>underlined</u> using the normal M-g or
+<b>bold</b>, <i>italic</i> or <u>underlined</u> using the normal M-o or
Edit/Text Properties/Face commands.
Pages can have <a name=\"SOMENAME\">named points</a> and can link other points
(define-skeleton html-href-anchor
"HTML anchor tag with href attribute."
"URL: "
- '(setq input "http:")
+ ;; '(setq input "http:")
"<a href=\"" str "\">" _ "</a>")
(define-skeleton html-name-anchor
"HTML anchor tag with name attribute."
"Name: "
- "<a name=\"" str "\">" _ "</a>")
+ "<a name=\"" str "\""
+ (if sgml-xml-mode (concat " id=\"" str "\""))
+ ">" _ "</a>")
(define-skeleton html-headline-1
"HTML level 1 headline tags."
(define-skeleton html-horizontal-rule
"HTML horizontal rule tag."
nil
- (if sgml-xml-mode "<hr/>" "<hr>") \n)
+ (if sgml-xml-mode "<hr />" "<hr>") \n)
(define-skeleton html-image
"HTML image tag."
- nil
- "<img src=\"" _ "\""
- (if sgml-xml-mode "/>" ">"))
+ "Image URL: "
+ "<img src=\"" str "\" alt=\"" _ "\""
+ (if sgml-xml-mode " />" ">"))
(define-skeleton html-line
"HTML line break tag."
nil
- (if sgml-xml-mode "<br/>" "<br>") \n)
+ (if sgml-xml-mode "<br />" "<br>") \n)
(define-skeleton html-ordered-list
"HTML ordered list tags."
"HTML paragraph tag."
nil
(if (bolp) nil ?\n)
-
\n "<p>" _ (if sgml-xml-mode "</p>"))
+ "<p>" _ (if sgml-xml-mode "</p>"))
(define-skeleton html-checkboxes
"Group of connected checkbox inputs."
"\" name=\"" (or v1 (setq v1 (skeleton-read "Name: ")))
"\" value=\"" str ?\"
(when (y-or-n-p "Set \"checked\" attribute? ")
- (funcall skeleton-transformation " checked"))
- (if sgml-xml-mode "/>" ">")
+ (funcall skeleton-transformation
+ (if sgml-xml-mode " checked=\"checked\"" " checked")))
+ (if sgml-xml-mode " />" ">")
(skeleton-read "Text: " (capitalize str))
(or v2 (setq v2 (if (y-or-n-p "Newline after text? ")
(funcall skeleton-transformation
- (if sgml-xml-mode "<br/>" "<br>"))
+ (if sgml-xml-mode "<br />" "<br>"))
"")))
\n))
"\" name=\"" (or (car v2) (setcar v2 (skeleton-read "Name: ")))
"\" value=\"" str ?\"
(when (and (not v1) (setq v1 (y-or-n-p "Set \"checked\" attribute? ")))
- (funcall skeleton-transformation " checked"))
- (if sgml-xml-mode "/>" ">")
+ (funcall skeleton-transformation
+ (if sgml-xml-mode " checked=\"checked\"" " checked")))
+ (if sgml-xml-mode " />" ">")
(skeleton-read "Text: " (capitalize str))
(or (cdr v2) (setcdr v2 (if (y-or-n-p "Newline after text? ")
(funcall skeleton-transformation
- (if sgml-xml-mode "<br/>" "<br>"))
+ (if sgml-xml-mode "<br />" "<br>"))
"")))
\n))
(provide 'sgml-mode)
-;;; arch-tag: 9675da94-b7f9-4bda-ad19-73ed7b4fb401
+;; arch-tag: 9675da94-b7f9-4bda-ad19-73ed7b4fb401
;;; sgml-mode.el ends here
HCoop / bpt / emacs.git / blobdiff