nxml-mode parser and multi major modes

[Lennart Borgman (gmail)]

Since Daniel started to do some work on nxml-mode I decided to take a 
new look on the possibility to tame the nxml-mode parser to only look at 
those pieces of the buffer that it should care about.

To my surprise it was much easier now :-)

I have attached the relevant pieces from rng-valid.el. I think this is 
much easier to understand as one piece than as a diff.

I believe it might need to be mixed with Daniel's code, not sure. So I 
send this here just in case someone has a comment or can make it 
better/faster.
(defvar rng-get-major-mode-chunk-function nil
  "Function to use to get major mode chunk.
It should take one argument, the point where to get the major mode chunk.

This is to be set by multiple major mode frame works, like
mumamo.

See also `rng-valid-nxml-major-mode-chunk-function' and
`rng-end-major-mode-chunk-function'. Note that all three
variables must be set.")
(make-variable-buffer-local 'rng-get-major-mode-chunk-function)
(put 'rng-get-major-mode-chunk-function 'permanent-local t)

(defvar rng-valid-nxml-major-mode-chunk-function nil
  "Function to use to check if nxml can parse major mode chunk.
It should take one argument, the chunk.

For more info see also `rng-get-major-mode-chunk-function'.")
(make-variable-buffer-local 'rng-valid-nxml-major-mode-chunk-function)
(put 'rng-valid-nxml-major-mode-chunk-function 'permanent-local t)

(defvar rng-end-major-mode-chunk-function nil
  "Function to use to get the end of a major mode chunk.
It should take one argument, the chunk.

For more info see also `rng-get-major-mode-chunk-function'.")
(make-variable-buffer-local 'rng-end-major-mode-chunk-function)
(put 'rng-end-major-mode-chunk-function 'permanent-local t)

(defun rng-do-some-validation-1 (&optional continue-p-function)
  (let (major-mode-chunk
        end-major-mode-chunk
        (limit (+ rng-validate-up-to-date-end
                  rng-validate-chunk-size))
        (remove-start rng-validate-up-to-date-end)
        (next-cache-point (+ (point) rng-state-cache-distance))
        (continue t)
        (xmltok-dtd rng-dtd)
        have-remaining-chars
        xmltok-type
        xmltok-start
        xmltok-name-colon
        xmltok-name-end
        xmltok-replacement
        xmltok-attributes
        xmltok-namespace-attributes
        xmltok-dependent-regions
        xmltok-errors
        )
    ;;(message ">>>>>>>>> here -1, p=%s" (point)) ;;(sit-for 4)
    (when (and continue (= (point) 1))
      (let ((regions (xmltok-forward-prolog)))
        (rng-clear-overlays 1 (point))
        (while regions
          (when (eq (aref (car regions) 0) 'encoding-name)
            (rng-process-encoding-name (aref (car regions) 1)
                                       (aref (car regions) 2)))
          (setq regions (cdr regions))))
      (unless (equal rng-dtd xmltok-dtd)
        (rng-clear-conditional-region))
      (setq rng-dtd xmltok-dtd))
    (while continue
      ;; If mumamo (or something similar) is used then jump over parts
      ;; that can not be parsed by nxml-mode.
      (when (and rng-get-major-mode-chunk-function
                 rng-valid-nxml-major-mode-chunk-function
                 rng-end-major-mode-chunk-function)
        (let ((here (point))
              next-non-space-pos)
          (skip-chars-forward " \t\r\n")
          (setq next-non-space-pos (point))
          (goto-char here)
          ;;(message "here when, p=%s emmc=%s non-space=%s" (point) 
end-major-mode-chunk next-non-space-pos) ;;(sit-for 4)
          (unless (and end-major-mode-chunk
                       ;; Remaining chars in this chunk?
                       (< next-non-space-pos end-major-mode-chunk))
            (setq end-major-mode-chunk nil)
            (setq major-mode-chunk (funcall rng-get-major-mode-chunk-function 
next-non-space-pos))
            (while (and major-mode-chunk
                        (not (funcall rng-valid-nxml-major-mode-chunk-function 
major-mode-chunk))
                        (< next-non-space-pos (point-max)))
              (let ((end-pos (funcall rng-end-major-mode-chunk-function 
major-mode-chunk)))
                (goto-char (+ end-pos 0))
                (setq major-mode-chunk (funcall 
rng-get-major-mode-chunk-function (point)))
                ;;(message "---> here 3, point=%s, ep=%s, mm-chunk=%s" (point) 
end-pos major-mode-chunk)
                )
              (setq next-non-space-pos (point))))
          ;; Stop parsing if we do not have a chunk here yet.
          (setq continue (and major-mode-chunk
                              (funcall rng-valid-nxml-major-mode-chunk-function 
major-mode-chunk)))
          (when continue
            ;;(message "  continue=t")
            (setq end-major-mode-chunk (funcall 
rng-end-major-mode-chunk-function major-mode-chunk)))))

      (when continue
        ;;(message "*** here remain, p=%s" (point))
        (setq have-remaining-chars (rng-forward end-major-mode-chunk))
        ;;(message "*** here remain b, p=%s" (point))
        (let ((pos (point)))
          (when end-major-mode-chunk
            ;; Fix-me: Seems like we need a new initialization (or why
            ;; do we otherwise hang without this?)
            (and (> limit end-major-mode-chunk) (setq limit 
end-major-mode-chunk)))
          (setq continue
                (and have-remaining-chars
                     continue
                     (or (< pos limit)
                         (and continue-p-function
                              (funcall continue-p-function)
                              (setq limit (+ limit rng-validate-chunk-size))
                              t))))
          (cond ((and rng-conditional-up-to-date-start
                      ;; > because we are getting the state from (1- pos)
                      (> pos rng-conditional-up-to-date-start)
                      (< pos rng-conditional-up-to-date-end)
                      (rng-state-matches-current (get-text-property (1- pos)
                                                                    
'rng-state)))
                 (when (< remove-start (1- pos))
                   (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
                 ;; 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)
                 (setq have-remaining-chars
                       (< rng-validate-up-to-date-end (point-max))))
                ((or (>= pos next-cache-point)
                     (not continue))
                 (setq next-cache-point (+ pos rng-state-cache-distance))
                 (rng-clear-cached-state remove-start pos)
                 (when have-remaining-chars
                   ;;(message "rng-cach-state (1- %s)" pos)
                   (rng-cache-state (1- pos)))
                 (setq remove-start pos)
                 (unless continue
                   ;; if we have just blank chars skip to the end
                   (when have-remaining-chars
                     (skip-chars-forward " \t\r\n")
                     (when (= (point) (point-max))
                       (rng-clear-overlays pos (point))
                       (rng-clear-cached-state pos (point))
                       (setq have-remaining-chars nil)
                       (setq pos (point))))
                   (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)
                            (rng-clear-conditional-region))
                           ((< rng-conditional-up-to-date-start pos)
                            (set-marker rng-conditional-up-to-date-start
                                        pos))))))))))
    have-remaining-chars))