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