Source

xemacsweb / batch-psgml-validate.el

adriana 836c779 
adriana 00f8a58 


adriana 836c779 

























adriana 00f8a58 

adriana 06a580b 
adriana 1cb84e2 
adriana 40e33b3 
adriana 00f8a58 

adrian a087bcf 
adriana 00f8a58 

adriana 40e33b3 
adrian a087bcf 
adriana 00f8a58 

adriana 1cb84e2 




adrian fabeca6 
adriana 1cb84e2 






adriana 40e33b3 


adriana 706fcd7 
adrian 39b6ea5 
adriana 706fcd7 






















adriana 00f8a58 












adriana 8dada07 





adriana 40e33b3 
adriana 8dada07 



apa-guest efc3356 



adriana 00f8a58 









adriana 40e33b3 














adriana 968aaf1 
adriana 00f8a58 



scop 0f1cd4e 
adriana 00f8a58 





adriana e1eaa9a 

adriana 00f8a58 


adriana b616645 


adriana 706fcd7 
adriana 00f8a58 

adriana 40e33b3 
adriana 968aaf1 










adriana 40e33b3 



adriana 968aaf1 


adriana 00f8a58 














adriana 40e33b3 

adriana 00f8a58 







adriana 968aaf1 















adriana b42b4bc 






adriana 968aaf1 
adriana 00f8a58 
adrian a087bcf 
adriana 968aaf1 






adriana 836c779 
;;; 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
  "    <p><small>Conform with "
  "Phrase to insert for conforming SGML document.")

(defconst psgml-validate-non-conform
  "    <p><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)))
            ;; drop indent which takes all the time
            (batch-psgml-validate-file file t))))
      ;; drop indent which takes all the time
      (batch-psgml-validate-file file-or-dir 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></p>\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