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