lisp/textmodes/sgml-mode.el

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