Source

xemacsweb / batch-psgml-validate.el

Full commit
adriana 00f8a58 


adriana 1cb84e2 
adriana 00f8a58 



adriana 1cb84e2 

adriana 00f8a58 








adriana 1cb84e2 












adriana 00f8a58 












adriana 8dada07 
















adriana 00f8a58 



























adriana b616645 


adriana 00f8a58 

adriana 1cb84e2 
adriana 00f8a58 

adriana 1cb84e2 


adriana 00f8a58 


























adriana b616645 
adriana 00f8a58 










;;;
;;; $Id$
;;;
;;; Adrian Aichner (APA), aichner@ecf.teradyne.com, Teradyne GmbH, 2000-07-16.
;;;

(require 'psgml)
(require 'psgml-parse)                  ;;; for sgml-element-context-string
;;; APA: 'psgml-html does not provide itself.  Why not?
;;; (require '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"))
  "*List of directory names to be ignored by `batch-psgml-validate'."
  :type '(repeat
          :custom-show t
          :documentation-shown t
          string)
  :group 'batch-psgml-validate)

(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)
            (if (member (file-name-nondirectory file)
                        psgml-validate-ignore-directories)
                (message "ignoring directory %s" file)
              (batch-psgml-validate file)))
           ((and
             (member (file-name-extension file) (list "htm" "html"))
             (null
              (backup-file-name-p file)))
            (message "validating %s" file)
            (batch-psgml-validate-file file t t))))
      (batch-psgml-validate-file file-or-dir t t))
    (message "batch-psgml-validate %s is done" file-or-dir)))

(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 ")))
  (with-current-buffer
      (find-file-noselect file)
    (batch-psgml-validate-buffer insert-result indent)))

(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 ")))
  (let (old-result-begin
        old-result-end
        new-result-begin
        result
        file
        line)
    (goto-char (point-min))
    (condition-case err
        (setq result (sgml-next-trouble-spot))
      (error (message ">> Error: %s" (prin1-to-string err)))
      (t (message "trouble: %s" (prin1-to-string err))))
    (unless (string= result "Ok")
      (setf file (buffer-file-name))
      (setq line (count-lines (point-min) (point))))
    (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))
      (unless (string= result "Ok")
        (if sgml-last-element
            (message "validation error in %s"
                     (sgml-element-context-string sgml-last-element)))
        (message "at %s line %d." file line))
      (insert html-helper-htmldtd-version)
      (html-quote-region new-result-begin (point))
      (insert
       ", PSGML "
       psgml-version ", "
       emacs-version ".</small>\n"))
    (when indent
      (indent-region (point-min) (point-max) nil))
    (if (noninteractive)
        (if (buffer-modified-p)
            (progn (message "Saving modified %s" (buffer-file-name))
                   (save-buffer))))))