lisp/textmodes/sgml-mode.el

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