;;; rng-valid.el --- real-time validation of XML using RELAX NG
-;; Copyright (C) 2003, 2007 Free Software Foundation, Inc.
+;; Copyright (C) 2003, 2007-2012 Free Software Foundation, Inc.
;; Author: James Clark
;; Keywords: XML, RelaxNG
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs 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 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
:group 'relax-ng)
(defcustom rng-state-cache-distance 2000
- "*Distance in characters between each parsing and validation state cache."
+ "Distance in characters between each parsing and validation state cache."
:type 'integer
:group 'relax-ng)
(defcustom rng-validate-chunk-size 8000
- "*Number of characters in a RELAX NG validation chunk.
+ "Number of characters in a RELAX NG validation chunk.
A validation chunk will be the smallest chunk that is at least this
size and ends with a tag. After validating a chunk, validation will
continue only if Emacs is still idle."
:group 'relax-ng)
(defcustom rng-validate-delay 1.5
- "*Time in seconds that Emacs must be idle before starting a full validation.
+ "Time in seconds that Emacs must be idle before starting a full validation.
A full validation continues until either validation is up to date
or Emacs is no longer idle."
:type 'number
:group 'relax-ng)
(defcustom rng-validate-quick-delay 0.3
- "*Time in seconds that Emacs must be idle before starting a quick validation.
+ "Time in seconds that Emacs must be idle before starting a quick validation.
A quick validation validates at most one chunk."
:type 'number
:group 'relax-ng)
(put 'rng-validate-quick-timer 'permanent-local t)
(defvar rng-error-count nil
- "Number of errors in the current buffer. Always equal to number of
-overlays with category rng-error.")
+ "Number of errors in the current buffer.
+Always equal to number of overlays with category `rng-error'.")
(make-variable-buffer-local 'rng-error-count)
(defvar rng-message-overlay nil
- "Overlay in this buffer whose help-echo property was last printed.
-Nil if none.")
+ "Overlay in this buffer whose `help-echo' property was last printed.
+It is nil if none.")
(make-variable-buffer-local 'rng-message-overlay)
(defvar rng-message-overlay-inhibit-point nil
(defvar rng-conditional-up-to-date-start nil
"Marker for the start of the conditionally up-to-date region.
-Nil if there is no conditionally up-to-date region. The conditionally
-up-to-date region must be such that for any cached state S with
-position P in the conditionally up-to-date region, if at some point it
-is determined that S becomes correct for P, then all states with
-position >= P in the conditionally up to date region must also then be
-correct and all errors between P and the end of the region must then
-be correctly marked.")
+It is nil if there is no conditionally up-to-date region. The
+conditionally up-to-date region must be such that for any cached
+state S with position P in the conditionally up-to-date region,
+if at some point it is determined that S becomes correct for P,
+then all states with position >= P in the conditionally up to
+date region must also then be correct and all errors between P
+and the end of the region must then be correctly marked.")
(make-variable-buffer-local 'rng-conditional-up-to-date-start)
(defvar rng-conditional-up-to-date-end nil
"Marker for the end of the conditionally up-to-date region.
-Nil if there is no conditionally up-to-date region. See the variable
-`rng-conditional-up-to-date-start'.")
+It is nil if there is no conditionally up-to-date region.
+See the variable `rng-conditional-up-to-date-start'.")
(make-variable-buffer-local 'rng-conditional-up-to-date-end)
(defvar rng-parsing-for-state nil
Checks whether the buffer is a well-formed XML 1.0 document,
conforming to the XML Namespaces Recommendation and valid against a
-RELAX NG schema. The mode-line indicates whether it is or not. Any
+RELAX NG schema. The mode-line indicates whether it is or not. Any
parts of the buffer that cause it not to be are considered errors and
-are highlighted with face `rng-error'. A description of each error is
+are highlighted with face `rng-error'. A description of each error is
available as a tooltip. \\[rng-next-error] goes to the next error
-after point. Clicking mouse-1 on the word `Invalid' in the mode-line
-goes to the first error in the buffer. If the buffer changes, then it
+after point. Clicking mouse-1 on the word `Invalid' in the mode-line
+goes to the first error in the buffer. If the buffer changes, then it
will be automatically rechecked when Emacs becomes idle; the
-rechecking will be paused whenever there is input pending..
+rechecking will be paused whenever there is input pending.
By default, uses a vacuous schema that allows any well-formed XML
-document. A schema can be specified explictly using
+document. A schema can be specified explicitly using
\\[rng-set-schema-file-and-validate], or implicitly based on the buffer's
file name or on the root element name. In each case the schema must
be a RELAX NG schema using the compact schema \(such schemas
(nxml-with-unmodifying-text-property-changes
(rng-clear-cached-state (point-min) (point-max)))
;; 1+ to clear empty overlays at (point-max)
- (rng-clear-overlays (point-min) (1+ (point-max))))
- (setq rng-validate-up-to-date-end 1)
+ (rng-clear-overlays (point-min) (1+ (point-max)))
+ (setq rng-validate-up-to-date-end (point-min)))
(rng-clear-conditional-region)
(setq rng-error-count 0)
;; do this here to avoid infinite loop if we set the schema
(interactive (list (rng-read-type-id)))
(and (rng-set-document-type type-id)
(or rng-validate-mode (rng-validate-mode))))
-
+
(defun rng-auto-set-schema-and-validate ()
"Set the schema for this buffer automatically and turn on `rng-validate-mode'.
The schema is set like `rng-auto-set-schema'."
(or rng-validate-mode (rng-validate-mode)))
(defun rng-after-change-function (start end pre-change-len)
- ;; Work around bug in insert-file-contents.
- (when (> end (1+ (buffer-size)))
- (setq start 1)
- (setq end (1+ (buffer-size))))
(setq rng-message-overlay-inhibit-point nil)
(nxml-with-unmodifying-text-property-changes
(rng-clear-cached-state start end))
(setq rng-validate-up-to-date-end start))
;; Must make rng-validate-up-to-date-end < point-max
;; (unless the buffer is empty).
- ;; otherwise validate-prepare will say there's nothing to do.
- ;; Don't use (point-max) because we may be narrowed.
- (if (> rng-validate-up-to-date-end (buffer-size))
- (setq rng-validate-up-to-date-end
- (max 1 (1- rng-validate-up-to-date-end))))
+ ;; otherwise rng-validate-prepare will say there's nothing to do.
+ (when (>= rng-validate-up-to-date-end (point-max))
+ (setq rng-validate-up-to-date-end
+ (if (< (point-min) (point-max))
+ (1- (point-max))
+ ;; Only widen if really necessary.
+ (save-restriction (widen) (max (point-min) (1- (point-max)))))))
;; Arrange to revalidate
(rng-activate-timers)
;; Need to do this after activating the timer
;; the end.
(floor (if (eq (buffer-size) 0)
0.0
- (/ (* (- rng-validate-up-to-date-end 1) 100.0)
- (buffer-size)))))
+ (/ (* (- rng-validate-up-to-date-end (point-min))
+ 100.0)
+ (- (point-max) (point-min))))))
"%%"))
((> rng-error-count 0)
(concat " "
'mouse-1
'rng-mouse-first-error))))
(t " Valid")))
-
+
(defun rng-cancel-timers ()
(let ((inhibit-quit t))
(when rng-validate-timer
(defun rng-kill-timers ()
;; rng-validate-timer and rng-validate-quick-timer have the
;; permanent-local property, so that the timers can be
- ;; cancelled even after changing mode.
- ;; This function takes care of cancelling the timers and
+ ;; canceled even after changing mode.
+ ;; This function takes care of canceling the timers and
;; then killing the local variables.
(when (local-variable-p 'rng-validate-timer)
(when rng-validate-timer
(when rng-validate-quick-timer
(cancel-timer rng-validate-quick-timer))
(kill-local-variable 'rng-validate-quick-timer)))
-
+
(defun rng-activate-timers ()
(unless rng-validate-timer
(let ((inhibit-quit t))
(defun rng-validate-done ()
(when (or (not (current-message))
(rng-current-message-from-error-overlay-p))
- (rng-error-overlay-message (or (rng-error-overlay-after (point))
+ (rng-error-overlay-message (or (rng-error-overlay-after (point))
(rng-error-overlay-after (1- (point))))))
(rng-cancel-timers)
(force-mode-line-update))
(defun rng-do-some-validation (&optional continue-p-function)
- "Do some validation work. Return t if more to do, nil otherwise."
+ "Do some validation work. Return t if more to do, nil otherwise."
(save-excursion
(save-restriction
(widen)
(nxml-with-invisible-motion
- (condition-case err
+ (condition-case-no-debug err
(and (rng-validate-prepare)
(let ((rng-dt-namespace-context-getter '(nxml-ns-get-context)))
(nxml-with-unmodifying-text-property-changes
(rng-do-some-validation-1 continue-p-function))))
- ;; errors signalled from a function run by an idle timer
+ ;; errors signaled from a function run by an idle timer
;; are ignored; if we don't catch them, validation
;; will get mysteriously stuck at a single place
(rng-compile-error
(goto-char pos))
(t (rng-set-initial-state))))))))))
+(defun rng-dtd-trivial-p (dtd)
+ "Check whether the current dtd is different from the trivial default."
+ (or (null dtd) (eq dtd xmltok-predefined-entity-alist)))
(defun rng-do-some-validation-1 (&optional continue-p-function)
(let ((limit (+ rng-validate-up-to-date-end
(rng-clear-cached-state remove-start (1- pos)))
;; sync up with cached validation state
(setq continue nil)
- ;; do this before settting rng-validate-up-to-date-end
+ ;; do this before setting rng-validate-up-to-date-end
;; in case we get a quit
(rng-mark-xmltok-errors)
(rng-mark-xmltok-dependent-regions)
(set-marker rng-conditional-up-to-date-start
pos)))))))))
have-remaining-chars))
-
+
(defun rng-clear-conditional-region ()
(when rng-conditional-up-to-date-start
(set-marker rng-conditional-up-to-date-start nil)
(setq rng-message-overlay-current nil))
;;; Error navigation
-
+
(defun rng-maybe-echo-error-at-point ()
(when (or (not (current-message))
(rng-current-message-from-error-overlay-p))
Turn on `rng-validate-mode' if it is not already on."
(interactive)
(or rng-validate-mode (rng-validate-mode))
- (when (and (eq rng-validate-up-to-date-end 1)
- (< rng-validate-up-to-date-end (point-max)))
- (rng-do-some-validation))
+ (rng-do-some-validation)
(let ((err (rng-find-next-error-overlay (1- (point-min)))))
(if err
(rng-goto-error-overlay err)
(defun rng-next-error (arg)
"Go to the next validation error after point.
Turn on `rng-validate-mode' if it is not already on.
-A prefix ARG specifies how many errors to move. A negative ARG
-moves backwards. Just \\[universal-argument] as a prefix
+A prefix ARG specifies how many errors to move.
+A negative ARG moves backwards. Just \\[universal-argument] as a prefix
means goto the first error."
(interactive "P")
(if (consp arg)
(defun rng-previous-error (arg)
"Go to the previous validation error before point.
Turn on `rng-validate-mode' if it is not already on.
-A prefix ARG specifies how many errors to move. A negative ARG
-moves forwards. Just \\[universal-argument] as a prefix
+A prefix ARG specifies how many errors to move.
+A negative ARG moves forwards. Just \\[universal-argument] as a prefix
means goto the first error."
(interactive "P")
(if (consp arg)
(setq last-err err)
(setq pos (overlay-start err)))
(when (> arg 0)
- (setq pos (max pos (1- rng-validate-up-to-date-end)))
+ (setq pos (max pos (1- rng-validate-up-to-date-end)))
(when (< rng-validate-up-to-date-end (point-max))
(message "Parsing...")
(while (let ((more-to-do (rng-do-some-validation)))
(rng-goto-error-overlay last-err)
(message "No previous errors")
nil)))
-
+
(defun rng-goto-error-overlay (err)
"Goto the start of error overlay ERR and print its message."
(goto-char (overlay-start err))
(defun rng-process-start-tag (tag-type)
"TAG-TYPE is `start-tag' for a start-tag, `empty-element' for
-an empty element. partial-empty-element should be passed
+an empty element. `partial-empty-element' should be passed
as empty-element."
(and rng-collecting-text (rng-flush-text))
(setq rng-collecting-text nil)
(rng-name-to-string nm t)))
required-attributes
", "))))))
-
+
(defun rng-process-end-tag (&optional partial)
(cond ((not rng-open-elements)
(rng-mark-not-well-formed "Extra end-tag"
(defun rng-process-text (start end whitespace &optional value)
"Process characters between position START and END as text.
-END nil means point. WHITESPACE t means known to be whitespace, nil
+END nil means point. WHITESPACE t means known to be whitespace, nil
means known not to be, anything else means unknown whether whitespace
-or not. END must not be nil if WHITESPACE is neither t nor nil.
+or not. END must not be nil if WHITESPACE is neither t nor nil.
VALUE is a string or nil; nil means the value is equal to the
string between START and END."
(cond (rng-collecting-text
(provide 'rng-valid)
-;; arch-tag: 7dd846d3-519d-4a6d-8107-4ff0024a60ef
;;; rng-valid.el ends here
HCoop / bpt / emacs.git / blobdiff