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