;;; rng-valid.el --- real-time validation of XML using RELAX NG
-;; Copyright (C) 2003, 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2003, 2007-2014 Free Software Foundation, Inc.
;; Author: James Clark
-;; Keywords: XML, RelaxNG
+;; Keywords: wp, hypermedia, languages, XML, RelaxNG
;; This file is part of GNU Emacs.
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
(> (prefix-numeric-value arg) 0)))
(save-restriction
(widen)
- (nxml-with-unmodifying-text-property-changes
+ (with-silent-modifications
(rng-clear-cached-state (point-min) (point-max)))
;; 1+ to clear empty overlays at (point-max)
(rng-clear-overlays (point-min) (1+ (point-max)))
(defun rng-after-change-function (start end pre-change-len)
(setq rng-message-overlay-inhibit-point nil)
- (nxml-with-unmodifying-text-property-changes
+ (with-silent-modifications
(rng-clear-cached-state start end))
;; rng-validate-up-to-date-end holds the position before the change
;; Adjust it to reflect the change.
(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
(defvar rng-validate-display-modified-p nil)
(defun rng-validate-while-idle-continue-p ()
- ;; input-pending-p and sit-for run timers that are
- ;; ripe. Binding timer-idle-list to nil prevents
- ;; this. If we don't do this, then any ripe timers
- ;; will get run, and we won't get any chance to
- ;; validate until Emacs becomes idle again or until
- ;; the other lower priority timers finish (which
- ;; can take a very long time in the case of
- ;; jit-lock).
- (let ((timer-idle-list nil))
- (and (not (input-pending-p))
- ;; Fake rng-validate-up-to-date-end so that the mode line
- ;; shows progress. Also use this to save point.
- (let ((rng-validate-up-to-date-end (point)))
- (goto-char rng-validate-display-point)
- (when (not rng-validate-display-modified-p)
- (restore-buffer-modified-p nil))
- (force-mode-line-update)
- (let ((continue (sit-for 0)))
- (goto-char rng-validate-up-to-date-end)
- continue)))))
+ (and (not (input-pending-p))
+ ;; Fake rng-validate-up-to-date-end so that the mode line
+ ;; shows progress. Also use this to save point.
+ (let ((rng-validate-up-to-date-end (point)))
+ (goto-char rng-validate-display-point)
+ (when (not rng-validate-display-modified-p)
+ (restore-buffer-modified-p nil))
+ (force-mode-line-update)
+ (let ((continue (sit-for 0)))
+ (goto-char rng-validate-up-to-date-end)
+ continue))))
;; Calling rng-do-some-validation once with a continue-p function, as
;; opposed to calling it repeatedly, helps on initial validation of a
;; validation process down.
(defun rng-validate-while-idle (buffer)
- (with-current-buffer buffer
- (if rng-validate-mode
- (if (let ((rng-validate-display-point (point))
- (rng-validate-display-modified-p (buffer-modified-p)))
- (rng-do-some-validation 'rng-validate-while-idle-continue-p))
- (force-mode-line-update)
- (rng-validate-done))
- ;; must have done kill-all-local-variables
- (rng-kill-timers))))
+ (when (buffer-live-p buffer) ; bug#13999
+ (with-current-buffer buffer
+ (if rng-validate-mode
+ (if (let ((rng-validate-display-point (point))
+ (rng-validate-display-modified-p (buffer-modified-p)))
+ (rng-do-some-validation 'rng-validate-while-idle-continue-p))
+ (force-mode-line-update)
+ (rng-validate-done))
+ ;; must have done kill-all-local-variables
+ (rng-kill-timers)))))
(defun rng-validate-quick-while-idle (buffer)
- (with-current-buffer buffer
- (if rng-validate-mode
- (if (rng-do-some-validation)
- (force-mode-line-update)
- (rng-validate-done))
- ;; must have done kill-all-local-variables
- (rng-kill-timers))))
+ (when (buffer-live-p buffer) ; bug#13999
+ (with-current-buffer buffer
+ (if rng-validate-mode
+ (if (rng-do-some-validation)
+ (force-mode-line-update)
+ (rng-validate-done))
+ ;; must have done kill-all-local-variables
+ (rng-kill-timers)))))
(defun rng-validate-done ()
(when (or (not (current-message))
(save-restriction
(widen)
(nxml-with-invisible-motion
- (condition-case-no-debug err
+ (condition-case-unless-debug err
(and (rng-validate-prepare)
(let ((rng-dt-namespace-context-getter '(nxml-ns-get-context)))
- (nxml-with-unmodifying-text-property-changes
+ (with-silent-modifications
(rng-do-some-validation-1 continue-p-function))))
;; errors signaled from a function run by an idle timer
;; are ignored; if we don't catch them, validation
xmltok-replacement
xmltok-attributes
xmltok-namespace-attributes
- xmltok-dependent-regions
xmltok-errors)
(when (= (point) 1)
(let ((regions (xmltok-forward-prolog)))
(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)
(setq rng-validate-up-to-date-end
(marker-position rng-conditional-up-to-date-end))
(rng-clear-conditional-region)
(when (not have-remaining-chars)
(rng-process-end-document))
(rng-mark-xmltok-errors)
- (rng-mark-xmltok-dependent-regions)
(setq rng-validate-up-to-date-end pos)
(when rng-conditional-up-to-date-end
(cond ((<= rng-conditional-up-to-date-end pos)
;; if overlays left over from a previous use
;; of rng-validate-mode that ended with a change of mode
(when rng-error-count
- (setq rng-error-count (1- rng-error-count)))))
- ((and (eq category 'rng-dependent)
- (<= beg (overlay-start overlay)))
- (delete-overlay overlay))))
+ (setq rng-error-count (1- rng-error-count)))))))
(setq overlays (cdr overlays))))))
-;;; Dependent regions
-
-(defun rng-mark-xmltok-dependent-regions ()
- (while xmltok-dependent-regions
- (apply 'rng-mark-xmltok-dependent-region
- (car xmltok-dependent-regions))
- (setq xmltok-dependent-regions
- (cdr xmltok-dependent-regions))))
-
-(defun rng-mark-xmltok-dependent-region (fun start end &rest args)
- (let ((overlay (make-overlay start end nil t t)))
- (overlay-put overlay 'category 'rng-dependent)
- (overlay-put overlay 'rng-funargs (cons fun args))))
-
-(put 'rng-dependent 'evaporate t)
-(put 'rng-dependent 'modification-hooks '(rng-dependent-region-changed))
-(put 'rng-dependent 'insert-behind-hooks '(rng-dependent-region-changed))
-
-(defun rng-dependent-region-changed (overlay
- after-p
- change-start
- change-end
- &optional pre-change-length)
- (when (and after-p
- ;; Emacs sometimes appears to call deleted overlays
- (overlay-start overlay)
- (let ((funargs (overlay-get overlay 'rng-funargs)))
- (save-match-data
- (save-excursion
- (save-restriction
- (widen)
- (apply (car funargs)
- (append (list change-start
- change-end
- pre-change-length
- (overlay-start overlay)
- (overlay-end overlay))
- (cdr funargs))))))))
- (rng-after-change-function (overlay-start overlay)
- change-end
- (+ pre-change-length
- (- (overlay-start overlay)
- change-start)))
- (delete-overlay overlay)))
-
;;; Error state
(defun rng-mark-xmltok-errors ()
(< rng-validate-up-to-date-end (point-max)))
;; Display percentage validated.
(force-mode-line-update)
- ;; Force redisplay but don't allow idle timers to run.
- (let ((timer-idle-list nil))
- (sit-for 0))
+ (sit-for 0)
(setq pos
(max pos (1- rng-validate-up-to-date-end)))
t)))))
(while (and (rng-do-some-validation)
(< rng-validate-up-to-date-end (min pos (point-max))))
(force-mode-line-update)
- ;; Force redisplay but don't allow idle timers to run.
- (let ((timer-idle-list nil))
- (sit-for 0)))
+ (sit-for 0))
(while (and (> arg 0)
(setq err (rng-find-previous-error-overlay pos)))
(setq pos (overlay-start err))
HCoop / bpt / emacs.git / blobdiff