xemacsweb / batch-psgml-validate.el

;;; batch-psgml-validate.el --- Batch-validation of HTML with PSGML for XEmacs
;;;
;;; $Id$
;;;
;;; Copyright (C) 2000 Adrian Aichner

;; Author: Adrian Aichner <adrian@xemacs.org>
;; Maintainer: XEmacs Development Team <xemacs-beta@xemacs.org>
;; Date: $Date$
;; Version: $Revision$
;; Keywords: xemacsweb

;; This file is part of XEmacs.

;; XEmacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; XEmacs is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;; General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with XEmacs; see the file COPYING.  If not, write to the Free
;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
;; 02111-1307, USA.

;;; Synched up with: Not in FSF.

(require 'psgml)
(require 'psgml-parse)                  ;;; for (defstruct (sgml-dtd ...))
;;; APA: 'psgml-html does not provide itself.  Why not?
(load "psgml-html")                   ;;; for html-quote-region

(defconst psgml-validate-conform
  "    <small>Conform with "
  "Phrase to insert for conforming SGML document.")

(defconst psgml-validate-non-conform
  "    <small><strong>Not</strong> conform with "
  "Phrase to insert for non-conforming SGML document.")

(defgroup batch-psgml-validate nil
  "SGML document validation using PSGML."
  :group 'emacs)

(defcustom psgml-validate-ignore-directories
  (quote ("CVS" "genpage" "html" "RCS" "SCCS" "linklint"))
  "*List of directory names to be ignored by `batch-psgml-validate'."
  :type '(repeat
          :custom-show t
          :documentation-shown t
          string)
  :group 'batch-psgml-validate)

(defvar batch-psgml-last-warning nil
  "Save last warning.")

(defun psgml-find-file-hook ()
  (condition-case nil
      (save-excursion
        (let (mdo)
          (goto-char (point-min))
          (setq mdo
                (sgml-with-parser-syntax
                 (let (start)
                   (sgml-skip-upto "MDO")
                   (setq start (point))
                   (sgml-skip-upto-mdc)
                   (forward-char 1)
                   (buffer-substring start (point)))))
          (string-match "\\bDTD\\s-+\\(\\w+\\)\\b" mdo)
          (cond
           ((string= (match-string 1 mdo) "XHTML")
            (xml-mode))
           ((string= (match-string 1 mdo) "XML")
            (xml-mode))
           ((string= (match-string 1 mdo) "HTML")
            (html-mode))
           (t
            nil))))
    (t nil)))

(defun batch-psgml-validate (&optional file-or-dir)
  "Uses `sgml-next-trouble-spot' from the PSGML package to validate
conformance of files in FILE-OR-DIR with the specified DTD.  See
`batch-psgml-validate-buffer'.  If FILE-OR-DIR is missing,
`batch-psgml-validate' is performed for each `command-line-args-left'."
  (interactive "DHTML directory to validate: ")
  (if (null file-or-dir)
      (progn
        (let (file-or-dir)
          (while command-line-args-left
            (setq file-or-dir (expand-file-name (car command-line-args-left)))
            (batch-psgml-validate file-or-dir)
            (setq command-line-args-left (cdr command-line-args-left)))))
    (if (file-directory-p file-or-dir)
        (dolist (file (directory-files file-or-dir t nil nil nil))
          (cond
           ((member (file-name-nondirectory file) (list "." ".."))
            nil)
           ((file-directory-p file)
            (batch-psgml-validate file))
           ((and
             (member (file-name-extension file) (list "htm" "html"))
             (null
              (backup-file-name-p file)))
            (batch-psgml-validate-file file t t))))
      (batch-psgml-validate-file file-or-dir t t))))

(defun batch-psgml-validate-file (file &optional insert-result indent)
  "Uses `sgml-next-trouble-spot' from the PSGML package to validate
conformance of FILE with the specified DTD.  See
`batch-psgml-validate-buffer'."
  (interactive
   (list
    (read-file-name "HTML file to validate: ")
    (yes-or-no-p "insert compliance text ")
    (yes-or-no-p "indent buffer ")))
  (when
      (catch 'file-should-be-validated
        (mapc
         (function
          (lambda (c)
            (when (member c psgml-validate-ignore-directories)
              (message "ignoring directory named %s" c)
              ;; APA: throw a nil value, causing catch to return nil
              (throw 'file-should-be-validated nil))))
         (split-string-by-char
          file
          directory-sep-char)))
    (with-current-buffer
        (find-file-noselect file)
      (batch-psgml-validate-buffer insert-result indent))
    (message "batch-psgml-validate of %s is done" file)))

(defun batch-psgml-validate-buffer (&optional insert-result indent)
  "Uses `sgml-next-trouble-spot' from the PSGML package to validate
conformance of buffer with the specified DTD.  INSERT-RESULT inserts a
\(non-\)compliance messsage before \"</body>\".  INDENT will
`indent-according-to-mode' as well.  The buffer is saved in the end if
not called interactively."
  (interactive
   (list
    (yes-or-no-p "insert compliance text ")
    (yes-or-no-p "indent buffer ")))
  (set (make-local-variable 'backup-inhibited)
       t)
  (let (old-result-begin
        old-result-end
        new-result-begin
        result
        file
        line)
    (psgml-find-file-hook)
    (goto-char (point-min))
    (condition-case err
        (progn
          (flet ((append-message
                  (&rest args) ())
                 (clear-message
                  (&optional label frame stdout-p no-restore)
                  ())
                 (sgml-log-warning
                  (format &rest things)
                  (setq batch-psgml-last-warning (apply 'format format things))
                  (when sgml-throw-on-warning
                    (throw sgml-throw-on-warning t))))
            (setq result (sgml-next-trouble-spot)))
          (unless (string= result "Ok")
            (setf file (buffer-file-name))
            (setq line (count-lines (point-min) (point)))
            (if batch-psgml-last-warning
                (display-message 'error
                  (format "%s:%d:%s" 
                          file line batch-psgml-last-warning)))))
      (error (message ">> Error: %s" (prin1-to-string err)))
      (t (message "trouble: %s" (prin1-to-string err))))
    (when insert-result
      (goto-char (point-max))
      (setq old-result-end
            (re-search-backward "^\\s-*</body>" (point-min) t))
      (while
          (re-search-backward
           (format "^\\s-*\\(%s\\|%s\\)"
                   psgml-validate-conform
                   psgml-validate-non-conform)
           (point-min) t)
        (setq old-result-begin (point)))
      (and
       old-result-begin
       old-result-end
       (delete-region
        old-result-begin
        old-result-end))
      (insert
       (format "%s"
               (if (string= result "Ok")
                   psgml-validate-conform
                 psgml-validate-non-conform)))
      (setq new-result-begin (point))
      (flet ((append-message (&rest args) ())
             (clear-message (&optional label frame stdout-p no-restore) ()))
        (insert
         (format
          "%s\n"
          ;; As suggested in
          ;; http://www.xemacs.org/list-archives/xemacs-beta/200008/msg00251.html
          (save-excursion
            (goto-char (point-min))
            (sgml-with-parser-syntax
             (let (start)
               (sgml-skip-upto "MDO")
               (setq start (point))
               (sgml-skip-upto-mdc)
               (forward-char 1)
               (buffer-substring start (point)))))))
        (save-restriction
          (narrow-to-region new-result-begin (point))
          (goto-char (point-min))
          (while (re-search-forward "\\s-+" (point-max) t)
            (replace-match " " nil nil))
          (goto-char (point-max))
          (widen))
        (html-quote-region new-result-begin (point)))
      (insert
       "\n      <br />Automatically validated by <a href=\"http://sourceforge.net/projects/psgml/\">PSGML</a></small>\n"))
    (flet ((append-message (&rest args) ())
           (clear-message (&optional label frame stdout-p no-restore) ()))
      (when indent
        (indent-region (point-min) (point-max) nil))
      (if (noninteractive)
          (if (buffer-modified-p)
              (save-buffer))))))

;;; batch-psgml-validate.el ends here
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.