(syntax-ppss): Catch the case where the buffer is narrowed.

1 files changed, 142 insertions, 133 deletions

diff --git a/lisp/emacs-lisp/syntax.el b/lisp/emacs-lisp/syntax.el
index b5b8ec251a7..7bd8378ab86 100644
--- a/lisp/emacs-lisp/syntax.el
+++ b/lisp/emacs-lisp/syntax.el
@@ -39,7 +39,6 @@
 ;; - new functions `syntax-state', ... to replace uses of parse-partial-state
 ;;   with something higher-level (similar to syntax-ppss-context).
 ;; - interaction with mmm-mode.
-;; - what to do when the buffer is narrowed ?
 
 ;;; Code:
 
@@ -118,141 +117,151 @@ Point is at POS when this function returns."
         (pt-min (point-min)))
     (if (and old-pos (> old-pos pos)) (setq old-pos nil))
     ;; Use the OLD-POS if usable and close.  Don't update the `last' cache.
-    (if (and old-pos (< (- pos old-pos)
-                        ;; The time to find PPSS using syntax-begin-function
-                        ;; is assumed to be about 2 * distance.
-                        (* 2 (/ (cdr (aref syntax-ppss-stats 5))
-                                (1+ (car (aref syntax-ppss-stats 5)))))))
-        (progn
-          (incf (car (aref syntax-ppss-stats 0)))
-          (incf (cdr (aref syntax-ppss-stats 0)) (- pos old-pos))
-          (parse-partial-sexp old-pos pos nil nil old-ppss))
-
-      (cond
-       ;; Use OLD-PPSS if possible and close enough.
-       ((and (not old-pos) old-ppss
-             ;; BEWARE! We rely on the undocumented 9th field.
-             ;; The 9th field currently contains the list of positions
-             ;; of open-parens of the enclosing parens.  I.e.  those positions
-             ;; are outside of any string/comment and the first of those is
-             ;; outside of any paren (i.e. corresponds to a nil ppss).
-             ;; If this list is empty but we are in a string or comment,
-             ;; then the 8th field contains a similar "toplevel" position.
-             ;; If `pt-min' is too far from `pos', we could try to use
-             ;; other positions in (nth 9 old-ppss), but that doesn't seem
-             ;; to happen in practice and it would complicate this code
-             ;; (and the after-change-function code even more).  But maybe it
-             ;; would be useful in "degenerate" cases such as when the whole
-             ;; file is wrapped in a set of parenthesis.
-             (setq pt-min (or (car (nth 9 old-ppss))
-                              (nth 8 old-ppss)
-                              (nth 2 old-ppss)))
-             (<= pt-min pos) (< (- pos pt-min) syntax-ppss-max-span))
-        (incf (car (aref syntax-ppss-stats 1)))
-        (incf (cdr (aref syntax-ppss-stats 1)) (- pos pt-min))
-        (setq ppss (parse-partial-sexp pt-min pos)))
-       ;; The OLD-* data can't be used.  Consult the cache.
-       (t
-        (let ((cache-pred nil)
-              (cache syntax-ppss-cache)
-              (pt-min (point-min))
-              ;; I differentiate between PT-MIN and PT-BEST because I feel
-              ;; like it might be important to ensure that the cache is only
-              ;; filled with 100% sure data (whereas syntax-begin-function
-              ;; might return incorrect data).  Maybe that's just stupid.
-              (pt-best (point-min))
-              (ppss-best nil))
-          ;; look for a usable cache entry.
-          (while (and cache (< pos (caar cache)))
-            (setq cache-pred cache)
-            (setq cache (cdr cache)))
-          (if cache (setq pt-min (caar cache) ppss (cdar cache)))
-
-          ;; Setup the after-change function if necessary.
-          (unless (or syntax-ppss-cache syntax-ppss-last)
-            (add-hook 'after-change-functions 'syntax-ppss-flush-cache nil t))
-
-          ;; Use the best of OLD-POS and CACHE.
-          (if (or (not old-pos) (< old-pos pt-min))
-              (setq pt-best pt-min ppss-best ppss)
-            (incf (car (aref syntax-ppss-stats 4)))
-            (incf (cdr (aref syntax-ppss-stats 4)) (- pos old-pos))
-            (setq pt-best old-pos ppss-best old-ppss))
-
-          ;; Use the `syntax-begin-function' if available.
-          ;; We could try using that function earlier, but:
-          ;; - The result might not be 100% reliable, so it's better to use
-          ;;   the cache if available.
-          ;; - The function might be slow.
-          ;; - If this function almost always finds a safe nearby spot,
-          ;;   the cache won't be populated, so consulting it is cheap.
-          (unless (or syntax-begin-function
-                      (not (boundp 'font-lock-beginning-of-syntax-function))
-                      (not font-lock-beginning-of-syntax-function))
-            (set (make-local-variable 'syntax-begin-function)
-                 font-lock-beginning-of-syntax-function))
-          (when (and syntax-begin-function
-                     (progn (goto-char pos)
-                            (funcall syntax-begin-function)
-                            ;; Make sure it's better.
-                            (> (point) pt-best))
-                     ;; Simple sanity check.
-                     (not (memq (get-text-property (point) 'face)
-                                '(font-lock-string-face font-lock-comment-face
-                                  font-lock-doc-face))))
-            (incf (car (aref syntax-ppss-stats 5)))
-            (incf (cdr (aref syntax-ppss-stats 5)) (- pos (point)))
-            (setq pt-best (point) ppss-best nil))
+    (condition-case nil
+        (if (and old-pos (< (- pos old-pos)
+                            ;; The time to use syntax-begin-function and
+                            ;; find PPSS is assumed to be about 2 * distance.
+                            (* 2 (/ (cdr (aref syntax-ppss-stats 5))
+                                    (1+ (car (aref syntax-ppss-stats 5)))))))
+            (progn
+              (incf (car (aref syntax-ppss-stats 0)))
+              (incf (cdr (aref syntax-ppss-stats 0)) (- pos old-pos))
+              (parse-partial-sexp old-pos pos nil nil old-ppss))
 
           (cond
-           ;; Quick case when we found a nearby pos.
-           ((< (- pos pt-best) syntax-ppss-max-span)
-            (incf (car (aref syntax-ppss-stats 2)))
-            (incf (cdr (aref syntax-ppss-stats 2)) (- pos pt-best))
-            (setq ppss (parse-partial-sexp pt-best pos nil nil ppss-best)))
-           ;; Slow case: compute the state from some known position and
-           ;; populate the cache so we won't need to do it again soon.
+           ;; Use OLD-PPSS if possible and close enough.
+           ((and (not old-pos) old-ppss
+                 ;; BEWARE! We rely on the undocumented 9th field.  The 9th
+                 ;; field currently contains the list of positions of
+                 ;; open-parens of the enclosing parens.  I.e. those
+                 ;; positions are outside of any string/comment
+                 ;; and the first of those is outside of any paren
+                 ;; (i.e. corresponds to a nil ppss).  If this list is empty
+                 ;; but we are in a string or comment, then the 8th field
+                 ;; contains a similar "toplevel" position.  If `pt-min' is
+                 ;; too far from `pos', we could try to use other positions
+                 ;; in (nth 9 old-ppss), but that doesn't seem to happen in
+                 ;; practice and it would complicate this code (and the
+                 ;; after-change-function code even more).  But maybe it
+                 ;; would be useful in "degenerate" cases such as when the
+                 ;; whole file is wrapped in a set of parenthesis.
+                 (setq pt-min (or (car (nth 9 old-ppss))
+                                  (nth 8 old-ppss)
+                                  (nth 2 old-ppss)))
+                 (<= pt-min pos) (< (- pos pt-min) syntax-ppss-max-span))
+            (incf (car (aref syntax-ppss-stats 1)))
+            (incf (cdr (aref syntax-ppss-stats 1)) (- pos pt-min))
+            (setq ppss (parse-partial-sexp pt-min pos)))
+           ;; The OLD-* data can't be used.  Consult the cache.
            (t
-            (incf (car (aref syntax-ppss-stats 3)))
-            (incf (cdr (aref syntax-ppss-stats 3)) (- pos pt-min))
-
-            ;; If `pt-min' is too far, add a few intermediate entries.
-            (while (> (- pos pt-min) (* 2 syntax-ppss-max-span))
-              (setq ppss (parse-partial-sexp
-                          pt-min (setq pt-min (/ (+ pt-min pos) 2))
-                          nil nil ppss))
-              (let ((pair (cons pt-min ppss)))
-                (if cache-pred
-                    (push pair (cdr cache-pred))
-                  (push pair syntax-ppss-cache))))
-
-            ;; Compute the actual return value.
-            (setq ppss (parse-partial-sexp pt-min pos nil nil ppss))
-
-            ;; Debugging check.
-            ;; (let ((real-ppss (parse-partial-sexp (point-min) pos)))
-            ;;   (setcar (last ppss 4) 0)
-            ;;   (setcar (last real-ppss 4) 0)
-            ;;   (setcar (last ppss 8) nil)
-            ;;   (setcar (last real-ppss 8) nil)
-            ;;   (unless (equal ppss real-ppss)
-            ;;     (message "!!Syntax: %s != %s" ppss real-ppss)
-            ;;     (setq ppss real-ppss)))
-
-            ;; Store it in the cache.
-            (let ((pair (cons pos ppss)))
-              (if cache-pred
-                  (if (> (- (caar cache-pred) pos) syntax-ppss-max-span)
-                      (push pair (cdr cache-pred))
-                    (setcar cache-pred pair))
-                (if (or (null syntax-ppss-cache)
-                        (> (- (caar syntax-ppss-cache) pos)
-                           syntax-ppss-max-span))
-                    (push pair syntax-ppss-cache)
-                  (setcar syntax-ppss-cache pair)))))))))
-
-      (setq syntax-ppss-last (cons pos ppss))
-      ppss)))
+            (let ((cache-pred nil)
+                  (cache syntax-ppss-cache)
+                  (pt-min (point-min))
+                  ;; I differentiate between PT-MIN and PT-BEST because
+                  ;; I feel like it might be important to ensure that the
+                  ;; cache is only filled with 100% sure data (whereas
+                  ;; syntax-begin-function might return incorrect data).
+                  ;; Maybe that's just stupid.
+                  (pt-best (point-min))
+                  (ppss-best nil))
+              ;; look for a usable cache entry.
+              (while (and cache (< pos (caar cache)))
+                (setq cache-pred cache)
+                (setq cache (cdr cache)))
+              (if cache (setq pt-min (caar cache) ppss (cdar cache)))
+
+              ;; Setup the after-change function if necessary.
+              (unless (or syntax-ppss-cache syntax-ppss-last)
+                (add-hook 'after-change-functions
+                          'syntax-ppss-flush-cache nil t))
+
+              ;; Use the best of OLD-POS and CACHE.
+              (if (or (not old-pos) (< old-pos pt-min))
+                  (setq pt-best pt-min ppss-best ppss)
+                (incf (car (aref syntax-ppss-stats 4)))
+                (incf (cdr (aref syntax-ppss-stats 4)) (- pos old-pos))
+                (setq pt-best old-pos ppss-best old-ppss))
+
+              ;; Use the `syntax-begin-function' if available.
+              ;; We could try using that function earlier, but:
+              ;; - The result might not be 100% reliable, so it's better to use
+              ;;   the cache if available.
+              ;; - The function might be slow.
+              ;; - If this function almost always finds a safe nearby spot,
+              ;;   the cache won't be populated, so consulting it is cheap.
+              (when (and (not syntax-begin-function)
+                         (boundp 'font-lock-beginning-of-syntax-function)
+                         font-lock-beginning-of-syntax-function)
+                (set (make-local-variable 'syntax-begin-function)
+                     font-lock-beginning-of-syntax-function))
+              (when (and syntax-begin-function
+                         (progn (goto-char pos)
+                                (funcall syntax-begin-function)
+                                ;; Make sure it's better.
+                                (> (point) pt-best))
+                         ;; Simple sanity check.
+                         (not (memq (get-text-property (point) 'face)
+                                    '(font-lock-string-face font-lock-doc-face
+                                      font-lock-comment-face))))
+                (incf (car (aref syntax-ppss-stats 5)))
+                (incf (cdr (aref syntax-ppss-stats 5)) (- pos (point)))
+                (setq pt-best (point) ppss-best nil))
+
+              (cond
+               ;; Quick case when we found a nearby pos.
+               ((< (- pos pt-best) syntax-ppss-max-span)
+                (incf (car (aref syntax-ppss-stats 2)))
+                (incf (cdr (aref syntax-ppss-stats 2)) (- pos pt-best))
+                (setq ppss (parse-partial-sexp pt-best pos nil nil ppss-best)))
+               ;; Slow case: compute the state from some known position and
+               ;; populate the cache so we won't need to do it again soon.
+               (t
+                (incf (car (aref syntax-ppss-stats 3)))
+                (incf (cdr (aref syntax-ppss-stats 3)) (- pos pt-min))
+
+                ;; If `pt-min' is too far, add a few intermediate entries.
+                (while (> (- pos pt-min) (* 2 syntax-ppss-max-span))
+                  (setq ppss (parse-partial-sexp
+                              pt-min (setq pt-min (/ (+ pt-min pos) 2))
+                              nil nil ppss))
+                  (let ((pair (cons pt-min ppss)))
+                    (if cache-pred
+                        (push pair (cdr cache-pred))
+                      (push pair syntax-ppss-cache))))
+
+                ;; Compute the actual return value.
+                (setq ppss (parse-partial-sexp pt-min pos nil nil ppss))
+
+                ;; Debugging check.
+                ;; (let ((real-ppss (parse-partial-sexp (point-min) pos)))
+                ;;   (setcar (last ppss 4) 0)
+                ;;   (setcar (last real-ppss 4) 0)
+                ;;   (setcar (last ppss 8) nil)
+                ;;   (setcar (last real-ppss 8) nil)
+                ;;   (unless (equal ppss real-ppss)
+                ;;     (message "!!Syntax: %s != %s" ppss real-ppss)
+                ;;     (setq ppss real-ppss)))
+
+                ;; Store it in the cache.
+                (let ((pair (cons pos ppss)))
+                  (if cache-pred
+                      (if (> (- (caar cache-pred) pos) syntax-ppss-max-span)
+                          (push pair (cdr cache-pred))
+                        (setcar cache-pred pair))
+                    (if (or (null syntax-ppss-cache)
+                            (> (- (caar syntax-ppss-cache) pos)
+                               syntax-ppss-max-span))
+                        (push pair syntax-ppss-cache)
+                      (setcar syntax-ppss-cache pair)))))))))
+
+          (setq syntax-ppss-last (cons pos ppss))
+          ppss)
+      (args-out-of-range
+       ;; If the buffer is more narrowed than when we built the cache,
+       ;; we may end up calling parse-partial-sexp with a position before
+       ;; point-min.  In that case, just parse from point-min assuming
+       ;; a nil state.
+       (parse-partial-sexp (point-min) pos)))))
 
 ;; Debugging functions