Index: nxml-util.el =================================================================== --- nxml-util.el (revision 44) +++ nxml-util.el (working copy) @@ -24,6 +24,35 @@ ;;; Code: +(defconst nxml-debug nil + "enable nxml debugging. effective only at compile time") + +(eval-when-compile + (require 'cl)) + +(defsubst nxml-debug (format &rest args) + (when nxml-debug + (apply #'message format args))) + +(defmacro nxml-debug-change (name start end) + (when nxml-debug + `(nxml-debug "%s: %S" ,name + (buffer-substring-no-properties ,start ,end)))) + +(defmacro nxml-debug-set-inside (start end) + (when nxml-debug + `(let ((overlay (make-overlay ,start ,end))) + (overlay-put overlay 'face '(:background "red")) + (overlay-put overlay 'nxml-inside-debug t) + (nxml-debug-change "nxml-set-inside" ,start ,end)))) + +(defmacro nxml-debug-clear-inside (start end) + (when nxml-debug + `(loop for overlay in (overlays-in ,start ,end) + if (overlay-get overlay 'nxml-inside-debug) + do (delete-overlay overlay) + finally (nxml-debug-change "nxml-clear-inside" ,start ,end)))) + (defun nxml-make-namespace (str) "Return a symbol for the namespace URI STR. STR must be a string. If STR is the empty string, return nil. @@ -37,12 +66,21 @@ This is the inverse of `nxml-make-namespace'." (and ns (substring (symbol-name ns) 1))) -(defconst nxml-xml-namespace-uri +(defconst nxml-xml-namespace-uri (nxml-make-namespace "http://www.w3.org/XML/1998/namespace")) (defconst nxml-xmlns-namespace-uri (nxml-make-namespace "http://www.w3.org/2000/xmlns/")) +(defmacro nxml-with-degradation-on-error (context &rest body) + (if (not nxml-debug) + (let ((error-symbol (gensym "err"))) + `(condition-case ,error-symbol + (progn ,@body) + (error + (nxml-degrade ,context ,error-symbol)))) + `(progn ,@body))) + (defmacro nxml-with-unmodifying-text-property-changes (&rest body) "Evaluate BODY without any text property changes modifying the buffer. Any text properties changes happen as usual but the changes are not treated as Index: nxml-rap.el =================================================================== --- nxml-rap.el (revision 44) +++ nxml-rap.el (working copy) @@ -110,9 +110,11 @@ (get-text-property pos 'nxml-inside)) (defsubst nxml-clear-inside (start end) + (nxml-debug-clear-inside start end) (remove-text-properties start end '(nxml-inside nil))) (defsubst nxml-set-inside (start end type) + (nxml-debug-set-inside start end) (put-text-property start end 'nxml-inside type)) (defun nxml-inside-end (pos) @@ -137,12 +139,10 @@ "Restore `nxml-scan-end' invariants after a change. The change happened between START and END. Return position after which lexical state is unchanged. -END must be > nxml-prolog-end." +END must be > nxml-prolog-end. START must be outside +any 'inside' regions and at the beginning of a token." (if (>= start nxml-scan-end) nxml-scan-end - (goto-char start) - (nxml-move-outside-backwards) - (setq start (point)) (let ((inside-remove-start start) xmltok-errors xmltok-dependent-regions) @@ -211,7 +211,7 @@ (setq adjusted-start ostart))))) (setq overlays (cdr overlays))) adjusted-start)) - + (defun nxml-mark-parse-dependent-regions () (while xmltok-dependent-regions (apply 'nxml-mark-parse-dependent-region @@ -297,6 +297,20 @@ (set-marker nxml-scan-end (point))) xmltok-type)) +(defun nxml-move-tag-backwards (bound) + "Move point backwards outside any 'inside' regions or tags, up +to nxml-prolog-end. Point will either be at bound or a '<' +character starting a tag outside any 'inside' regions. Ignores +dependent regions. As a precondition, point must be >= bound." + (nxml-move-outside-backwards) + (when (not (equal (char-after) ?<)) + (if (search-backward "<" bound t) + (progn + (nxml-move-outside-backwards) + (when (not (equal (char-after) ?<)) + (search-backward "<" bound t))) + (goto-char bound)))) + (defun nxml-move-outside-backwards () "Move point to first character of the containing special thing. Leave point unmoved if it is not inside anything special." Index: rng-auto.el =================================================================== --- rng-auto.el (revision 44) +++ rng-auto.el (working copy) @@ -106,12 +106,9 @@ (autoload (quote nxml-mode) "nxml-mode" "\ Major mode for editing XML. -Syntax highlighting is performed unless the variable -`nxml-syntax-highlight-flag' is nil. - \\[nxml-finish-element] finishes the current element by inserting an end-tag. C-c C-i closes a start-tag with `>' and then inserts a balancing end-tag -leaving point between the start-tag and end-tag. +leaving point between the start-tag and end-tag. \\[nxml-balanced-close-start-tag-block] is similar but for block rather than inline elements: the start-tag, point, and end-tag are all left on separate lines. If `nxml-slash-auto-complete-flag' is non-nil, then inserting a `' and then inserts a balancing end-tag leaving point between the start-tag and end-tag. @@ -570,13 +549,9 @@ (nxml-clear-dependent-regions (point-min) (point-max)) (setq nxml-scan-end (copy-marker (point-min) nil)) (nxml-with-unmodifying-text-property-changes - (when nxml-syntax-highlight-flag - (nxml-clear-fontified (point-min) (point-max))) - (nxml-clear-inside (point-min) (point-max)) + (nxml-clear-inside (point-min) (point-max)) (nxml-with-invisible-motion (nxml-scan-prolog))))) - (when nxml-syntax-highlight-flag - (add-hook 'fontification-functions 'nxml-fontify nil t)) (add-hook 'after-change-functions 'nxml-after-change nil t) (add-hook 'write-contents-hooks 'nxml-prepare-to-save) (when (not (and (buffer-file-name) (file-exists-p (buffer-file-name)))) @@ -585,6 +560,19 @@ (setq buffer-file-coding-system nxml-default-buffer-file-coding-system)) (when nxml-auto-insert-xml-declaration-flag (nxml-insert-xml-declaration))) + + (setq font-lock-defaults + '(nxml-font-lock-keywords + t ; keywords-only; we highlight comments and strings here + nil ; font-lock-keywords-case-fold-search. XML is case sensitive + nil ; no special syntax table + nil ; no automatic syntactic fontification + (font-lock-extend-after-change-region-function + . nxml-extend-after-change-region) + (font-lock-extend-region-functions . (nxml-extend-region)) + (jit-lock-contextually . t) + (font-lock-unfontify-region-function . nxml-unfontify-region))) + (run-hooks 'nxml-mode-hook)) (defun nxml-degrade (context err) @@ -598,85 +586,76 @@ (save-restriction (widen) (nxml-with-unmodifying-text-property-changes - (nxml-clear-face (point-min) (point-max)) - (nxml-set-fontified (point-min) (point-max)) - (nxml-clear-inside (point-min) (point-max))) + (nxml-clear-inside (point-min) (point-max))) (setq mode-name "nXML/degraded")))) ;;; Change management +(defun nxml-debug-region (start end) + (interactive "r") + (let ((font-lock-beg start) + (font-lock-end end)) + (nxml-extend-region) + (goto-char font-lock-beg) + (set-mark font-lock-end))) + (defun nxml-after-change (start end pre-change-length) - ;; Work around bug in insert-file-contents. - (when (> end (1+ (buffer-size))) - (setq start 1) - (setq end (1+ (buffer-size)))) - (unless nxml-degraded - (condition-case err - (save-excursion - (save-restriction - (widen) - (save-match-data - (nxml-with-invisible-motion - (nxml-with-unmodifying-text-property-changes - (nxml-after-change1 start end pre-change-length)))))) - (error - (nxml-degrade 'nxml-after-change err))))) + ; in font-lock mode, nxml-after-change1 is called via + ; nxml-extend-after-change-region instead so that the updated + ; book-keeping information is available for fontification. + (unless (or font-lock-mode nxml-degraded) + (nxml-with-degradation-on-error 'nxml-after-change + (save-excursion + (save-restriction + (widen) + (save-match-data + (nxml-with-invisible-motion + (nxml-with-unmodifying-text-property-changes + (nxml-after-change1 + start end pre-change-length))))))))) + (defun nxml-after-change1 (start end pre-change-length) - (setq nxml-last-fontify-end nil) + "after-change book-keeping. returns a cons containing a +possibly-enlarged change region. you must still call +nxml-extend-region on this expanded region to obtain the full +extent of the area needing refontification. + +For book-keeping, call this function even when fontification is +disabled." (let ((pre-change-end (+ start pre-change-length))) (setq start (nxml-adjust-start-for-dependent-regions start - end - pre-change-length)) + end + pre-change-length)) + + ;; If the prolog might have changed, rescan the prolog (when (<= start - ;; Add 2 so as to include the < and following char - ;; that start the instance, since changing these - ;; can change where the prolog ends. + ;; Add 2 so as to include the < and following char that + ;; start the instance (document element), since changing + ;; these can change where the prolog ends. (+ nxml-prolog-end 2)) - ;; end must be extended to at least the end of the old prolog + ;; end must be extended to at least the end of the old prolog in + ;; case the new prolog is shorter (when (< pre-change-end nxml-prolog-end) (setq end ;; don't let end get out of range even if pre-change-length ;; is bogus (min (point-max) (+ end (- nxml-prolog-end pre-change-end))))) + (nxml-scan-prolog))) - (cond ((<= end nxml-prolog-end) - (setq end nxml-prolog-end) - (goto-char start) - ;; This is so that Emacs redisplay works - (setq start (line-beginning-position))) - ((and (<= start nxml-scan-end) - (> start (point-min)) - (nxml-get-inside (1- start))) - ;; The closing delimiter might have been removed. - ;; So we may need to redisplay from the beginning - ;; of the token. - (goto-char (1- start)) - (nxml-move-outside-backwards) - ;; This is so that Emacs redisplay works - (setq start (line-beginning-position)) - (setq end (max (nxml-scan-after-change (point) end) - end))) - (t - (goto-char start) - ;; This is both for redisplay and to move back - ;; past any incomplete opening delimiters - (setq start (line-beginning-position)) - (setq end (max (nxml-scan-after-change start end) - end)))) - (when nxml-syntax-highlight-flag - (when (>= start end) - ;; Must clear at least one char so as to trigger redisplay. - (cond ((< start (point-max)) - (setq end (1+ start))) - (t - (setq end (point-max)) - (goto-char end) - (setq start (line-beginning-position))))) - (nxml-clear-fontified start end))) + (when (> end nxml-prolog-end) + (goto-char start) + (nxml-move-tag-backwards (point-min)) + (setq start (point)) + (setq end (max (nxml-scan-after-change start end) + end))) + + (nxml-debug-change "nxml-after-change1" start end) + (cons start end)) + ;;; Encodings (defun nxml-insert-xml-declaration () @@ -862,59 +841,102 @@ ;;; Fontification -(defun nxml-fontify (start) - (condition-case err - (save-excursion - (save-restriction - (widen) - (save-match-data - (nxml-with-invisible-motion - (nxml-with-unmodifying-text-property-changes - (if (or nxml-degraded - ;; just in case we get called in the wrong buffer - (not nxml-prolog-end)) - (nxml-set-fontified start (point-max)) - (nxml-fontify1 start))))))) - (error - (nxml-degrade 'nxml-fontify err)))) +(defun nxml-unfontify-region (start end) + (font-lock-default-unfontify-region start end) + (nxml-clear-char-ref-extra-display start end)) -(defun nxml-fontify1 (start) - (cond ((< start nxml-prolog-end) - (nxml-fontify-prolog) - (nxml-set-fontified (point-min) - nxml-prolog-end)) - (t - (goto-char start) - (when (not (eq nxml-last-fontify-end start)) - (when (not (equal (char-after) ?\<)) - (search-backward "<" nxml-prolog-end t)) - (nxml-ensure-scan-up-to-date) - (nxml-move-outside-backwards)) - (let ((start (point))) - (nxml-do-fontify (min (point-max) - (+ start nxml-fontify-chunk-size))) - (setq nxml-last-fontify-end (point)) - (nxml-set-fontified start nxml-last-fontify-end))))) +(defun nxml-extend-region () + "Extend the region to hold the minimum area we can fontify with +nXML. Called with font-lock-beg and font-lock-end dynamically bound." + (let ((start font-lock-beg) + (end font-lock-end)) -(defun nxml-fontify-buffer () - (interactive) - (save-excursion - (save-restriction - (widen) - (nxml-with-invisible-motion - (goto-char (point-min)) - (nxml-with-unmodifying-text-property-changes - (nxml-fontify-prolog) - (goto-char nxml-prolog-end) - (nxml-do-fontify)))))) + (nxml-debug-change "nxml-extend-region(input)" start end) + (when (< start nxml-prolog-end) + (setq start (point-min))) + + (cond ((<= end nxml-prolog-end) + (setq end nxml-prolog-end)) + + (t + (goto-char start) + ;; some font-lock backends (like Emacs 22 jit-lock) snap + ;; the region to the beginning of the line no matter what + ;; we say here. To mitigate the resulting excess + ;; fontification, ignore leading whitespace. + (skip-syntax-forward " ") + + ;; find the beginning of the previous tag + (when (not (equal (char-after) ?\<)) + (search-backward "<" nxml-prolog-end t)) + (nxml-ensure-scan-up-to-date) + (nxml-move-outside-backwards) + (setq start (point)) + + (while (< (point) end) + (nxml-tokenize-forward)) + + (setq end (point)))) + + (when (or (< start font-lock-beg) + (> end font-lock-end)) + (setq font-lock-beg start + font-lock-end end) + (nxml-debug-change "nxml-extend-region" start end) + t))) + +(defun nxml-extend-after-change-region (start end pre-change-length) + (unless nxml-degraded + (setq nxml-last-fontify-end nil) + + (nxml-with-degradation-on-error 'nxml-extend-after-change-region + (save-excursion + (save-restriction + (widen) + (save-match-data + (nxml-with-invisible-motion + (nxml-with-unmodifying-text-property-changes + (nxml-extend-after-change-region1 + start end pre-change-length))))))))) + +(defun nxml-extend-after-change-region1 (start end pre-change-length) + (let* ((region (nxml-after-change1 start end pre-change-length)) + (font-lock-beg (car region)) + (font-lock-end (cdr region))) + + (nxml-extend-region) + (cons font-lock-beg font-lock-end))) + +(defun nxml-fontify-matcher (bound) + "Called as font-lock keyword matcher." + + (unless nxml-degraded + (nxml-debug-change "nxml-fontify-matcher" (point) bound) + + (when (< (point) nxml-prolog-end) + (goto-char (point-min)) + (nxml-fontify-prolog) + (goto-char nxml-prolog-end)) + + (let (xmltok-dependent-regions + xmltok-errors) + (while (and (< (point) bound) + (nxml-tokenize-forward)) + (nxml-apply-fontify-rule))) + + (setq nxml-last-fontify-end (point))) + + ;; Since we did the fontification internally, tell font-lock to not + ;; do anything itself. + nil) + (defun nxml-fontify-prolog () "Fontify the prolog. The buffer is assumed to be prepared for fontification. This does not set the fontified property, but it does clear faces appropriately." (let ((regions nxml-prolog-regions)) - (nxml-clear-face (point-min) nxml-prolog-end) (while regions (let ((region (car regions))) (nxml-apply-fontify-rule (aref region 0) @@ -922,17 +944,6 @@ (aref region 2))) (setq regions (cdr regions))))) -(defun nxml-do-fontify (&optional bound) - "Fontify at least as far as bound. -Leave point after last fontified position." - (unless bound (setq bound (point-max))) - (let (xmltok-dependent-regions - xmltok-errors) - (while (and (< (point) bound) - (nxml-tokenize-forward)) - (nxml-clear-face xmltok-start (point)) - (nxml-apply-fontify-rule)))) - ;; Vectors identify a substring of the token to be highlighted in some face. ;; Token types returned by xmltok-forward. @@ -2582,13 +2593,7 @@ (> (prefix-numeric-value arg) 0)))) (when (not (eq new nxml-char-ref-extra-display)) (setq nxml-char-ref-extra-display new) - (save-excursion - (save-restriction - (widen) - (if nxml-char-ref-extra-display - (nxml-with-unmodifying-text-property-changes - (nxml-clear-fontified (point-min) (point-max))) - (nxml-clear-char-ref-extra-display (point-min) (point-max)))))))) + (font-lock-fontify-buffer)))) (put 'nxml-char-ref 'evaporate t)