home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / gnu / emacs-19.16 / lisp / sgml-mode.el < prev    next >
Encoding:
Text File  |  1993-05-31  |  8.4 KB  |  258 lines
  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. ;; 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
  258.