1
0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2025-01-05 11:45:45 +00:00

* lisp/nxml/rng-valid.el: Use define-minor-mode

Remove redundant `:group`s.
(rng-validate-mode): Use define-minor-mode.
(rng-validate-clear): Let-bind rng-current-schema instead of passing
a `no-change-schema` argument.
This commit is contained in:
Stefan Monnier 2019-09-29 18:15:56 -04:00
parent a4688030b4
commit 524af9b833

View File

@ -106,34 +106,29 @@
:group 'languages)
(defface rng-error '((t (:inherit font-lock-warning-face)))
"Face for highlighting XML errors."
:group 'relax-ng)
"Face for highlighting XML errors.")
(defcustom rng-state-cache-distance 2000
"Distance in characters between each parsing and validation state cache."
:type 'integer
:group 'relax-ng)
:type 'integer)
(defcustom rng-validate-chunk-size 8000
"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."
:type 'integer
:group 'relax-ng)
:type 'integer)
(defcustom rng-validate-delay 1.5
"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)
:type 'number)
(defcustom rng-validate-quick-delay 0.3
"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)
:type 'number)
;; Global variables
@ -208,14 +203,11 @@ See the variable `rng-conditional-up-to-date-start'.")
"Non-nil means we are currently parsing just to compute the state.
Should be dynamically bound.")
(defvar rng-validate-mode nil)
(make-variable-buffer-local 'rng-validate-mode)
(defvar rng-dtd nil)
(make-variable-buffer-local 'rng-dtd)
;;;###autoload
(defun rng-validate-mode (&optional arg no-change-schema)
(define-minor-mode rng-validate-mode
"Minor mode performing continual validation against a RELAX NG schema.
Checks whether the buffer is a well-formed XML 1.0 document,
@ -237,11 +229,7 @@ be a RELAX NG schema using the compact schema \(such schemas
conventionally have a suffix of `.rnc'). The variable
`rng-schema-locating-files' specifies files containing rules
to use for finding the schema."
(interactive "P")
(setq rng-validate-mode
(if (null arg)
(not rng-validate-mode)
(> (prefix-numeric-value arg) 0)))
:global nil
(save-restriction
(widen)
(with-silent-modifications
@ -252,21 +240,20 @@ to use for finding the schema."
(rng-clear-conditional-region)
(setq rng-error-count 0)
;; do this here to avoid infinite loop if we set the schema
(remove-hook 'rng-schema-change-hook 'rng-validate-clear t)
(remove-hook 'rng-schema-change-hook #'rng-validate-clear t)
(cond (rng-validate-mode
(unwind-protect
(save-excursion
;; An error can change the current buffer
(when (or (not rng-current-schema)
(and (eq rng-current-schema rng-any-element)
(not no-change-schema)))
(eq rng-current-schema rng-any-element))
(rng-auto-set-schema t)))
(unless rng-current-schema (rng-set-schema-file-1 nil))
(add-hook 'rng-schema-change-hook 'rng-validate-clear nil t)
(add-hook 'after-change-functions 'rng-after-change-function nil t)
(add-hook 'kill-buffer-hook 'rng-kill-timers nil t)
(add-hook 'echo-area-clear-hook 'rng-echo-area-clear-function nil t)
(add-hook 'post-command-hook 'rng-maybe-echo-error-at-point nil t)
(add-hook 'rng-schema-change-hook #'rng-validate-clear nil t)
(add-hook 'after-change-functions #'rng-after-change-function nil t)
(add-hook 'kill-buffer-hook #'rng-kill-timers nil t)
(add-hook 'echo-area-clear-hook #'rng-echo-area-clear-function nil t)
(add-hook 'post-command-hook #'rng-maybe-echo-error-at-point nil t)
(rng-match-init-buffer)
(rng-activate-timers)
;; Start validating right away if the buffer is visible.
@ -278,11 +265,10 @@ to use for finding the schema."
(rng-validate-while-idle (current-buffer)))))
(t
(rng-cancel-timers)
(force-mode-line-update)
(remove-hook 'kill-buffer-hook 'rng-cancel-timers t)
(remove-hook 'post-command-hook 'rng-maybe-echo-error-at-point t)
(remove-hook 'echo-area-clear-hook 'rng-echo-area-clear-function t)
(remove-hook 'after-change-functions 'rng-after-change-function t))))
(remove-hook 'kill-buffer-hook #'rng-cancel-timers t)
(remove-hook 'post-command-hook #'rng-maybe-echo-error-at-point t)
(remove-hook 'echo-area-clear-hook #'rng-echo-area-clear-function t)
(remove-hook 'after-change-functions #'rng-after-change-function t))))
(defun rng-set-schema-file-and-validate (filename)
"Sets the schema and turns on `rng-validate-mode' if not already on.
@ -389,16 +375,20 @@ The schema is set like `rng-auto-set-schema'."
(setq rng-validate-timer
(run-with-idle-timer rng-validate-delay
t
'rng-validate-while-idle
#'rng-validate-while-idle
(current-buffer)))
(setq rng-validate-quick-timer
(run-with-idle-timer rng-validate-quick-delay
t
'rng-validate-quick-while-idle
#'rng-validate-quick-while-idle
(current-buffer))))))
(defun rng-validate-clear ()
(rng-validate-mode 1 t))
(if (eq rng-current-schema rng-any-element)
;; Prevent rng-validate-mode from trying to find another schema.
(let ((rng-current-schema (copy-sequence rng-current-schema)))
(rng-validate-mode))
(rng-validate-mode)))
;; These two variables are dynamically bound and used
;; to pass information between rng-validate-while-idle
@ -432,7 +422,7 @@ The schema is set like `rng-auto-set-schema'."
(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))
(rng-do-some-validation #'rng-validate-while-idle-continue-p))
(force-mode-line-update)
(rng-validate-done))
;; Must have done kill-all-local-variables.
@ -1109,7 +1099,7 @@ as empty-element."
(defun rng-mark-start-tag-close (&rest args)
(when (not (eq xmltok-type 'partial-start-tag))
(rng-mark-invalid (apply 'format args)
(rng-mark-invalid (apply #'format args)
(- (point)
(if (eq xmltok-type 'empty-element)
2
@ -1285,19 +1275,19 @@ as empty-element."
((memq nil contents) nil)
((not (cdr contents))
(rng-segment-string (car contents)))
(t (apply 'concat
(nreverse (mapcar 'rng-segment-string
(t (apply #'concat
(nreverse (mapcar #'rng-segment-string
contents)))))))
(defun rng-segment-string (segment)
(or (car segment)
(apply 'buffer-substring-no-properties
(apply #'buffer-substring-no-properties
(cdr segment))))
(defun rng-segment-blank-p (segment)
(if (car segment)
(rng-blank-p (car segment))
(apply 'rng-region-blank-p
(apply #'rng-region-blank-p
(cdr segment))))
(defun rng-contents-region ()