Source

xemacsweb / batch-psgml-validate.el

Full commit
;;;
;;; $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)))))
    (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))))
    (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))))))