lisp/textmodes/sgml-mode.el

   1 ;;; sgml-mode.el --- SGML-editing mode
   2
   3 ;; Copyright (C) 1992 Free Software Foundation, Inc.
   4
   5 ;; Author: James Clark <jjc@clark.com>
   6 ;; Adapted-By: ESR
   7 ;; Keywords: wp
   8
   9 ;; This file is part of GNU Emacs.
  10
  11 ;; GNU Emacs is free software; you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation; either version 2, or (at your option)
  14 ;; any later version.
  15
  16 ;; GNU Emacs is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs; see the file COPYING.  If not, write to
  23 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  24
  25 ;;; Commentary:
  26
  27 ;; Major mode for editing the SGML document-markup language.
  28
  29 ;;; Code:
  30
  31 (provide 'sgml-mode)
  32 (require 'compile)
  33
  34 ;;; sgmls is a free SGML parser available from
  35 ;;; ftp.uu.net:pub/text-processing/sgml
  36 ;;; Its error messages can be parsed by next-error.
  37 ;;; The -s option suppresses output.
  38
  39 (defconst sgml-validate-command
  40   "sgmls -s"
  41   "*The command to validate an SGML document.
  42 The file name of current buffer file name will be appended to this,
  43 separated by a space.")
  44
  45 (defvar sgml-saved-validate-command nil
  46   "The command last used to validate in this buffer.")
  47
  48 (defvar sgml-mode-map nil "Keymap for SGML mode")
  49
  50 (if sgml-mode-map
  51     ()
  52   (setq sgml-mode-map (make-sparse-keymap))
  53   (define-key sgml-mode-map ">" 'sgml-close-angle)
  54   (define-key sgml-mode-map "/" 'sgml-slash)
  55   (define-key sgml-mode-map "\C-c\C-v" 'sgml-validate))
  56
  57 ;;;###autoload
  58 (defun sgml-mode ()
  59   "Major mode for editing SGML.
  60 Makes > display the matching <.  Makes / display matching /.
  61 Use \\[sgml-validate] to validate your document with an SGML parser."
  62   (interactive)
  63   (kill-all-local-variables)
  64   (setq local-abbrev-table text-mode-abbrev-table)
  65   (use-local-map sgml-mode-map)
  66   (setq mode-name "SGML")
  67   (setq major-mode 'sgml-mode)
  68   (make-local-variable 'paragraph-start)
  69   ;; A start or end tag by itself on a line separates a paragraph.
  70   ;; This is desirable because SGML discards a newline that appears
  71   ;; immediately after a start tag or immediately before an end tag.
  72   (setq paragraph-start
  73         "^[ \t\n]\\|\
  74 \\(</?\\([A-Za-z]\\([-.A-Za-z0-9= \t\n]\\|\"[^\"]*\"\\|'[^']*'\\)*\\)?>$\\)")
  75   (make-local-variable 'paragraph-separate)
  76   (setq paragraph-separate
  77         "^[ \t\n]*$\\|\
  78 ^</?\\([A-Za-z]\\([-.A-Za-z0-9= \t\n]\\|\"[^\"]*\"\\|'[^']*'\\)*\\)?>$")
  79   (make-local-variable 'sgml-saved-validate-command)
  80   (set-syntax-table text-mode-syntax-table)
  81   (make-local-variable 'comment-start)
  82   (setq comment-start "<!-- ")
  83   (make-local-variable 'comment-end)
  84   (setq comment-end " -->")
  85   (make-local-variable 'comment-indent-function)
  86   (setq comment-indent-function 'sgml-comment-indent)
  87   (make-local-variable 'comment-start-skip)
  88   ;; This will allow existing comments within declarations to be
  89   ;; recognized.
  90   (setq comment-start-skip "--[ \t]*")
  91   (run-hooks 'text-mode-hook 'sgml-mode-hook))
  92
  93 (defun sgml-comment-indent ()
  94   (if (and (looking-at "--")
  95            (not (and (eq (char-after (1- (point))) ?!)
  96                      (eq (char-after (- (point) 2)) ?<))))
  97       (progn
  98         (skip-chars-backward " \t")
  99         (max comment-column (1+ (current-column))))
 100     0))
 101
 102 (defconst sgml-start-tag-regex
 103   "<[A-Za-z]\\([-.A-Za-z0-9= \n\t]\\|\"[^\"]*\"\\|'[^']*'\\)*"
 104   "Regular expression that matches a non-empty start tag.
 105 Any terminating > or / is not matched.")
 106
 107 (defvar sgml-mode-markup-syntax-table nil
 108   "Syntax table used for scanning SGML markup.")
 109
 110 (if sgml-mode-markup-syntax-table
 111     ()
 112   (setq sgml-mode-markup-syntax-table (make-syntax-table))
 113   (modify-syntax-entry ?< "(>" sgml-mode-markup-syntax-table)
 114   (modify-syntax-entry ?> ")<" sgml-mode-markup-syntax-table)
 115   (modify-syntax-entry ?- "_ 1234" sgml-mode-markup-syntax-table)
 116   (modify-syntax-entry ?\' "\"" sgml-mode-markup-syntax-table))
 117
 118 (defconst sgml-angle-distance 4000
 119   "*If non-nil, is the maximum distance to search for matching <.")
 120
 121 (defun sgml-close-angle (arg)
 122   "Insert > and display matching <."
 123   (interactive "p")
 124   (insert-char ?> arg)
 125   (if (> arg 0)
 126       (let ((oldpos (point))
 127             (blinkpos))
 128         (save-excursion
 129           (save-restriction
 130             (if sgml-angle-distance
 131                 (narrow-to-region (max (point-min)
 132                                        (- (point) sgml-angle-distance))
 133                                   oldpos))
 134             ;; See if it's the end of a marked section.
 135             (and (> (- (point) (point-min)) 3)
 136                  (eq (char-after (- (point) 2)) ?\])
 137                  (eq (char-after (- (point) 3)) ?\])
 138                  (re-search-backward "<!\\[\\(-?[A-Za-z0-9. \t\n&;]\\|\
 139 --\\([^-]\\|-[^-]\\)*--\\)*\\["
 140                                      (point-min)
 141                                      t)
 142                  (let ((msspos (point)))
 143                    (if (and (search-forward "]]>" oldpos t)
 144                             (eq (point) oldpos))
 145                        (setq blinkpos msspos))))
 146             ;; This handles cases where the > ends one of the following:
 147             ;; markup declaration starting with <! (possibly including a
 148             ;; declaration subset); start tag; end tag; SGML declaration.
 149             (if blinkpos
 150                 ()
 151               (goto-char oldpos)
 152               (condition-case ()
 153                   (let ((oldtable (syntax-table))
 154                         (parse-sexp-ignore-comments t))
 155                     (unwind-protect
 156                         (progn
 157                           (set-syntax-table sgml-mode-markup-syntax-table)
 158                           (setq blinkpos (scan-sexps oldpos -1)))
 159                       (set-syntax-table oldtable)))
 160                 (error nil))
 161               (and blinkpos
 162                    (goto-char blinkpos)
 163                    (or
 164                     ;; Check that it's a valid delimiter in context.
 165                     (not (looking-at
 166                           "<\\(\\?\\|/?[A-Za-z>]\\|!\\([[A-Za-z]\\|--\\)\\)"))
 167                     ;; Check that it's not a net-enabling start tag
 168                     ;; nor an unclosed start-tag.
 169                     (looking-at (concat sgml-start-tag-regex "[/<]"))
 170                     ;; Nor an unclosed end-tag.
 171                     (looking-at "</[A-Za-z][-.A-Za-z0-9]*[ \t]*<"))
 172                    (setq blinkpos nil)))
 173             (if blinkpos
 174                 ()
 175               ;; See if it's the end of a processing instruction.
 176               (goto-char oldpos)
 177               (if (search-backward "<?" (point-min) t)
 178                   (let ((pipos (point)))
 179                     (if (and (search-forward ">" oldpos t)
 180                              (eq (point) oldpos))
 181                         (setq blinkpos pipos))))))
 182           (if blinkpos
 183               (progn
 184                 (goto-char blinkpos)
 185                 (if (pos-visible-in-window-p)
 186                     (sit-for 1)
 187                   (message "Matches %s"
 188                            (buffer-substring blinkpos
 189                                              (progn (end-of-line)
 190                                                     (point)))))))))))
 191
 192 ;;; I doubt that null end tags are used much for large elements,
 193 ;;; so use a small distance here.
 194 (defconst sgml-slash-distance 1000
 195   "*If non-nil, is the maximum distance to search for matching /.")
 196
 197 (defun sgml-slash (arg)
 198   "Insert / and display any previous matching /.
 199 Two /s are treated as matching if the first / ends a net-enabling
 200 start tag, and the second / is the corresponding null end tag."
 201   (interactive "p")
 202   (insert-char ?/ arg)
 203   (if (> arg 0)
 204       (let ((oldpos (point))
 205             (blinkpos)
 206             (level 0))
 207         (save-excursion
 208           (save-restriction
 209             (if sgml-slash-distance
 210                 (narrow-to-region (max (point-min)
 211                                        (- (point) sgml-slash-distance))
 212                                   oldpos))
 213             (if (and (re-search-backward sgml-start-tag-regex (point-min) t)
 214                      (eq (match-end 0) (1- oldpos)))
 215                 ()
 216               (goto-char (1- oldpos))
 217               (while (and (not blinkpos)
 218                           (search-backward "/" (point-min) t))
 219                 (let ((tagend (save-excursion
 220                                 (if (re-search-backward sgml-start-tag-regex
 221                                                         (point-min) t)
 222                                     (match-end 0)
 223                                   nil))))
 224                   (if (eq tagend (point))
 225                       (if (eq level 0)
 226                           (setq blinkpos (point))
 227                         (setq level (1- level)))
 228                     (setq level (1+ level)))))))
 229           (if blinkpos
 230               (progn
 231                 (goto-char blinkpos)
 232                 (if (pos-visible-in-window-p)
 233                     (sit-for 1)
 234                   (message "Matches %s"
 235                            (buffer-substring (progn
 236                                                (beginning-of-line)
 237                                                (point))
 238                                              (1+ blinkpos))))))))))
 239
 240 (defun sgml-validate (command)
 241   "Validate an SGML document.
 242 Runs COMMAND, a shell command, in a separate process asynchronously
 243 with output going to the buffer *compilation*.
 244 You can then use the command \\[next-error] to find the next error message
 245 and move to the line in the SGML document that caused it."
 246   (interactive
 247    (list (read-string "Validate command: "
 248                       (or sgml-saved-validate-command
 249                           (concat sgml-validate-command
 250                                   " "
 251                                   (let ((name (buffer-file-name)))
 252                                     (and name
 253                                          (file-name-nondirectory name))))))))
 254   (setq sgml-saved-validate-command command)
 255   (compile-internal command "No more errors"))
 256
 257 ;;; sgml-mode.el ends here