root/trunk/tdtd/tdtd.el

;;;; tdtd.el --- Tony's DTD mode
;; $Id: tdtd.el,v 1.45 2001-08-31 23:15:22-04 tkg Exp $
;; $Name: tdtd08b1 $

;; Copyright (C) 1996, 1997, 1998, 1999, 2001, 2007 Tony Graham

;; Author: Tony Graham <tkg@menteith.com>
;; Contributors: Juanma Barranquero, Adam di Carlo

;;; This file is not part of GNU Emacs.

;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License
;; as published by the Free Software Foundation; either version 2
;; of the License, or (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, write to the Free Software
;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.


;;;; Commentary:

;; Macros for editing DTDs

;; Requires tdtd-font.el
;; Requires 'etags for `find-tag-default'
;; Requires 'imenu for "TAGS" menu
;; Requires 'make-regexp for tdtd-font.el
;; Requires 'reporter for `dtd-submit-bug-report'
;; Send bugs to tdtd-bug@menteith.com


;;;; Code:
(eval-and-compile
  (require 'font-lock))
(eval-and-compile
  (autoload 'sgml-validate "psgml"))
(eval-and-compile
  (autoload 'reporter-submit-bug-report "reporter"))
;; XEmacs users don't always have imenu.el installed, so use
;; condition-case to cope if we cause an error by requiring imenu.
(eval-and-compile
  (condition-case nil
        (require 'imenu)
    (error nil)))

;; We need etags for `find-tag-default'
(require 'etags)
(require 'cl)
(require 'tdtd-font "tdtd-font")

(provide 'tdtd)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Version information

(defconst tdtd-version "0.8b2"
  "Version number of tdtd.")

(defun tdtd-version ()
  "Returns the value of the variable `tdtd-version'."
  tdtd-version)

(defconst tdtd-maintainer-address "tdtd-bug@menteith.com")

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Variables

(defvar dtd-autodetect-type t
  "*Non-nil enables autodetection of XML or SGML when entering `dtd-mode'.")

(defvar dtd-xml-flag nil
  "*Non-nil enables XML-specific behaviour, where implemented.")

(defvar dtd-decl-flag nil
  "*Non-nil enables SGML Declaration-specific behaviour, where implemented.")

(defvar dtd-sys-decl-flag nil
  "*Non-nil enables System Declaration-specific behaviour, where implemented.")

(defun dtd-xml-p ()
  "Returns t when XML-specific behaviour is enabled, otherwise returns nil."
  (if dtd-xml-flag
      t nil))

(defun dtd-decl-p ()
  "Returns t when SGML Declaration-specific behaviour is enabled, otherwise nil."
  (if dtd-decl-flag
      t nil))

(defun dtd-sys-decl-p ()
  "Returns t when System Declaration-specific behaviour is enabled, otherwise nil."
  (if dtd-sys-decl-flag
      t nil))

(defvar dtd-use-after-change-functions-flag t
  "*Non-nil enables use of after-change functions")

(defvar dtd-indent-tabs-mode nil
  "*Initial value of indent-tabs-mode on entering dtd-mode")

(defvar dtd-default-filespec "*.dtd *.ent"
  "*Inital prompt value for `dtd-etags''s FILESPEC argument.")

(defvar dtd-filespec-history (list dtd-default-filespec)
  "Minibuffer history list for `dtd-etags' and `dtd-grep''s FILESPEC argument.")

(defvar dtd-grep-pattern-history nil
  "Minibuffer history list for `dtd-grep''s PATTERN argument.")

(defvar dtd-grep-case-sensitive-flag nil
  "*Non-nil disables case insensitive searches by `dtd-grep'.")

(defvar dtd-grep-command-format
  "grep -n %s -- '%s' %s"
  "*Format string for the grep command called by `dtd-grep'.")

;; Aren't shell escapes fun!
;; "\" -> "\\\\\\"
;; any other significant character -> "\\" + character
(defvar dtd-etags-regex-option
  "--regex=/\\<\\!\\\\\\(ELEMENT\\\\\\|ENTITY\\[\\ \\\\\\t]\\+%\\\\\\|NOTATION\\\\\\|ATTLIST\\\\\\)\\[\\ \\\\\\t]\\+\\\\\\(\\[^\\ \\\\\\t]\\+\\\\\\)/\\\\\\2/"
  "*Complete, including \"--regex=\", etags regular expression option string
for the etags command line for extracting tags (in the Emacs sense)
from DTDs.")
;; Use this regex with 4NT:
;; "--regex=\"/<!\\(ELEMENT\\|ENTITY[ \\t]+%%\\|NOTATION\\|ATTLIST\\)[\\t]+\\([^ \\t]+\\)/\\2/\""

(defvar dtd-etags-program "etags"
  "*Name (and possibly path) of the etags program")

(defvar dtd-etags-output-file "TAGS"
  "*Name of the etags output file")

(defvar dtd-attribute-type-history
  (list "CDATA" "ID" "IDREF" "IDREFS"
        "ENTITY" "ENTITIES" "NMTOKEN" "NMTOKENS" "NOTATION ")
  "Minibuffer history list for attribute types.")

(defvar dtd-attribute-tag-history nil
  "Minibuffer history list for attribute tags.")

(defvar dtd-attribute-default-history
  (list "#IMPLIED" "#REQUIRED")
  "Minibuffer history list for attribute types.")

(defvar dtd-default-element-type-name nil
  "Default for element type names.")

(defvar dtd-declared-element-type-names nil
  "List of element type names recently declared.")

(defvar dtd-referenced-element-type-names nil
  "List of element type names recently entered in content models.")

(defvar dtd-declared-parameter-entity-names nil
  "List of parameter entity names recently declared.")

(defvar dtd-referenced-parameter-entity-names nil
  "List of parameter entity names recently entered in content models.")

(defvar dtd-element-type-name-history nil
  "Minibuffer history list for element type names.")

(defvar dtd-parameter-entity-value-history nil
  "Minibuffer history list for parameter entity values.")

(defvar dtd-external-entity-public-history nil
  "Minibuffer history list for external entity public identifiers.")

(defvar dtd-external-entity-system-history nil
  "Minibuffer history list for external entity system identifiers.")

(defvar dtd-element-comment-history nil
  "Minibuffer history list for element comments.")

(defvar dtd-element-content-spec-history
  (list "(#PCDATA)" "EMPTY" "ANY")
  "Minibuffer history list for element content specifications.")

(defvar dtd-upcase-name-comment-flag nil
  "*Non-nil enables converting descriptive name comments to uppercase.")

(defvar dtd-prompt-descriptive-name t
  "*Non-nil enables prompting for descriptive names of elements, etc.")

(defvar dtd-prompt-descriptive-comment t
  "*Non-nil enables prompting for descriptive comments for elements, etc.")

(defvar dtd-outdent-attribute-pe nil
  "*Non-nil enables outdenting parameter entities used for attributes.")

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Character sequences

(defvar dtd-sgml-mdo "<!"
  "*Markup Delimiter Open (MDO) character sequence")

(defvar dtd-sgml-mdc ">"
  "*Markup Delimiter Close (MDC) character sequence")

(defvar dtd-comment-start "<!--"
  "*Comment start character sequence")

(defvar dtd-comment-end "-->"
  "*Comment end character sequence")

;; SGML Syntactic Literals
(defvar dtd-empty-literal "EMPTY"
  "EMPTY element syntactic literal")

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Variables controlling indentation

(defvar dtd-dtd-max-column 70
  "*Rightmost column for text in the DTD")

(defvar dtd-mdc-indent-column (1- dtd-dtd-max-column)
  "*Column at which to insert a MDC")

(defvar dtd-comment-start-column 25
  "*Column for starting text in a comment")

(defvar dtd-comment-max-column (- dtd-dtd-max-column 3)
  "*Maximum column number for text in a comment")

;; (defvar dtd-sgml-comment-max-column (- dtd-dtd-max-column 2))

(defvar dtd-element-name-column 12
  "*Column for element name in an element declaration")

(defvar dtd-element-tag-omission-column 25
  "*Column for inserting the omissibility indicators, if used")

(defvar dtd-element-content-spec-start-column 29
  "*Column at which to start content model")

(defvar dtd-element-content-spec-continuation-column 30
  "*Column at which to start second and subsequent lines of content model")

(defvar dtd-xml-element-content-spec-start-column 25
  "*Column at which to start XML content model")

(defvar dtd-xml-element-content-spec-continuation-column
  (1+ dtd-xml-element-content-spec-start-column)
  "*Column at which to start second and subsequent lines of XML content model")

(defvar dtd-entity-entity-value-start-column 24
  "*Column at which to start parameter entity's entity value")

(defvar dtd-entity-entity-value-continuation-column
  (1+ dtd-entity-entity-value-start-column)
  "*Column at which to start second and subsequent lines of parameter entity value")

(defvar dtd-attribute-name-column (+ dtd-element-name-column 2)
  "*Indent for inserting attribute names in attribute definitions")

(defvar dtd-attribute-default-column (- dtd-dtd-max-column 10)
  "*Indent for inserting attribute defaults in attribute definitions")

(defvar dtd-line-comment
  (concat
   dtd-comment-start
   " "
   (make-string
    (- dtd-dtd-max-column
       (length (concat dtd-comment-start "  " dtd-comment-end)))
    ?=)
   " "
   dtd-comment-end
   "\n")
  "*Separator comment line: \"<!-- ==== -->\".")

(defvar dtd-init-comment-column 16)

(defvar dtd-init-comment-fill-prefix
  (concat
   dtd-comment-start
   (make-string (- dtd-init-comment-column (length dtd-comment-start))
                ?\ ))
  "*Prefix for comments making up the initial comment in a module.")

(defvar dtd-design-comment-start-column (+ (length dtd-comment-start) 2)
  "*Column for starting text in a \"Design Considerations\" comment")


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Functions

(defun dtd-autodetect-type ()
  "Check for initial declaration and set flags accordingly."
  (interactive)
  (save-excursion
    (goto-char (point-min))
    (skip-chars-forward "\\s-")
    (cond
     ((looking-at "<\\?xml")
      (setq dtd-xml-flag t)
      (setq dtd-decl-flag nil)
      (setq dtd-sys-decl-flag nil))
     ((looking-at "<!SGML")
      (setq dtd-xml-flag nil)
      (setq dtd-decl-flag t)
      (setq dtd-sys-decl-flag nil))
     ((looking-at "<!SYSTEM")
      (setq dtd-xml-flag nil)
      (setq dtd-decl-flag nil)
      (setq dtd-sys-decl-flag t))
     (t
      (setq dtd-xml-flag nil)
      (setq dtd-decl-flag nil)
      (setq dtd-sys-decl-flag nil)))))

;; If you want to untabify everything every time, add this to functions
;;  (untabify (point-min) (point-max))
;; Its easier to just not insert tabs using:
;;  (setq indent-tabs-mode nil)
(defun dtd-untabify-buffer ()
  "Untabify the entire buffer"
  (interactive)
  (untabify (point-min) (point-max)))

(defun dtd-fix-entities ()
  "Quick and dirty addition of \";\" to entity references lacking it"
  (interactive)
  (save-excursion
    (goto-char (point-min))
    (while
        (re-search-forward "\\([%&][-A-Za-z0-9.:_]+\\)\\([^-A-Za-z0-9.:_;]\\)" nil t)
      (replace-match "\\1;\\2" nil nil)
      ;; match 2 may be the start of another entity reference
      (goto-char (match-beginning 2)))))

(defun dtd-toggle-debug-on-error ()
  "Toggle the value of debug-on-error"
  (interactive)
  (setq debug-on-error (not debug-on-error))
  (message "debug-on-error: %s" debug-on-error))

(defun dtd-indent-or-newline-to (target-column)
  "Indent to TARGET COLUMN or, if at or past target, insert newline and indent."
  (if (>= (current-column)
          target-column)
      (insert "\n"))
  (indent-to target-column))

(defun dtd-center-comment (comment)
  "Center a comment on line"
  (interactive "sComment: ")
  (insert dtd-comment-start)
  (indent-to (/ (- dtd-dtd-max-column (length comment)) 2))
  (insert comment)
  (indent-to dtd-comment-max-column)
  (insert dtd-comment-start)
  (insert "\n"))

(defun dtd-recenter-comment ()
  "Recenter text in a presumably modified comment line"
  (interactive)
  (save-excursion
    (save-match-data
      (beginning-of-line)
      (if (looking-at "^<!--\\s-*\\(\\w+\\(\\W+\\w+\\)*\\)\\s-*-->$")
          (let ((contents (match-string 1)))
            (delete-region (match-beginning 0) (match-end 0))
            (dtd-center-comment contents))))))

(defun dtd-filled-comment (comment)
  "Insert a comment with \"=\" in most of the whitespace"
  (interactive "sComment: ")
  (dtd-comment comment "="))

;; TDTD house style puts all comments starting on a favourite column
(defun dtd-comment (comment &optional fill-character)
  "Insert COMMENT starting at the usual column.

With a prefix argument, e.g. \\[universal-argument] \\[dtd-comment], insert separator comment
lines above and below COMMENT in the manner of `dtd-big-comment'."
  (interactive "sComment: ")
  (if current-prefix-arg
      (insert dtd-line-comment))
  (insert "\n")
  (backward-char)
  (let ((fill-column (1- dtd-comment-max-column))
        (fill-prefix (make-string (1- dtd-comment-start-column) ?\ ))
        (comment-start dtd-init-comment-fill-prefix)
        (saved-auto-fill-function auto-fill-function))
    (auto-fill-mode 1)
    (insert dtd-comment-start)
    (if (and
         (stringp fill-character)
         (not (string-equal fill-character "")))
        (progn
          (insert " ")
          (insert (make-string (- dtd-comment-start-column
                                  (current-column)
                                  2)
                               (string-to-char fill-character)))))
    (indent-to (1- dtd-comment-start-column))
    (fill-region (point) (save-excursion
                           (insert comment)
                           (point))
                 nil
                 1
                 1)
    ;; The fill does the right thing, but in Emacs 19.34 it always ends with
    ;; an extra newline, so we delete the newline.
    (if (bolp)
        (delete-backward-char 1))
    (if (not saved-auto-fill-function)
        (auto-fill-mode 0))
    (if (and
         (stringp fill-character)
         (not (string-equal fill-character "")))
        (progn
          (insert " ")
          (insert (make-string (- dtd-comment-max-column
                                  (current-column)
                                  1)
                               (string-to-char fill-character)))))
    (indent-to dtd-comment-max-column)
    (insert dtd-comment-end)
    (insert "\n")
    (if current-prefix-arg
        (insert dtd-line-comment))
    (if font-lock-mode
        (save-excursion
          (font-lock-fontify-region
           (dtd-font-lock-region-point-min)
           (dtd-font-lock-region-point-max))))))

(defun dtd-recomment ()
  "Fix text position in a presumably modified comment line"
  (interactive)
  (save-excursion
    (save-match-data
      (beginning-of-line)
      (if (looking-at "^\\(<!--*\\)?\\s-*\\([^ \t\n>]+\\([- \t]+[^- \t\n>]+\\)*\\)\\s-*\\(-->\\)?\n")
          (let ((contents (match-string 2)))
            (delete-region (match-beginning 0) (match-end 0))
            (dtd-comment contents))))))

(defun dtd-join-comments (mark point)
  "Join comments by removing the \"interior\" comment delimiters."
  (interactive "r")
  (save-excursion
    (save-match-data
      (goto-char (min mark point))
      ;; Insert a comment start if there isn't one at the beginning.
      (if (not (looking-at dtd-comment-start))
          (progn
            (if (looking-at (make-string (length dtd-comment-start) ?\ ))
                (delete-region (match-beginning 0) (match-end 0)))
            (insert dtd-comment-start)))
      ;; Delete the "interior" comment delimiters
      (goto-char (min mark point))
      (while (re-search-forward
              (concat "[ \t\n]*" dtd-comment-end "\n" dtd-comment-start)
              (max mark point) t)
        (replace-match (concat "\n" (make-string
                                     (length dtd-comment-start)
                                     ?\ ))
                       nil nil))))
  ;; Insert a comment end if there isn't one at the end
  ;;      (goto-char (- (max mark point)
  ;;                (length dtd-comment-end)))
  ;;      (if (not (looking-at dtd-comment-end))
  ;;      
  (if font-lock-mode
      (save-excursion
        (font-lock-fontify-region
         (dtd-font-lock-region-point-min)
         (dtd-font-lock-region-point-max)))))

(defun dtd-declare-element (element-tag element-name element-comment content-spec)
  "Insert an element type declaration at the current point.

ELEMENT-TAG is the element type name as it appears in start- and
end-tags.  ELEMENT-NAME is a descriptive name for the element.  It is
output as a comment.  ELEMENT-COMMENT is a further comment about the
element.  This comment is not output if ELEMENT-COMMENT is an empty
string.  CONTENT-SPEC is the element type's content specification.

When dtd-xml-flag in nil, the omitted tag minimization parameter is
output as part of the element type declaration.  When CONTENT-SPEC is
\"EMPTY\", the minimization parameter is \"- o\", otherwise it is \"- -\"

When dtd-upcase-name-comment-flag is non-nil, the text of the
descriptive element name is converted to uppercase before output.

ELEMENT-NAME is not prompted for if dtd-prompt-descriptive-name is
nil, and ELEMENT-COMMENT is not prompted for if
dtd-prompt-descriptive-comment is nil.

An example inserted element type declaration is as follows:

<!--                    Element name                               -->
<!--                    Comment about the element: what it's for,
                        or something about its behaviour           -->
<!ELEMENT  element-tag  - - (insert, your, content, specification,
                             here)                                   >
"
  (interactive
   ;; Hackery and fakery
   (let ((element-tag nil))
     (list (progn
             ;; set element-tag to what's read from the minibuffer
             (setq element-tag
                   (dtd-read-from-minibuffer
                    "Element tag: "
                    (car dtd-referenced-element-type-names)
                    'dtd-referenced-element-type-names))
             ;; complain if element-tag is an empty string and there's no
             ;; default
             (if (string-equal element-tag "")
                 (if default
                     (setq element-tag default)
                   (error "You must supply an element tag name"))
               ;; return element-tag is we had one already
               element-tag))
           (if dtd-prompt-descriptive-name
               (read-from-minibuffer (format "<%s> descriptive name: "
                                             element-tag)
                                     ;; use element-tag as the default for
                                     ;; the descriptive name since we often
                                     ;; base the descriptive name on it
                                     element-tag nil nil nil)
             "")
           (if dtd-prompt-descriptive-comment
               (read-from-minibuffer (format "<%s> comment: "
                                             element-tag)
                                     nil nil nil
                                     'dtd-element-comment-history)
             "")
           (read-from-minibuffer (format "<%s> content spec: "
                                         element-tag)
                                 nil nil nil
                                 'dtd-element-content-spec-history))))
  (if (not
       (string-equal element-name ""))
      (progn
        (if dtd-upcase-name-comment-flag
            (setq element-name (upcase element-name)))
        (dtd-comment element-name)))
  (if (not
       (string-equal element-comment ""))
      (dtd-comment element-comment))
  (insert "\n")
  (backward-char)
  (insert "<!ELEMENT  ")
  (insert element-tag)
  (if dtd-autodetect-type
      (dtd-autodetect-type))
  (if (not dtd-xml-flag)
      (progn
        (dtd-indent-or-newline-to (1- dtd-element-tag-omission-column))
        (if (string-equal content-spec dtd-empty-literal)
            (insert "- o")
          (insert "- -"))))
  (dtd-indent-or-newline-to
   (if dtd-xml-flag
       (1- dtd-xml-element-content-spec-start-column)
     (1- dtd-element-content-spec-start-column)))
  (let ((fill-column dtd-mdc-indent-column)
        (fill-prefix (make-string
                      (if dtd-xml-flag
                          (1-
                           dtd-xml-element-content-spec-continuation-column)
                        (1- dtd-element-content-spec-continuation-column))
                      ?\ ))
        (saved-auto-fill-function auto-fill-function))
    (auto-fill-mode 1)
    (fill-region (point) (save-excursion
                           (insert content-spec)
                           (point))
                 nil
                 1
                 1)
    ;; The fill does the right thing, but in Emacs 19.34 it always ends with
    ;; an extra newline, so we delete the newline.
    (if (bolp)
        (delete-backward-char 1))
    ;;    (setq content-spec-end (point))
    (if (not saved-auto-fill-function)
        (auto-fill-mode 0))
    (dtd-indent-or-newline-to dtd-mdc-indent-column)
    (insert (concat dtd-sgml-mdc "\n"))
    (auto-fill-mode nil)
    (if font-lock-mode
        (save-excursion
          (font-lock-fontify-region
           (dtd-font-lock-region-point-min)
           (dtd-font-lock-region-point-max))))
    ;; Add to the list of element type names that has already been seen
    (add-to-list 'dtd-declared-element-type-names element-tag)
    ;; Work out whether it's safe to remove element-tag from the list of
    ;; element type names that's been seen referenced in content models
    ;; and parameter entity declarations
    ;;
    ;; Before working anything out, need to remove element-type-name
    ;; from the start of dtd-referenced-element-type-names (since that's
    ;; the minibuffer history list variable)
    (setq dtd-referenced-element-type-names
          (cdr dtd-referenced-element-type-names))
    (if (member element-tag dtd-referenced-element-type-names)
        ;; There has to be an easier way to do this.
        (setq dtd-referenced-element-type-names
              (catch 'roll-referenced-element-type-names
                (let ((bypassed-element-type-names nil))
                  (while (car dtd-referenced-element-type-names)
                    (let ((element-type-name
                           (car dtd-referenced-element-type-names)))
                      (setq dtd-referenced-element-type-names
                            (cdr dtd-referenced-element-type-names))
                      (if (equal element-tag element-type-name)
                          (throw
                           'roll-referenced-element-type-names
                           (append dtd-referenced-element-type-names
                                   bypassed-element-type-names))
                        (setq bypassed-element-type-names
                              (reverse
                               (add-to-list 'bypassed-element-type-names
                                            element-type-name))))))))))
    (dtd-analyse-content-spec content-spec)))

(defun dtd-analyse-content-spec (content-spec)
  "Eventually, decide if need declarations for anything referenced in CONTENT-SPEC.

CONTENT-SPEC is an element type's content specification as provided to
`dtd-declare-element' or `dtd-declare-parameter-entity'."
;;  (message "%s" content-spec)
  (if (not (or (string-equal content-spec "ANY")
               (string-equal content-spec "CDATA")
               (string-equal content-spec "EMPTY")
               (string-equal content-spec "RCDATA")))
      (let ((match-index nil)
            (token-list nil))
        (save-match-data
          (while (string-match "\\(%?[-A-Za-z0-9#:._]+;?\\)"
                               content-spec match-index)
            (add-to-list 'token-list (substring content-spec
                                               (match-beginning 1)
                                               (match-end 1)))
            (setq match-index (match-end 0))))
        (while token-list
          (let* ((token (car token-list))
                 (pe-flag (string-equal "%" (substring token 0 1))))
            (if (not (string-equal token "#PCDATA"))
                (progn
;;                (message "%s" token)
                  (if pe-flag
                      (progn
                        (setq token (substring token
                                               1
                                               (1- (length token))))
                        (if (not (member token
                                         dtd-declared-parameter-entity-names))
                            (add-to-list
                             'dtd-referenced-parameter-entity-names
                             token)))
                    (if (not (member token
                                     dtd-declared-element-type-names))
                        (add-to-list 'dtd-referenced-element-type-names
                                     token))))))
            (setq token-list (cdr token-list))))))

;;(defun dtd-update-element-lists-with-element
;;  "Analyse the elements definition as if it had just been declared."
;;  (if (looking-at "\\(<!ELEMENT\\)\\(\\s-+\\)\\sw+")
;;        (progn
;;          (goto-char (match-end 0))
;;          (add-to-list 'dtd-declared-element-type-names (match-string 1))
;;          (goto-char (match-end 2))
;;          (if (looking-at "\\([-o]\\)\\s-+\\([-o]\\)\\s-+")
;;              (goto-char (match-end 0)))
;;          (if (looking-at ("("))
;;              (

(defun dtd-defined-in-comment (element-tag other-module)
  "Insert an \"ELEMENT-TAG  is defined in OTHER-MODULE\" comment.

ELEMENT-TAG is the element type name as it appears in start- and
end-tags.  OTHER-MODULE is the name of the module in which the element
is defined.

An example inserted \"defined in\" comment is as follows:

<!--       ELEMENT-TAG  is defined in OTHER-MODULE                 -->
"
  (interactive
   ;; Hackery and fakery
   (let ((element-tag nil))
     (list (progn
             ;; set element-tag to what's read from the minibuffer
             (setq element-tag
                   (dtd-read-from-minibuffer
                    "Element tag: "
                    (car dtd-referenced-element-type-names)
                    'dtd-referenced-element-type-names))
             ;; complain if element-tag is an empty string and there's no
             ;; default
             (if (string-equal element-tag "")
                 (if default
                     (setq element-tag default)
                   (error "You must supply an element tag name"))
               ;; return element-tag is we had one already
               element-tag))
           (read-from-minibuffer "module name: "))))
  (insert "\n")
  (backward-char)
  (insert dtd-comment-start)
  (dtd-indent-or-newline-to (1- dtd-element-name-column))
  (insert element-tag)
  (dtd-indent-or-newline-to (1- dtd-comment-start-column))
  (insert (format "is defined in %s" other-module))
  (indent-to dtd-comment-max-column)
  (insert dtd-comment-end)
  (insert "\n")
  ;; Add to the list of element type names that we've already seen
  (add-to-list 'dtd-declared-element-type-names element-tag)
  ;; Remove element-type-name from the start of
  ;; dtd-referenced-element-type-names (since that's the minibuffer
  ;; history list variable)
  (setq dtd-referenced-element-type-names
        (cdr dtd-referenced-element-type-names))
  (if (member element-tag dtd-referenced-element-type-names)
      ;; There has to be an easier way to do this.
      (setq dtd-referenced-element-type-names
            (catch 'roll-referenced-element-type-names
              (let ((bypassed-element-type-names nil))
                (while (car dtd-referenced-element-type-names)
                  (let ((element-type-name
                         (car dtd-referenced-element-type-names)))
                    (setq dtd-referenced-element-type-names
                          (cdr dtd-referenced-element-type-names))
                    (if (equal element-tag element-type-name)
                        (throw
                         'roll-referenced-element-type-names
                         (append dtd-referenced-element-type-names
                                 bypassed-element-type-names))
                      (setq bypassed-element-type-names
                            (reverse
                             (add-to-list 'bypassed-element-type-names
                                          element-type-name))))))))))
  (if font-lock-mode
      (save-excursion
        (font-lock-fontify-region
         (dtd-font-lock-region-point-min)
         (dtd-font-lock-region-point-max)))))

(defun dtd-read-from-minibuffer (prompt default history)
  "Read from minibuffer with default and command history."
(let ((value nil))
  (if (string-equal
       ""
       (setq value
             (read-from-minibuffer (if default
                                       (format
                                        "%s(default `%s') "
                                        prompt default)
                                     (format "%s" prompt))
                                   nil nil nil
                                   history)))
             default
             value)))

(defun dtd-declare-attribute
  (attribute-tag attribute-comment attribute-type attribute-default)
  "Declare an attribute.

ATTRIBUTE-TAG is the attribute name.  ATTRIBUTE-NAME is a descriptive
name for the attribute.  It is output as a comment.  ATTRIBUTE-COMMENT
is a further comment about the attribute.  This comment is not output
if ATTRIBUTE-COMMENT is an empty string.  ATTRIBUTE-TYPE is the
attribute's type or enumeration declaration.  ATTRIBUTE-DEFAULT is the
attribute's default.

ATTRIBUTE-COMMENT is not prompted for if
dtd-prompt-descriptive-comment is nil.

If called interactively and not after \"<!ATTLIST\", also calls
`dtd-declare-attribute-list' before prompting for ATTRIBUTE-TAG.

`dtd-declare-attribute' takes care of inserting or moving the \">\"
that closes the attribute list declaration."
  (interactive
   (let ((attribute-tag nil))
     ;; Hackery and fakery
     ;; If we're not after "<!ATTLIST", call dtd-declare-attribute-list.
     ;; This is an abomination, but don't know a better way to do it.
     ;;
     ;; Do `save-excursion', etc. while we check.
     (if (not (save-excursion
                (save-match-data
                  (re-search-backward "^<!" nil t)
                  (looking-at "<!ATTLIST"))))
         (dtd-declare-attribute-list
          ;; This is largely a repeat of the (interactive) statement
          ;; in dtd-declare-attribute-list
          (dtd-read-from-minibuffer
           "Element type: "
           (save-excursion
             (save-match-data
               (re-search-backward "^<!ELEMENT[ \t]+\\([^ \t\n]+\\)" nil t)
               (match-string 1)))
           'dtd-declared-element-type-names)))
     (list (setq attribute-tag
                 (dtd-read-from-minibuffer "Attribute tag: "
                                           nil
                                           'dtd-attribute-tag-history))
           (if dtd-prompt-descriptive-comment
               (dtd-read-from-minibuffer (format "\"%s\" comment: "
                                                 attribute-tag)
                                         nil nil)
             "")
           (dtd-read-from-minibuffer
            (format "\"%s\" type or enumeration: " attribute-tag)
            (car dtd-attribute-type-history)
            'dtd-attribute-type-history)
           (dtd-read-from-minibuffer
            (format "\"%s\" default: " attribute-tag)
            (car dtd-attribute-default-history)
            'dtd-attribute-default-history))))
  (if (and (stringp attribute-comment)
           (not (string-equal attribute-comment "")))
      (save-excursion
        (re-search-backward "^<!ATTLIST" nil t)
        (insert dtd-comment-start)
        (dtd-indent-or-newline-to (1- dtd-attribute-name-column))
        (if (and
             dtd-outdent-attribute-pe
             (string-equal (substring attribute-tag 0 1) "%"))
            (delete-backward-char 1))
        (insert attribute-tag)
        (dtd-indent-or-newline-to (1- dtd-comment-start-column))
        (let ((fill-column dtd-mdc-indent-column)
              (fill-prefix (make-string
                            (1- dtd-comment-start-column) ?\ ))
              (saved-auto-fill-function auto-fill-function))
          ;;    (auto-fill-mode 1)
          ;;    (setq content-spec-start (point))
          (fill-region (point) (save-excursion
                                 (insert attribute-comment)
                                 (insert "\n")
                                 (point))
                       nil
                       1
                       1)
          ;; The fill does the right thing, but in Emacs 19.34 it
          ;; always ends with an extra newline, so we delete the newline.
          (if (bolp)
              (delete-backward-char 1))
          (dtd-indent-or-newline-to dtd-comment-max-column)
          (insert dtd-comment-end)
          (insert "\n"))
        ;; Now see if we need to merge with a previous comment
        (let ((previous-comment-beginning
               (save-excursion
                 (re-search-backward "<!" nil t 2)
                 (if (looking-at dtd-comment-start)
                     (point)
                   nil))))
          (if previous-comment-beginning
              (dtd-join-comments previous-comment-beginning (point))))))
  ;; Do it all again for the actual declaration
  (let ((fill-column dtd-mdc-indent-column)
        (fill-prefix (make-string
                      (1- dtd-comment-start-column) ?\ ))
        (saved-auto-fill-function auto-fill-function))
    ;; If we're after a declaration, delete the preceding mdc and any
    ;; whitespace around it.
    (if (not (save-excursion
               (re-search-backward "^<!\\|>" nil t)
               (looking-at "<!ATTLIST")))
        (save-excursion
          (delete-region (point)
                         (save-excursion
                           (re-search-backward "[^ \t\n\r>]" nil t)
                           (1+ (point))))))
    (dtd-indent-or-newline-to (1- dtd-attribute-name-column))
    (if (string-equal (substring attribute-tag 0 1) "%")
        (delete-backward-char 1))
    (insert attribute-tag)
    (dtd-indent-or-newline-to (1- dtd-comment-start-column))
    (fill-region (point) (save-excursion
                           (insert attribute-type)
                           (insert "\n")
                           (point))
                 nil
                 1
                 1)
    ;; The fill does the right thing, but in Emacs 19.34 it always ends with
    ;; an extra newline, so we delete the newline.
    (if (bolp)
        (delete-backward-char 1))
    ;; We want the default to line up on dtd-attribute-default-column
    ;; unless it's too long, in which case we want one space between
    ;; the end of the default and the mdc (>).
    (if (< (length attribute-default)
           (- dtd-dtd-max-column dtd-attribute-default-column 1))
        (dtd-indent-or-newline-to (1- dtd-attribute-default-column))
      (dtd-indent-or-newline-to (- dtd-dtd-max-column
                                   (length attribute-default)
                                   2)))
    (insert attribute-default)
    ;; Insert an mdc only if there isn't one between here and the
    ;; next mdo.
    (if (or (looking-at "<")
            (not (save-excursion
                   (re-search-forward "^<!\\|>" nil t)
                   (goto-char (match-beginning 0))
                   (looking-at ">"))))
        (progn
          (dtd-indent-or-newline-to dtd-mdc-indent-column)
          (insert dtd-sgml-mdc)))
    (insert "\n")
    (if font-lock-mode
        (save-excursion
          (font-lock-fontify-region
           (dtd-font-lock-region-point-min)
           (dtd-font-lock-region-point-max))))))

(defun dtd-declare-attribute-list (element-type-name)
  "Declare an attribute list."
  (interactive
   (list (dtd-read-from-minibuffer
          "Element type: "
          (save-excursion
            (save-match-data
              (re-search-backward "^<!ELEMENT[ \t]+\\([^ \t\n]+\\)" nil t)
              (match-string 1)))
          'dtd-declared-element-type-names)))
  (insert (concat "<!ATTLIST  " element-type-name "\n")))

(defun dtd-declare-notation
  (notation-tag notation-name notation-comment public-identifier system-identifier)
  "Insert a notation declaration.

NOTATION-TAG is the notation name as it appears in notation
references.  NOTATION-NAME is a descriptive name for the notation.  It
is output as a comment.  NOTATION-COMMENT is a further comment about
the notation.  The comment is not output if NOTATION-COMMENT is an
empty string.  PUBLIC-IDENTIFIER is the notation\'s public identifier
\(without '\"' characters).  SYSTEM-IDENTIFIER is the notation's system
identifier (without '\"' characters).

NOTATION-NAME is not prompted for if dtd-prompt-descriptive-name is
nil, and NOTATION-COMMENT is not prompted for if
dtd-prompt-descriptive-comment is nil.

An example inserted notation type declaration is as follows:

<!--                    Notation name                                -->
<!--                    Comment about the notation: what it's for,
                        or something about its behaviour           -->
<!NOTATION notation-tag   PUBLIC
\"-//Complete//NOTATION Public Identifier//EN\"
                                                                   -->
%notation-tag;
"
  (interactive
   ;; Hackery and fakery
   (let ((notation-tag nil))
     (list (progn
             ;; set notation-tag to what's read from the minibuffer
             (setq notation-tag
                   (dtd-read-from-minibuffer
                    "Notation tag: "
                    (car dtd-referenced-notation-type-names)
                    'dtd-referenced-notation-type-names))
             ;; complain if notation-tag is an empty string and there's no
             ;; default
             (if (string-equal notation-tag "")
                 (if default
                     (setq notation-tag default)
                   (error "You must supply an notation tag name"))
               ;; return notation-tag is we had one already
               notation-tag))
           (if dtd-prompt-descriptive-name
               (read-from-minibuffer (format "`%s' descriptive name: "
                                             notation-tag)
                                     ;; use notation-tag as the default for
                                     ;; the descriptive name since we often
                                     ;; base the descriptive name on it
                                     notation-tag nil nil nil)
             "")
           (if dtd-prompt-descriptive-comment
               (read-from-minibuffer (format "`%s' comment: "
                                             notation-tag)
                                     nil nil nil
                                     'dtd-notation-comment-history)
             "")
           (read-from-minibuffer (format "`%s' content spec: "
                                         notation-tag)
                                 nil nil nil
                                 'dtd-notation-content-spec-history))))
  (if (not
       (string-equal notation-name ""))
      (progn
        (if dtd-upcase-name-comment-flag
            (setq notation-name (upcase notation-name)))
        (dtd-comment notation-name)))
  (if (not
       (string-equal notation-comment ""))
        (dtd-comment notation-comment))
;;  (insert "\n")
;;  (backward-char)
  (insert "<!NOTATION ")
  (insert notation-tag)
  (dtd-indent-or-newline-to (1- dtd-element-content-spec-start-column))
  (if (not
       (string-equal public-identifier ""))
      (progn
        (insert "PUBLIC\n")
        (insert (concat "\"" public-identifier "\"\n")))
    (insert "SYSTEM "))
  (if (not
       (string-equal system-identifier ""))
      (insert (concat "\"" system-identifier "\"\n")))
  (indent-to dtd-mdc-indent-column)
  (insert dtd-sgml-mdc)
  (insert "\n")
  (if font-lock-mode
        (save-excursion
          (font-lock-fontify-region
           (dtd-font-lock-region-point-min)
           (dtd-font-lock-region-point-max)))))

(defun dtd-declare-external-entity
  (entity-tag entity-name entity-comment public-identifier system-identifier)
  "Insert an entity declaration and references for an external public entity.

ENTITY-NAME is a descriptive name for the entity.  It is output as a
comment.  ENTITY-COMMENT is a further comment about the entity.  The
comment is not output if ENTITY-COMMENT is an empty string.
ENTITY-TAG is the entity name as it appears in entity references.
PUBLIC-IDENTIFIER is the entity's public identifier (without '\"'
characters).  SYSTEM-IDENTIFIER is the entity's system identifier
\(without '\"' characters).

ENTITY-NAME is not prompted for if dtd-prompt-descriptive-name is nil,
and ENTITY-COMMENT is not prompted for if
dtd-prompt-descriptive-comment is nil.

An example inserted entity type declaration is as follows:

<!--                    Entity name                                -->
<!--                    Comment about the entity: what it's for,
                        or something about its behaviour           -->
<!ENTITY % entity-tag   PUBLIC
\"-//Complete//ENTITY Public Identifier//EN\"
                                                                   -->
%entity-tag;
"
;;  (interactive "sEntity tag: \nsEntity name: \nsEntity comment: \nsPublic Identifier: \nsSystem Identifier: ")
  (interactive
   ;; Hackery and fakery
   (let ((entity-tag nil))
     (list (setq entity-tag
                 (read-from-minibuffer "External entity tag: "
                                       nil nil nil
                                       'dtd-referenced-parameter-entity-names))
           (if dtd-prompt-descriptive-name
               (read-from-minibuffer (format "`%%%s;\' descriptive name: "
                                             entity-tag)
                                     nil nil nil nil)
             "")
           (if dtd-prompt-descriptive-comment
               (read-from-minibuffer (format "`%%%s;' comment: "
                                             entity-tag)
                                     nil nil nil nil)
             "")
           (read-from-minibuffer (format "`%%%s;' public identifier: "
                                         entity-tag)
                                 nil nil nil
                                 'dtd-external-entity-public-history)
           (read-from-minibuffer (format "`%%%s;' system identifier: "
                                         entity-tag)
                                 nil nil nil
                                 'dtd-external-entity-system-history))))
  (if (not
       (string-equal entity-name ""))
      (progn
        (if dtd-upcase-name-comment-flag
            (setq entity-name (upcase entity-name)))
        (dtd-comment entity-name)))
;;  (insert "\n")
  (if (not
       (string-equal entity-comment ""))
      (progn
        (dtd-comment entity-comment)
        (insert "\n")))
;;  (insert "\n")
;;  (backward-char)
  (insert "<!ENTITY % ")
  (insert entity-tag)
  (if dtd-autodetect-type
      (dtd-autodetect-type))
  (dtd-indent-or-newline-to
   (if dtd-xml-flag
       (1- dtd-xml-element-content-spec-start-column)
       (1- dtd-element-content-spec-start-column)))
  (if (not
       (string-equal public-identifier ""))
      (progn
        (insert "PUBLIC\n")
        (insert (concat "\"" public-identifier "\"\n")))
    (insert "SYSTEM "))
  (if (not
       (string-equal system-identifier ""))
      (insert (concat "\"" system-identifier "\"\n")))
  (indent-to dtd-mdc-indent-column)
  (insert (concat dtd-sgml-mdc "\n"))
  (insert (concat "%" entity-tag ";\n"))
  (if font-lock-mode
        (save-excursion
          (font-lock-fontify-region
           (dtd-font-lock-region-point-min)
           (dtd-font-lock-region-point-max)))))

(defun dtd-declare-parameter-entity
  (entity-tag entity-name entity-comment entity-value)
  "Insert a parameter entity declaration at the current point.

ENTITY-NAME is a descriptive name for the entity.  It is output as a
comment.  ENTITY-COMMENT is a further comment about the entity.  The
comment is not output if ENTITY-COMMENT is an empty string.
ENTITY-TAG is the entity type name as it appears in start- and
end-tags.  ENTITY-VALUE is the entity's value specification, without
the '\"' characters.

ENTITY-NAME is not prompted for if dtd-prompt-descriptive-name is nil,
and ENTITY-COMMENT is not prompted for if
dtd-prompt-descriptive-comment is nil.

An example inserted parameter entity declaration is as follows:

<!--                    Entity name                               -->
<!--                    Comment about the entity: what it's for,
                        or something about its behaviour           -->
<!ENTITY % entity-tag   \"parameter, entity, contents\"                >
"
  (interactive
   ;; Hackery and fakery
   (let ((entity-tag nil))
     (list (setq entity-tag
                 (read-from-minibuffer "Entity tag: "
                                       nil nil nil
                                       'dtd-referenced-parameter-entity-names))
           (if dtd-prompt-descriptive-name
               (read-from-minibuffer (format "`%%%s;\' descriptive name: "
                                             entity-tag)
                                     nil nil nil nil)
             "")
           (if dtd-prompt-descriptive-comment
               (read-from-minibuffer (format "`%%%s;' comment: "
                                             entity-tag)
                                     nil nil nil nil)
             "")
           (read-from-minibuffer (format "`%%%s;' value: "
                                         entity-tag)
                                 nil nil nil
                                 'dtd-parameter-entity-value-history))))
  (if (not
       (string-equal entity-name ""))
      (progn
        (if dtd-upcase-name-comment-flag
            (setq entity-name (upcase entity-name)))
        (dtd-comment entity-name)))
  (if (not
       (string-equal entity-comment ""))
      (dtd-comment entity-comment))
  (insert "<!ENTITY % ")
  (insert entity-tag)
  (dtd-indent-or-newline-to (1- dtd-entity-entity-value-start-column))
  (insert "\"")
  (let ((fill-column dtd-mdc-indent-column)
        (fill-prefix (make-string
                      (1- dtd-entity-entity-value-continuation-column) ?\ ))
        (saved-auto-fill-function auto-fill-function))
    (auto-fill-mode 1)
    (fill-region (point) (save-excursion
                           (insert entity-value)
                           (insert "\"")
                           (point))
                 nil
                 1
                 1)
    ;; The fill does the right thing, but in Emacs 19.34 it always ends with
    ;; an extra newline, so we delete the newline.
    (if (bolp)
        (delete-backward-char 1))
    (if (not saved-auto-fill-function)
        (auto-fill-mode 0))
    (dtd-indent-or-newline-to dtd-mdc-indent-column)
    (insert (concat dtd-sgml-mdc "\n"))
    (auto-fill-mode nil)
    (if font-lock-mode
        (save-excursion
          (font-lock-fontify-region
           (dtd-font-lock-region-point-min)
           (dtd-font-lock-region-point-max))))
    (add-to-list 'dtd-declared-parameter-entity-names entity-tag)
    (if (member entity-tag dtd-referenced-parameter-entity-names)
        (setq dtd-referenced-parameter-entity-names
              (delete entity-tag dtd-referenced-parameter-entity-names)))
    (dtd-analyse-content-spec entity-value)))

(defun dtd-insert-mdc ()
  "Without moving point, indent to usual column and insert MDC (>).
MDC = Markup Declaration Close"
  (interactive)
  (save-excursion
    (let ((current-point (point))
          (mdc-column 0)
          (mdc dtd-sgml-mdc))
      ;; Only insert a mdc if looking at an mdo or if there's a previous mdo
      (if (if (looking-at dtd-sgml-mdo)
              1
            (re-search-backward (concat "^" dtd-sgml-mdo) nil t))
          (progn
            (if (looking-at dtd-comment-start)
              (progn
                (setq mdc dtd-comment-end)
                (setq mdc-column dtd-comment-max-column))
              (progn
                (setq mdc dtd-sgml-mdc)
                (setq mdc-column dtd-mdc-indent-column)))
            (goto-char current-point)
            (beginning-of-line)
            (cond
             ;; The main "looking-at" regular expression doesn't handle
             ;; line containing just "-->" or ">" very well, so handle
             ;; as special case.
             ((looking-at "\\s-*\\(--\\)?>$")
              (progn
                ;; Delete to the end of line so we can then insert our mdc
               (delete-region (point) (save-excursion
                                        (end-of-line)
                                        (point)))
               (indent-to mdc-column)
               (insert mdc)))
             ;; Another special case: just comment start and end
             ((looking-at "\\(\\s-*<!--\\)\\s-+-->$")
              (goto-char (match-end 1))
              (delete-region (point) (save-excursion
                                       (end-of-line)
                                       (point)))
              (indent-to mdc-column)
              (insert mdc))
             ;; This is the main "looking-at" regular expression that
             ;; handles most things
             ((looking-at "^\\(\\(<!\\|[ \t]*\\)?\\(--\\)?[ \t]*\\([^ \t\n>]+\\([- \t]+[^- \t\n>]+\\)*\\)?\\)[ \t]*\\(\\(--\\)?>?\\)?$")
              (progn
                ;;(message ":%s:%s:%s:%s:" mdc mdc-column (match-string 4) (match-string 1))
                (goto-char (match-end 1))
                (delete-region (point) (save-excursion
                                         (end-of-line)
                                         (point)))
                (dtd-indent-or-newline-to mdc-column)
                (insert mdc)))
             (t
              ;;(insert "@")
              (message "Could not insert mdc")))))))
  (if font-lock-mode
      (save-excursion
        (font-lock-fontify-region
         (dtd-font-lock-region-point-min)
         (dtd-font-lock-region-point-max)))))

;; A work in progress
(defun dtd-fill-paragraph (&optional justify)
  "DTD fill paragraph function.  A work in progress."
  (interactive "P")
  ;;(insert "DTD")
  (save-excursion
    (if dtd-autodetect-type
        (dtd-autodetect-type))
    (let ((current-point (point))
          (fill-column dtd-mdc-indent-column)
          (fill-prefix (make-string
                        (if dtd-xml-flag
                            (1-
                             dtd-xml-element-content-spec-continuation-column)
                          (1- dtd-element-content-spec-continuation-column))
                        ?\ ))
          (saved-auto-fill-function auto-fill-function))
      (if (not (looking-at dtd-sgml-mdo))
          (re-search-backward (concat "^" dtd-sgml-mdo) nil t))
      (if (looking-at "\\(<!ELEMENT\\)\\(\\s-+\\)")
          (progn
            (goto-char (match-end 1))
            (delete-region (match-beginning 2) (match-end 2))
            (dtd-indent-or-newline-to (1- dtd-element-name-column))
            (if (looking-at "\\(\\sw\\|\\s_\\)+\\(\\s-+\\)")
                (progn
                  (message "It's an element")
                  (delete-region (match-beginning 2) (match-end 2))
                  (goto-char (match-end 1))
                  (if (looking-at "\\([-o]\\)\\s-+\\([-o]\\)\\s-+")
                      (let ((omit-start (match-string 1))
                            (omit-end (match-string 2)))
                        (message "It has ommissibility indicators")
                        (message "%s %s" omit-start omit-end)
                        (delete-region
                         (match-beginning 0) (match-end 0))
                        (dtd-indent-or-newline-to
                         (1- dtd-element-tag-omission-column))
                        (insert omit-start)
                        (insert " ")
                        (insert omit-end)))
                  (dtd-indent-or-newline-to
                   (1-
                    (if dtd-xml-flag
                        dtd-xml-element-content-spec-start-column
                      dtd-element-content-spec-start-column)))
                  (auto-fill-mode 1)
;;                (let ((content-model-start (point))
;;                      (content-model-end (save-excursion
;;                                           (forward-sexp)
;;                                           (point))))
                  (save-excursion
                    (let ((content-model-end (save-excursion
                                               (forward-sexp)
                                               (point))))
                    (while (re-search-forward
                            "\n+"
                            content-model-end t)
                      (replace-match " " nil nil))))
                  (fill-region (point) (save-excursion
                                         (forward-sexp)
                                         (point))
                               nil
                               1
                               1)
                  ;; The fill does the right thing, but it always ends with
                  ;; an extra newline, so we delete the newline.
                  (backward-char 1)
                  ;;    (setq content-spec-end (point))
                  (if (not saved-auto-fill-function)
                      (auto-fill-mode 0))))
            (dtd-insert-mdc)
;;                (insert "$")
;;          (if (looking-at "\\(\\s-*\\)>")
;;              (progn
;;                (delete-region (match-beginning 1) (match-end 1))
;;                (dtd-indent-or-newline-to dtd-mdc-indent-column)
;;                (insert "$")
))
;;                (dtd-insert-mdc)
;;                (insert "\n")
;;                (auto-fill-mode nil)
                  (if font-lock-mode
        (save-excursion
          (font-lock-fontify-region
           (dtd-font-lock-region-point-min)
           (dtd-font-lock-region-point-max)))))))
;;          (if (looking-at "ANY\\|CDATA\\|EMPTY\\|RCDATA")
;;              (progn
;;                (dtd-indent-or-newline-to
;;                 (1- dtd-element-content-spec-start-column)))
;;            (message "It's something else"))))))
        ;; If we're not doing anything, return nil so the built-in function
        ;; will run
;;  (font-lock-fontify-block))


;; Functions that set fill-prefix, etc. for various regions in a DTD
(defun dtd-comment-setup ()
  "Setup the auto-fill variables for comments in the body of the DTD"
  (interactive)
  (setq fill-prefix (make-string (1- dtd-comment-start-column) ?\ ))
  (auto-fill-mode 'true)
  (setq fill-column dtd-comment-max-column))

(defun dtd-design-comment-setup ()
  "Setup the auto-fill variables for \"Design Considerations\" comments"
  (interactive)
  (setq fill-prefix (make-string
                     (1- dtd-design-comment-start-column)
                     ?\ ))
  (auto-fill-mode 'true)
  (setq fill-column dtd-comment-max-column))

(defun dtd-declaration-setup ()
  "Setup the auto-fill variables for declarations"
  (interactive)
  (setq fill-prefix (make-string
                     (1- dtd-element-content-spec-continuation-column)
                     ?\ ))
  (auto-fill-mode 'true)
  (setq fill-column dtd-mdc-indent-column))

(defun dtd-init-comment-setup ()
  "Setup the auto-fill variables for initial comments"
  (interactive)
  (setq fill-prefix dtd-init-comment-fill-prefix)
  (auto-fill-mode 'true)
  (setq fill-column (- dtd-dtd-max-column (length dtd-comment-end))))

;;(setq fill-paragraph-function 'dtd-fill-paragraph)

;; Not quite sure what this gets me, but these variables seem to apply
;; in auto-fill mode
(make-local-variable 'comment-start)
(setq comment-start "<!-- ")
(make-local-variable 'comment-end)
(setq comment-end " -->")


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; imenu stuff

(defun dtd-sort-alist (alist)
  "Sort an alist"
  (sort
   alist
   (lambda (a b) (string< (car a) (car b)))))

(defun dtd-imenu-create-index-function ()
  "Create an alist of elements, etc. suitable for use with imenu."
  (let ((element-alist '())
        (notation-alist '())
        (general-entity-alist '())
        (parameter-entity-alist '()))
    (goto-char (point-min))
    (while
        (re-search-forward
         "^<!ELEMENT[ \t]+\\([^ \t\n]+\\)+[ \t\n]+\\([-o][ \t]+[-o][ \t]+\\)?(*" nil t)
      (setq element-alist
            (cons (cons (buffer-substring-no-properties
                         (match-beginning 1)
                         (match-end 1))
                        (match-end 0))
                  element-alist)))
    (goto-char (point-min))
    (while
        (re-search-forward
         "^<!NOTATION[ \t]+\\([^ \t\n]+\\)" nil t)
      (setq notation-alist
            (cons (cons (buffer-substring-no-properties
                         (match-beginning 1)
                         (match-end 1))
                        (match-beginning 1))
                  notation-alist)))
    (goto-char (point-min))
    (while
        (re-search-forward
         "^<!ENTITY[ \t]+\\([^% \t\n]+\\)" nil t)
      (setq general-entity-alist
            (cons (cons (buffer-substring-no-properties
                         (match-beginning 1)
                         (match-end 1))
                        (match-beginning 1))
                  general-entity-alist)))
    (goto-char (point-min))
    (while
        (re-search-forward
         "^<!ENTITY[ \t]+%[ \t]+\\([^ \t\n]+\\)[ \t\n]+[\"']?" nil t)
      (setq parameter-entity-alist
            (cons (cons (buffer-substring-no-properties
                         (match-beginning 1)
                         (match-end 1))
                        (match-end 0))
                  parameter-entity-alist)))
    (append
     (if notation-alist
         (list (cons "<!NOTATION" (dtd-sort-alist notation-alist))))
     (if general-entity-alist
         (list (cons "<!ENTITY" (dtd-sort-alist general-entity-alist))))
     (if parameter-entity-alist
         (list (cons "<!ENTITY %" (dtd-sort-alist parameter-entity-alist))))
     (dtd-sort-alist element-alist))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; grep stuff

;;;###autoload
(defun dtd-grep (pattern filespec)
  "Grep for PATTERN in files matching FILESPEC.

Runs `grep' with PATTERN and FILESPEC as arguments.

PATTERN is the pattern on which `grep' is to match.  PATTERN is quoted
with single quotes in the `grep' command arguments to avoid
interpretation of characters in PATTERN.  `dtd-grep' maintains a
history of PATTERNs so you can easily re-use a previous value.

FILESPEC is the names or regular expression for the files to be
scanned by grep.  Since `dtd-grep' uses `grep', regular expressions
and multiple filenames are supported, and \"*.dtd\" and \"*.dtd
*.ent\" are both valid FILESPEC values.

When called interactively, the initial FILESPEC is taken from
dtd-default-filespec, but `dtd-grep' also maintains a history of
FILESPEC arguments so you can easily re-use a previous value.  The
history is shared with `dtd-etags' so you can re-use the same FILESPEC
with both functions.
"
  (interactive
   (list
    (dtd-read-from-minibuffer "Pattern: "
                              (find-tag-default)
                              'dtd-grep-pattern-history)
    (dtd-read-from-minibuffer "Files: "
                              (car dtd-filespec-history)
                              'dtd-filespec-history)))
  ;; We include "--" in the command in case the pattern starts with "-"
  (grep (format dtd-grep-command-format
                (if (not dtd-grep-case-sensitive-flag)
                    "-i")
                pattern
                filespec)))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Tags stuff

;;;###autoload
(defun dtd-etags (filespec)
  "Execute etags on FILESPEC and match on DTD-specific regular expressions.

Runs the \"etags\" program on the specified file with a regular
expression for finding element, entity, attribute list, and notation
declarations.  `dtd-tags' then modifies the output tags file to
disambiguate parameter entity names versus other names.

FILESPEC is the names or regular expression for the files to be
scanned by etags.  `dtd-etags' uses `shell-command' to execute etags
specifically so regular expressions and multiple filenames are
supported, and \"*.dtd\" and \"*.dtd *.ent\" are both valid FILESPEC
values.

When called interactively, the initial prompt is taken from
dtd-default-filespec, but `dtd-etags' also maintains a history of
FILESPEC arguments so you can easily re-use a previous value.  The
history is shared with `dtd-grep' so you can re-use the same FILESPEC
with both functions.

The output tags file is added to tags-table-list using
`visit-tags-table', and, depending on the value of tags-add-tables,
you may be prompted whether to add the new tags table to the current
list or to start a new list.

`dtd-etags' also uses the dtd-etags-program, dtd-etags-regex-option,
and dtd-etags-output-file variables to construct the command passed to
`shell-command'."
  (interactive
   (list (dtd-read-from-minibuffer "Files: "
                                   (car dtd-filespec-history)
                                   'dtd-filespec-history)))
  (shell-command
   (format "%s %s --output=%s %s"
           dtd-etags-program
           dtd-etags-regex-option
           dtd-etags-output-file
           filespec))
  (save-excursion
    (save-window-excursion
      ;; We could be visiting the TAGS file, which causes an
      ;; unecessary complication when Emacs prompts to see if
      ;; we want to reload the buffer, so we just kill it out
      ;; of hand.  Since more than one buffer can be visiting it,
      ;; we make sure we catch them all.
      (while (get-file-buffer dtd-etags-output-file)
        (kill-buffer (get-file-buffer dtd-etags-output-file)))
      (find-file dtd-etags-output-file)
      (while (re-search-forward
              "^\\(<!ENTITY[ \t]+%[ \t]+[^\177]+\177\\)\\([^%\1]+\\)"
              nil t)
        (replace-match "\\1%\\2;" nil nil))
      ;; Go again to find element names to add to
      ;; dtd-declared-element-type-names
      (goto-char (point-min))
      ;; Remove whatever we had as dtd-declared-element-type-names
      (setq dtd-declared-element-type-names nil)
      ;; Add the element names as found by the etags program
      (while (re-search-forward
              "^<!ELEMENT[ \t]+\\([^\177]+\\)"
              nil t)
        (add-to-list 'dtd-declared-element-type-names (match-string 1)))
      ;; Don't bother saving a backup
      (setq backup-inhibited t)
      (save-buffer)
      (kill-buffer (current-buffer))
      (visit-tags-table
       (expand-file-name dtd-etags-output-file)))))

(defun dtd-find-tag-hook ()
  "Slight customization of find-tags."
  ;; If we're looking at an element declaration, move point to the first
  ;; syntactic literal, element type name, or parameter entity reference
  ;; in the content model.
  (cond
   ((looking-at
     "<!ELEMENT[ \t]+[^ \t]+[ \t\n]+\\([-o][ \t]+[-o][ \t]+\\)?(*")
    (goto-char (match-end 0)))
   ((looking-at
     "<!ATTLIST[ \t]+[^ \t]+[ \t\n]+")
    (goto-char (match-end 0)))
   ((looking-at
     "<!ENTITY[ \t]+%[ \t]+[^ \t]+[ \t\n]+\"?")
      (goto-char (match-end 0)))))


(defvar dtd-mode-abbrev-table nil
  "Abbrev table used while in DTD mode.")

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Mode map stuff

(defvar dtd-mode-map nil
  "Keymap for DTD mode.")

(if dtd-mode-map
    ()
  (setq dtd-mode-map (make-sparse-keymap))
  (define-key dtd-mode-map ">"                         'dtd-electric-mdc)
  (define-key dtd-mode-map '[(control c) (>)]          'dtd-insert-mdc)
  (define-key dtd-mode-map '[(control c) (control a)]  'dtd-declare-attribute)
  (define-key dtd-mode-map '[(control c) (control n)]  'dtd-declare-notation)
  (define-key dtd-mode-map '[(control c) (meta control %)]
    'dtd-declare-external-entity)
  (define-key dtd-mode-map '[(control c) (control %)]
    'dtd-declare-parameter-entity)
  (define-key dtd-mode-map '[(control c) (control e)]  'dtd-declare-element)
  (define-key dtd-mode-map '[(control c) (control c)]  'dtd-comment)
  (define-key dtd-mode-map '[(control c) (control v)]  'sgml-validate)
  ;;(define-key dtd-mode-map '[(control c) (b)]     'dtd-big-comment)
  (define-key dtd-mode-map '[(meta g) (meta f)]    'font-lock-fontify-buffer)
  (define-key dtd-mode-map '[(meta g) (meta control g)]
    'font-lock-fontify-buffer)
  (define-key dtd-mode-map '[(meta control g)]     'font-lock-fontify-buffer)
  (define-key dtd-mode-map [(control m)]          'dtd-electric-return)
  ;; This overrides the sgml-mode mapping and puts it back to its default
  (define-key dtd-mode-map '[(meta tab)]           'complete-tag))

(defun dtd-electric-mdc ()
  (interactive)
  (insert ">")
  (if font-lock-mode
      (save-excursion
        (font-lock-fontify-region
         (dtd-font-lock-region-point-min)
         (dtd-font-lock-region-point-max)))))

(defun dtd-electric-return ()
  "What do do for a newline in dtd mode"
  (interactive)
  (message "%s" (current-column))
  (if (= (char-before) ?>)
      (progn
        (message "mdc")
        (insert "\n"))
    (progn
      ;;  (message "%s" (current-column))
      (insert "\n")
      (delete-horizontal-space)
      (indent-to
       (save-excursion
         (backward-char )
         (delete-horizontal-space)
         (let*
             ((declaration-type
               (save-excursion
                 (re-search-backward "^<!")
                 (cond
                  ((looking-at "<!ELEMENT") 'element)
                  ((looking-at "<!ATTLIST") 'attlist)
                  ((looking-at "<!--") 'comment)
                  ((looking-at "<!ENTITY\\s-+%") 'parameter-entity)
                  ((looking-at "<!ENTITY") 'entity)
                  ((looking-at "<!DOCTYPE") 'doctype)
                  ((looking-at "<!\\[\\s-+CDATA") 'cdata-section)
                  (t
                   'unknown))))
              (indent
               (progn
                 (message "%s" declaration-type)
                 (beginning-of-line)
;;               (insert "@")
                 (case declaration-type
                   ('element
                    (cond
                     ((looking-at "<!ELEMENT\\s-*$")
                      (message "ELEMENT")
                      (1- dtd-element-name-column))
                     ((looking-at "<!ELEMENT\\s-+\\sw+\\s-*$")
                      (message "ELEMENT name")
                      (1- (if dtd-xml-flag
                              dtd-xml-element-content-spec-start-column
                            dtd-element-tag-omission-column)))
                     ((looking-at
                       "<!ELEMENT\\s-+\\sw+\\s-+[-oO]\\s-+[-oO]\\s-*$")
                      (1- dtd-element-content-spec-start-column))
                     ((looking-at
                       "<!ELEMENT\\s-+\\sw+\\s-+[-oO]\\s-+[-oO]\\s-+\\S+")
                      (message "ELEMENT name")
                      dtd-element-content-spec-start-column)
                     ((looking-at "<!ELEMENT\\s-+\\sw+\\s-+[^-oO]")
                      (message "ELEMENT name xml")
                      (1-
                       dtd-xml-element-content-spec-continuation-column))
                     ((looking-at "\\s-+[-oO]\\s-+[-oO]\\s-+(")
                      (message "SGML element continuation")
                      (1- dtd-element-content-spec-continuation-column))
                     ((looking-at "\\(\\s-+\\)\\S-+")
                      (goto-char (match-end 1))
                      (current-column))
                     (t
                      (message "other element")
                      0)))
                    ('attlist
                     (cond
                      ((looking-at "<!ATTLIST$")
                       (message "attlist")
                       (1- dtd-element-name-column))
                      ((looking-at "<!ATTLIST\\s-+\\sw+")
                       (message "attlist element name")
                       (1- dtd-attribute-name-column))
                      ((looking-at
                        "\\(\\s-+\\(\\sw+\\s-+\\)?NOTATION\\s-+(\\)")
                       (if (save-excursion
                             (end-of-line)
                             (= (char-before) ?\)))
                           (progn
                             (message "Finished NOTATION list")
                             (1- dtd-attribute-default-column))
                         (progn
                           (message "Unfinished NOTATION list")
                           (- (match-end 1) (match-beginning 1)))))
                      ((looking-at "[^(]*([^)]*)\\s-+$")
                       (message "Finished group")
                       (1- dtd-attribute-default-column))
                      ((looking-at "\\(\\s-+\\)\\sw+\\s-*")
                       (message "attribute list, single token")
                       (end-of-line)
                       (delete-horizontal-space)
                       (cond
                        ((or
                          (= (char-before) ?\))
                          (= (char-before) ?\"))
                         (message "attribute list, after ) or \"")
                         (1- dtd-attribute-default-column))
                        ((<= (abs (- (- (match-end 1)
                                        (match-beginning 1))
                                     dtd-attribute-name-column))
                             2)
                         (message "After attribute name")
                         (1- dtd-comment-start-column))
                        (t
                         (goto-char (match-end 1))
                         (current-column))))
                      ((looking-at "\\(\\s-+\\)(")
                       (message "Start of group")
                       (goto-char (match-end 1))
                       (1+ (current-column)))
                      ((looking-at "\\(\\s-+\\)\\sw")
                       (if (<= (abs (- (length (- (match-end 1)
                                                  (match-beginning 1)))
                                       dtd-attribute-name-column))
                               2)
                           (1- dtd-comment-start-column)
                         (progn
                           (message "??")
                           (goto-char (match-end 1))
                           (current-column))))
                      ((looking-at "\\(\\s-+\\)\\sw+\\s-+\\sw")
                       (goto-char (match-end 1))
                       (current-column))
                      (t
                       (message "other attlist")
                       0)))
                    ('parameter-entity
                     (cond
                      ((looking-at
                        "<!ENTITY\\s-+%\\s-+\\sw+\\s-+\\(PUBLIC\\|SYSTEM\\)$")
                       (message "PUBLIC or SYSTEM")
                       0)
                      ((looking-at "<!ENTITY\\s-+%\\s-+\\sw+\\s-+\"")
                       (message "Internal PE continuation")
                       dtd-entity-entity-value-continuation-column)
                      ((looking-at "<!ENTITY\\s-+%\\s-+\\sw")
                       (message "Internal PE")
                       (1- dtd-entity-entity-value-start-column))
                     ((looking-at "\\(\\s-+\\)\\(\\sw\\|(\\)+")
                       dtd-entity-entity-value-continuation-column)
                     (t
                      (message "other parameter entity")
                      0)))
                    ('comment
                     (cond
                      ((looking-at "<!--")
                       (message "comment")
                       (re-search-forward
                        "<!--\\s-+")
                       (current-column))
                     ((looking-at "\\(\\s-+\\)\\(\\sw\\|(\\)+")
                      (goto-char (match-end 1))
                      (current-column))
                     (t
                      (message "other comment")
                      0)))
                    ('unknown
                     (message "unknown")
                     0)))))
           indent))))))

;;         (cond
;;          ((looking-at "\\(\\s-+\\)\\(\\sw\\|(\\)+")
;;           (message "whitespace+")
;;           (if (progn
;;                 (re-search-backward "<")
;;                 (looking-at "<!ATTLIST"))
;;               (progn
;;                 (message "inside ATTLIST")
;;                 (end-of-line)
;;                 (backward-char)
;;                 (if (looking-at ")")
;;                     (1- dtd-attribute-default-column)))
;;             (progn
;;               (message "also inside ATTLIST")
;;               ;;            (end-of-line)
;;               (if (looking-at "\\(\\s-+\\)\\(\\sw\\|(\\)+")
;;                   (goto-char (match-end 1)))
;;               (current-column))))
;;          ((looking-at "\\s-+")
;;           (message "whitespace")
;;           0)
;;          ((looking-at "$")
;;           (message "end of line")
;;           0)
;;          ((looking-at "<!\\[\W*CDATA")
;;           (message "CDATA marked section")
;;           0)
;;          (t
;;           (message "unknown")
;;           0))))
;;      (message "%s" (current-column)))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Syntax table stuff

(defvar dtd-mode-syntax-table nil
  "Syntax table used while in DTD mode.")

(if dtd-mode-syntax-table
    ()
  (setq dtd-mode-syntax-table (make-syntax-table))
  ;; set the non-alphanumeric characters in XML names to
  ;; 'symbol constituent' class
  (modify-syntax-entry ?: "_" dtd-mode-syntax-table)
  (modify-syntax-entry ?_ "_" dtd-mode-syntax-table)
  (modify-syntax-entry ?- "_ 1234" dtd-mode-syntax-table)
  (modify-syntax-entry ?. "_" dtd-mode-syntax-table)
  ;; "-" is a special case because it is the first and second characters
  ;; of the start- and end-comment sequences.
  (modify-syntax-entry ?- "_ 1234" dtd-mode-syntax-table)
  ;; "%" does double duty in parameter entity declarations and references.
  ;; Not necessary to make "%" and ";" act like parentheses since the
  ;; font lock highlighting tells you when you've put the ";" on the
  ;; end of a parameter entity reference.
  (modify-syntax-entry ?% "_" dtd-mode-syntax-table)
  (modify-syntax-entry ?\; "_" dtd-mode-syntax-table)
  ;; "/" is just punctuation in DTDs, and really only has a role in
  ;; Formal Public Identifiers
  (modify-syntax-entry ?/ "." dtd-mode-syntax-table)
  ;; Sometimes a string is more than just a string, Dr Freud.
  ;; Unfortunately, the syntax stuff isn't fussy about matching
  ;; on paired delimeters, and will happily match a single quote
  ;; with a double quote, and vice versa.  At least the font
  ;; lock stuff is more fussy and won't change colour if the
  ;; delimiters aren't paired.
  (modify-syntax-entry ?\" "$" dtd-mode-syntax-table)
  (modify-syntax-entry ?\' "$" dtd-mode-syntax-table)
  ;; The occurrence indicators and connectors are punctuation to us.
  (modify-syntax-entry ?| "." dtd-mode-syntax-table)
  (modify-syntax-entry ?, "." dtd-mode-syntax-table)
  (modify-syntax-entry ?& "." dtd-mode-syntax-table)
  (modify-syntax-entry ?? "." dtd-mode-syntax-table)
  (modify-syntax-entry ?+ "." dtd-mode-syntax-table)
  (modify-syntax-entry ?* "." dtd-mode-syntax-table)
  ;; `<' and `>' are also punctuation
  (modify-syntax-entry ?< "." dtd-mode-syntax-table)
  (modify-syntax-entry ?> "." dtd-mode-syntax-table)
  ;; "#" is syntax too
  (modify-syntax-entry ?# "_" dtd-mode-syntax-table))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Font-lock utility functions

(defun dtd-font-lock-mark-block-function ()
  "Function to mark the area of text we want to fontify.

Used with font-lock-fontify-block.  Set font-lock-mark-block-function
to this function for this function to take effect.

This function marks the area beginning five \"<!\" before point and five
\">\" at ends of lines after point.  The default without a function like
this is to fontify 16 lines before and after point, but then the region
often starts or ends partway through a comment or declaration, turning
that half white because the keywords didn't match, and it just looks so
ugly."
  (let ((current-point (point)))
    (re-search-forward ">$" (point-max) 'limit 5)
    (set-mark (point))
    (goto-char current-point)
    (re-search-backward "^<!" (point-min) 'limit 5)))

(defun dtd-font-lock-region-point-min ()
  "Return the start point of the region we want to fontify"
  (save-excursion
    (re-search-backward "^<!" (point-min) 'limit 5)
;;    (insert "@")
    (point)))

(defun dtd-font-lock-region-point-max ()
  "Return the start point of the region we want to fontify"
  (save-excursion
    (re-search-forward ">$" (point-max) 'limit 5)
;;    (insert "!")
    (point)))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; After change functions

;;(defun dtd-recalc-mdc-after-change (begin end length)
;;  "Recalculate the position of the mdc after a change"
;;  (if dtd-use-after-change-functions-flag
;;      (save-match-data
;;      (save-excursion
;;        (goto-char end)
;;        (end-of-line)
;;        (if (and (= (char-before) ?>)
;;                 (or (= (char-before (- (point) 2)) ?-)
;;                     (= (char-before (- (point) 2)) ?\ )))
;;            (dtd-insert-mdc))))))

(defun dtd-recalc-mdc-after-change (begin end length)
  "Recalculate the position of the mdc after a change"
  (if dtd-use-after-change-functions-flag
      (let ((end-column (save-excursion
                              (goto-char end)
                              (current-column))))
      (save-match-data
        (save-excursion
          (goto-char end)
          (end-of-line)
          (if (and (= (char-before) ?>)
                   (or (= (char-before (- (point) 2)) ?-)
                       (= (char-before (- (point) 2)) ?\ )))
              (dtd-insert-mdc))))
      (if (= (char-before end) ?\ )
          (move-to-column end-column)))))


;;;###autoload
(defun dtd-mode ()
  "Major mode for SGML and XML DTDs.

dtd-mode features include:

 - dtd-etags function for creating Emacs TAGS files for easy lookup of
   any element, parameter entity, or notation's definition using
   Emacs's built-in tag-lookup functions;

 - Font lock highlighting of declarations so that the important
   information stands out;

 - XML-specific behaviour that, at user option, is triggered by
   automatic detection of the XML Declaration; and

 - Functions for writing and editing declarations and comments to ease
   creating and keeping a consistent style.

dtd-mode builds on sgml-mode, and the full sgml-mode functions are
still available.  Use with Lennart Staflin's psgml package is
recommended.

dtd-mode uses many user-definable variables to control the formatting
of declarations, some of which are shown in the following examples:

                        dtd-comment-start-column    dtd-dtd-max-column
                        |                    dtd-comment-max-column  |
                        |                                         |  |
<!--                    This is a comment                          -->

           dtd-element-name-column
           |            dtd-element-tag-ommission-column
           |            |   dtd-element-content-spec-start-column
           |            |   |dtd-element-content-spec-continuation-column
           |            |   ||                      dtd-dtd-max-column
           |            |   ||                                       |
<!ELEMENT  element-tag  - - (insert, your, content, specification,
                             here)                                   >

\\{dtd-mode-map}"
  (interactive)
  (kill-all-local-variables)
  (use-local-map dtd-mode-map)
  (setq mode-name "DTD")
  (setq major-mode 'dtd-mode)
  (setq local-abbrev-table dtd-mode-abbrev-table)
  ;; XEmacs users don't all have imenu
  (if (featurep 'imenu)
      (progn
        ;; If you don't have imenu, you'll get a "free variable"
        ;; warning for imenu-create-index-function when you
        ;; byte-compile, but not having imenu won't cause problems
        ;; when you use tdtd
        (setq imenu-create-index-function 'dtd-imenu-create-index-function)
        (setq imenu-extract-index-name-function 'dtd-imenu-create-index-function)
        (imenu-add-to-menubar "TAGS")))
  (set-syntax-table dtd-mode-syntax-table)
  ;; XML specific behaviour can be specific to a buffer
  (make-local-variable 'dtd-xml-flag)
  ;; Maybe select XML-specific behaviour if we have an XML declaration
  (if dtd-autodetect-type
      (dtd-autodetect-type))
  ;; dtd font-lock highlighting setup
  (make-local-variable 'font-lock-defaults)
  (make-local-variable 'font-lock-mark-block-function)
  (cond
   (dtd-xml-flag
    (setq font-lock-defaults '(dtd-xml-font-lock-keywords t)))
   (dtd-decl-flag
    (setq font-lock-defaults '(dtd-decl-font-lock-keywords t)))
   (dtd-sys-decl-flag
    (setq font-lock-defaults '(dtd-sys-decl-font-lock-keywords t)))
   (t
    (setq font-lock-defaults '(dtd-sgml-font-lock-keywords t))))
  (setq font-lock-mark-block-function 'dtd-font-lock-mark-block-function)
  ;; Enable mode-specific behaviour on finding tags (in the Emacs sense)
  (make-local-variable 'find-tag-hook)
  (add-hook 'find-tag-hook
            'dtd-find-tag-hook)
  (make-local-variable 'after-change-functions)
  (setq after-change-functions '(dtd-recalc-mdc-after-change))
  ;; Maybe insert space characters when user hits "Tab" key
  (setq indent-tabs-mode dtd-indent-tabs-mode)
  (run-hooks 'dtd-mode-hooks))


;;;; Bug reporting

(defun dtd-submit-bug-report ()
  "Submit via mail a bug report on TDTD."
  (interactive)
  (require 'reporter)
  (require 'sendmail)
  (and (y-or-n-p "Do you really want to submit a report on DTD mode? ")
       (reporter-submit-bug-report
        tdtd-maintainer-address
        (concat "tdtd.el " tdtd-version)
        (list 
         'dtd-attribute-default-column
         'dtd-attribute-default-history
         'dtd-attribute-name-column
         'dtd-attribute-tag-history
         'dtd-attribute-type-history
         'dtd-autodetect-type
         'dtd-comment-end
         'dtd-comment-max-column
         'dtd-comment-start
         'dtd-comment-start-column
         'dtd-declared-element-type-names
         'dtd-declared-parameter-entity-names
         'dtd-default-element-type-name
         'dtd-default-filespec
         'dtd-design-comment-start-column
         'dtd-dtd-max-column
         'dtd-element-comment-history
         'dtd-element-content-spec-continuation-column
         'dtd-element-content-spec-history
         'dtd-element-content-spec-start-column
         'dtd-element-name-column
         'dtd-element-tag-omission-column
         'dtd-element-type-name-history
         'dtd-empty-literal
         'dtd-entity-entity-value-start-column
         'dtd-etags-output-file
         'dtd-etags-program
         'dtd-etags-regex-option
         'dtd-filespec-history
         'dtd-grep-case-sensitive-flag
         'dtd-grep-pattern-history
         'dtd-indent-tabs-mode
         'dtd-init-comment-column
         'dtd-init-comment-fill-prefix
         'dtd-line-comment
         'dtd-mdc-indent-column
         'dtd-outdent-attribute-pe
         'dtd-parameter-entity-value-history
         'dtd-referenced-element-type-names
         'dtd-referenced-parameter-entity-names
         'dtd-sgml-mdc
         'dtd-sgml-mdo
         'dtd-upcase-name-comment-flag
         'dtd-xml-element-content-spec-continuation-column
         'dtd-xml-element-content-spec-start-column
         'dtd-xml-flag
         )
        nil
        nil
     "Please change the Subject header to a concise bug description.\nRemember to cover the basics, that is, what you expected to\nhappen and what in fact did happen.  Please remove these\ninstructions from your message.")
    (save-excursion
      (goto-char (point-min))
      (mail-position-on-field "Subject")
      (beginning-of-line)
      (delete-region (point) (progn (forward-line) (point)))
      (insert
       "Subject: tdtd version " tdtd-version " is wonderful but...\n"))))


;;;; Last provisions
;;;(provide 'tdtd)

;;; tdtd.el ends here