X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/84eb0351d8be4811897c8cf62a69757ff5d14001..7e09ef09a479731d01b1ca46e94ddadd73ac98e3:/lisp/nxml/rng-valid.el diff --git a/lisp/nxml/rng-valid.el b/lisp/nxml/rng-valid.el index 876e582ed2..2bf8f1dfa6 100644 --- a/lisp/nxml/rng-valid.el +++ b/lisp/nxml/rng-valid.el @@ -1,9 +1,9 @@ ;;; rng-valid.el --- real-time validation of XML using RELAX NG -;; Copyright (C) 2003, 2007-2011 Free Software Foundation, Inc. +;; Copyright (C) 2003, 2007-2015 Free Software Foundation, Inc. ;; Author: James Clark -;; Keywords: XML, RelaxNG +;; Keywords: wp, hypermedia, languages, XML, RelaxNG ;; This file is part of GNU Emacs. @@ -230,7 +230,7 @@ will be automatically rechecked when Emacs becomes idle; the 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 @@ -244,7 +244,7 @@ to use for finding the schema." (> (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))) @@ -305,7 +305,7 @@ The schema is set like `rng-auto-set-schema'." (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. @@ -377,8 +377,8 @@ The schema is set like `rng-auto-set-schema'." (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 @@ -414,26 +414,17 @@ The schema is set like `rng-auto-set-schema'." (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 @@ -442,24 +433,26 @@ The schema is set like `rng-auto-set-schema'." ;; 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)) @@ -475,10 +468,10 @@ The schema is set like `rng-auto-set-schema'." (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 @@ -537,7 +530,6 @@ Return t if there is work to do, nil otherwise." xmltok-replacement xmltok-attributes xmltok-namespace-attributes - xmltok-dependent-regions xmltok-errors) (when (= (point) 1) (let ((regions (xmltok-forward-prolog))) @@ -570,10 +562,9 @@ Return t if there is work to do, nil otherwise." (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) @@ -598,7 +589,6 @@ Return t if there is work to do, nil otherwise." (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) @@ -668,57 +658,9 @@ Return t if there is work to do, nil otherwise." ;; 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 () @@ -880,9 +822,7 @@ means goto the first error." (< 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))))) @@ -905,9 +845,7 @@ means goto the first error." (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))