[Emacs-diffs] Changes to emacs/lisp/nxml/nxml-mode.el,v

[Michael W. Olson]

CVSROOT:        /sources/emacs
Module name:    emacs
Changes by:     Michael W. Olson <mwolson>      08/06/06 16:14:49

Index: nxml-mode.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/nxml/nxml-mode.el,v
retrieving revision 1.12
retrieving revision 1.13
diff -u -b -r1.12 -r1.13
--- nxml-mode.el        6 May 2008 04:25:55 -0000       1.12
+++ nxml-mode.el        6 Jun 2008 16:14:48 -0000       1.13
@@ -24,11 +24,6 @@
 
 ;; See nxml-rap.el for description of parsing strategy.
 
-;; The font locking here is independent of font-lock.el.  We want to
-;; do more sophisticated handling of changes and we want to use the
-;; same xmltok rather than regexps for parsing so that we parse
-;; consistently and correctly.
-
 ;;; Code:
 
 (when (featurep 'mucs)
@@ -56,11 +51,6 @@
   :group 'nxml
   :group 'font-lock-faces)
 
-(defcustom nxml-syntax-highlight-flag t
-  "*Non-nil means nxml-mode should perform syntax highlighting."
-  :group 'nxml
-  :type 'boolean)
-
 (defcustom nxml-char-ref-display-glyph-flag t
   "*Non-nil means display glyph following character reference.
 The glyph is displayed in face `nxml-glyph'.  The hook
@@ -100,8 +90,6 @@
   :group 'nxml
   :type 'integer)
 
-(defvar nxml-fontify-chunk-size 500)
-
 (defcustom nxml-bind-meta-tab-to-complete-flag (not window-system)
   "*Non-nil means bind M-TAB in `nxml-mode-map' to `nxml-complete'.
 C-return will be bound to `nxml-complete' in any case.
@@ -432,19 +420,13 @@
     map)
   "Keymap for nxml-mode.")
 
+(defvar nxml-font-lock-keywords
+  '(nxml-fontify-matcher)
+  "Default font lock keywords for nxml-mode.")
+
 (defsubst nxml-set-face (start end face)
   (when (and face (< start end))
-    (put-text-property start end 'face face)))
-
-(defun nxml-clear-face (start end)
-  (remove-text-properties start end '(face nil))
-  (nxml-clear-char-ref-extra-display start end))
-
-(defsubst nxml-set-fontified (start end)
-  (put-text-property start end 'fontified t))
-
-(defsubst nxml-clear-fontified (start end)
-  (remove-text-properties start end '(fontified nil)))
+    (font-lock-append-text-property start end 'face face)))
 
 ;;;###autoload
 (defun nxml-mode ()
@@ -453,9 +435,6 @@
   ;; not mnemonic.
   "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. 
@@ -540,13 +519,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-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 'change-major-mode-hook 'nxml-cleanup nil t)
 
@@ -561,6 +536,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)))
+
   (rng-nxml-mode-init)
   (nxml-enable-unicode-char-name-sets)
   (run-hooks 'nxml-mode-hook))
@@ -591,83 +579,72 @@
     (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))))))
 
 ;;; 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
+  ; 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))))))
-      (error
-       (nxml-degrade 'nxml-after-change err)))))
+                  (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 bookkeeping.  Returns a cons cell containing a
+possibly-enlarged change region.  You must call
+nxml-extend-region on this expanded region to obtain the full
+extent of the area needing refontification.
+
+For bookkeeping, 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))
+    ;; 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
+      (nxml-scan-prolog)
+      (setq start (point-min))))
+
+  (when (> end nxml-prolog-end)
         (goto-char start)
-        ;; This is both for redisplay and to move back
-        ;; past any incomplete opening delimiters
-        (setq start (line-beginning-position))
+    (nxml-move-tag-backwards (point-min))
+    (setq start (point))
         (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)))
+                   end)))
+
+  (nxml-debug-change "nxml-after-change1" start end)
+  (cons start end))
   
 ;;; Encodings
 
@@ -854,51 +831,98 @@
 
 ;;; 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))
+
+(defvar font-lock-beg) (defvar font-lock-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))
+
+    (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))
 
-(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))
+           ;; 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))
-        (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)))))
+           (nxml-move-outside-backwards)
+           (setq start (point))
 
-(defun nxml-fontify-buffer ()
-  (interactive)
+           (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
-       (goto-char (point-min))
        (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)
+      ;; prolog needs to be fontified in one go, and
+      ;; nxml-extend-region makes sure we start at BOB.
+      (assert (bobp))
          (nxml-fontify-prolog)
-         (goto-char nxml-prolog-end)
-         (nxml-do-fontify))))))
+      (goto-char nxml-prolog-end))
+
+    (let (xmltok-dependent-regions
+          xmltok-errors)
+      (while (and (nxml-tokenize-forward)
+                  (<= (point) bound)) ; intervals are open-ended
+        (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.
@@ -906,7 +930,6 @@
 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)
@@ -914,17 +937,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.
@@ -2574,13 +2586,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)