/[emacs]/emacs/lisp/emacs-lisp/syntax.el
ViewVC logotype

Diff of /emacs/lisp/emacs-lisp/syntax.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.5.2.1 by miles, Fri Apr 4 06:20:16 2003 UTC revision 1.5.2.2 by miles, Tue Oct 14 23:32:21 2003 UTC
# Line 1  Line 1 
1  ;;; syntax.el --- helper functions to find syntactic context  ;;; syntax.el --- helper functions to find syntactic context
2    
3  ;; Copyright (C) 2000 Free Software Foundation, Inc.  ;; Copyright (C) 2000, 2003 Free Software Foundation, Inc.
4    
5  ;; Maintainer: FSF  ;; Maintainer: FSF
6  ;; Keywords: internal  ;; Keywords: internal
# Line 25  Line 25 
25  ;;; Commentary:  ;;; Commentary:
26    
27  ;; The main exported function is `syntax-ppss'.  You might also need  ;; The main exported function is `syntax-ppss'.  You might also need
28  ;; to call `syntax-ppss-after-change-function' or to add it to  ;; to call `syntax-ppss-flush-cache' or to add it to
29  ;; after-change-functions'(although this is automatically done by  ;; after-change-functions'(although this is automatically done by
30  ;; syntax-ppss when needed, but that might fail if syntax-ppss is  ;; syntax-ppss when needed, but that might fail if syntax-ppss is
31  ;; called in a context where after-change-functions is temporarily  ;; called in a context where after-change-functions is temporarily
# Line 39  Line 39 
39  ;; - new functions `syntax-state', ... to replace uses of parse-partial-state  ;; - new functions `syntax-state', ... to replace uses of parse-partial-state
40  ;;   with something higher-level (similar to syntax-ppss-context).  ;;   with something higher-level (similar to syntax-ppss-context).
41  ;; - interaction with mmm-mode.  ;; - interaction with mmm-mode.
 ;; - what to do when the buffer is narrowed ?  
42    
43  ;;; Code:  ;;; Code:
44    
# Line 73  point (where the PPSS is equivalent to n Line 72  point (where the PPSS is equivalent to n
72    "Cache of (LAST-POS . LAST-PPSS).")    "Cache of (LAST-POS . LAST-PPSS).")
73  (make-variable-buffer-local 'syntax-ppss-last)  (make-variable-buffer-local 'syntax-ppss-last)
74    
75  (defun syntax-ppss-after-change-function (beg &rest ignored)  (defalias 'syntax-ppss-after-change-function 'syntax-ppss-flush-cache)
76    (defun syntax-ppss-flush-cache (beg &rest ignored)
77      "Flush the cache of `syntax-ppss' starting at position BEG."
78    ;; Flush invalid cache entries.    ;; Flush invalid cache entries.
79    (while (and syntax-ppss-cache (> (caar syntax-ppss-cache) beg))    (while (and syntax-ppss-cache (> (caar syntax-ppss-cache) beg))
80      (setq syntax-ppss-cache (cdr syntax-ppss-cache)))      (setq syntax-ppss-cache (cdr syntax-ppss-cache)))
# Line 106  point (where the PPSS is equivalent to n Line 107  point (where the PPSS is equivalent to n
107    "Parse-Partial-Sexp State at POS.    "Parse-Partial-Sexp State at POS.
108  The returned value is the same as `parse-partial-sexp' except that  The returned value is the same as `parse-partial-sexp' except that
109  the 2nd and 6th values of the returned state cannot be relied upon.  the 2nd and 6th values of the returned state cannot be relied upon.
   
 If the caller knows the PPSS of a nearby position, she can pass it  
 in OLP-PPSS (with or without its corresponding OLD-POS) to try and  
 avoid a more expansive scan.  
110  Point is at POS when this function returns."  Point is at POS when this function returns."
111    ;; Default values.    ;; Default values.
112    (unless pos (setq pos (point)))    (unless pos (setq pos (point)))
# Line 120  Point is at POS when this function retur Line 117  Point is at POS when this function retur
117          (pt-min (point-min)))          (pt-min (point-min)))
118      (if (and old-pos (> old-pos pos)) (setq old-pos nil))      (if (and old-pos (> old-pos pos)) (setq old-pos nil))
119      ;; Use the OLD-POS if usable and close.  Don't update the `last' cache.      ;; Use the OLD-POS if usable and close.  Don't update the `last' cache.
120      (if (and old-pos (< (- pos old-pos)      (condition-case nil
121                          ;; The time to find PPSS using syntax-begin-function          (if (and old-pos (< (- pos old-pos)
122                          ;; is assumed to be about 2 * distance.                              ;; The time to use syntax-begin-function and
123                          (* 2 (/ (cdr (aref syntax-ppss-stats 5))                              ;; find PPSS is assumed to be about 2 * distance.
124                                  (1+ (car (aref syntax-ppss-stats 5)))))))                              (* 2 (/ (cdr (aref syntax-ppss-stats 5))
125          (progn                                      (1+ (car (aref syntax-ppss-stats 5)))))))
126            (incf (car (aref syntax-ppss-stats 0)))              (progn
127            (incf (cdr (aref syntax-ppss-stats 0)) (- pos old-pos))                (incf (car (aref syntax-ppss-stats 0)))
128            (parse-partial-sexp old-pos pos nil nil old-ppss))                (incf (cdr (aref syntax-ppss-stats 0)) (- pos old-pos))
129                  (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-after-change-function 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))  
130    
131            (cond            (cond
132             ;; Quick case when we found a nearby pos.             ;; Use OLD-PPSS if possible and close enough.
133             ((< (- pos pt-best) syntax-ppss-max-span)             ((and (not old-pos) old-ppss
134              (incf (car (aref syntax-ppss-stats 2)))                   ;; BEWARE! We rely on the undocumented 9th field.  The 9th
135              (incf (cdr (aref syntax-ppss-stats 2)) (- pos pt-best))                   ;; field currently contains the list of positions of
136              (setq ppss (parse-partial-sexp pt-best pos nil nil ppss-best)))                   ;; open-parens of the enclosing parens.  I.e. those
137             ;; Slow case: compute the state from some known position and                   ;; positions are outside of any string/comment
138             ;; populate the cache so we won't need to do it again soon.                   ;; and the first of those is outside of any paren
139                     ;; (i.e. corresponds to a nil ppss).  If this list is empty
140                     ;; but we are in a string or comment, then the 8th field
141                     ;; contains a similar "toplevel" position.  If `pt-min' is
142                     ;; too far from `pos', we could try to use other positions
143                     ;; in (nth 9 old-ppss), but that doesn't seem to happen in
144                     ;; practice and it would complicate this code (and the
145                     ;; after-change-function code even more).  But maybe it
146                     ;; would be useful in "degenerate" cases such as when the
147                     ;; whole file is wrapped in a set of parenthesis.
148                     (setq pt-min (or (car (nth 9 old-ppss))
149                                      (nth 8 old-ppss)
150                                      (nth 2 old-ppss)))
151                     (<= pt-min pos) (< (- pos pt-min) syntax-ppss-max-span))
152                (incf (car (aref syntax-ppss-stats 1)))
153                (incf (cdr (aref syntax-ppss-stats 1)) (- pos pt-min))
154                (setq ppss (parse-partial-sexp pt-min pos)))
155               ;; The OLD-* data can't be used.  Consult the cache.
156             (t             (t
157              (incf (car (aref syntax-ppss-stats 3)))              (let ((cache-pred nil)
158              (incf (cdr (aref syntax-ppss-stats 3)) (- pos pt-min))                    (cache syntax-ppss-cache)
159                      (pt-min (point-min))
160              ;; If `pt-min' is too far, add a few intermediate entries.                    ;; I differentiate between PT-MIN and PT-BEST because
161              (while (> (- pos pt-min) (* 2 syntax-ppss-max-span))                    ;; I feel like it might be important to ensure that the
162                (setq ppss (parse-partial-sexp                    ;; cache is only filled with 100% sure data (whereas
163                            pt-min (setq pt-min (/ (+ pt-min pos) 2))                    ;; syntax-begin-function might return incorrect data).
164                            nil nil ppss))                    ;; Maybe that's just stupid.
165                (let ((pair (cons pt-min ppss)))                    (pt-best (point-min))
166                  (if cache-pred                    (ppss-best nil))
167                      (push pair (cdr cache-pred))                ;; look for a usable cache entry.
168                    (push pair syntax-ppss-cache))))                (while (and cache (< pos (caar cache)))
169                    (setq cache-pred cache)
170              ;; Compute the actual return value.                  (setq cache (cdr cache)))
171              (setq ppss (parse-partial-sexp pt-min pos nil nil ppss))                (if cache (setq pt-min (caar cache) ppss (cdar cache)))
172    
173              ;; Debugging check.                ;; Setup the after-change function if necessary.
174              ;; (let ((real-ppss (parse-partial-sexp (point-min) pos)))                (unless (or syntax-ppss-cache syntax-ppss-last)
175              ;;   (setcar (last ppss 4) 0)                  (add-hook 'after-change-functions
176              ;;   (setcar (last real-ppss 4) 0)                            'syntax-ppss-flush-cache nil t))
177              ;;   (setcar (last ppss 8) nil)  
178              ;;   (setcar (last real-ppss 8) nil)                ;; Use the best of OLD-POS and CACHE.
179              ;;   (unless (equal ppss real-ppss)                (if (or (not old-pos) (< old-pos pt-min))
180              ;;     (message "!!Syntax: %s != %s" ppss real-ppss)                    (setq pt-best pt-min ppss-best ppss)
181              ;;     (setq ppss real-ppss)))                  (incf (car (aref syntax-ppss-stats 4)))
182                    (incf (cdr (aref syntax-ppss-stats 4)) (- pos old-pos))
183              ;; Store it in the cache.                  (setq pt-best old-pos ppss-best old-ppss))
184              (let ((pair (cons pos ppss)))  
185                (if cache-pred                ;; Use the `syntax-begin-function' if available.
186                    (if (> (- (caar cache-pred) pos) syntax-ppss-max-span)                ;; We could try using that function earlier, but:
187                        (push pair (cdr cache-pred))                ;; - The result might not be 100% reliable, so it's better to use
188                      (setcar cache-pred pair))                ;;   the cache if available.
189                  (if (or (null syntax-ppss-cache)                ;; - The function might be slow.
190                          (> (- (caar syntax-ppss-cache) pos)                ;; - If this function almost always finds a safe nearby spot,
191                             syntax-ppss-max-span))                ;;   the cache won't be populated, so consulting it is cheap.
192                      (push pair syntax-ppss-cache)                (when (and (not syntax-begin-function)
193                    (setcar syntax-ppss-cache pair)))))))))                           (boundp 'font-lock-beginning-of-syntax-function)
194                             font-lock-beginning-of-syntax-function)
195        (setq syntax-ppss-last (cons pos ppss))                  (set (make-local-variable 'syntax-begin-function)
196        ppss)))                       font-lock-beginning-of-syntax-function))
197                  (when (and syntax-begin-function
198                             (progn (goto-char pos)
199                                    (funcall syntax-begin-function)
200                                    ;; Make sure it's better.
201                                    (> (point) pt-best))
202                             ;; Simple sanity check.
203                             (not (memq (get-text-property (point) 'face)
204                                        '(font-lock-string-face font-lock-doc-face
205                                          font-lock-comment-face))))
206                    (incf (car (aref syntax-ppss-stats 5)))
207                    (incf (cdr (aref syntax-ppss-stats 5)) (- pos (point)))
208                    (setq pt-best (point) ppss-best nil))
209    
210                  (cond
211                   ;; Quick case when we found a nearby pos.
212                   ((< (- pos pt-best) syntax-ppss-max-span)
213                    (incf (car (aref syntax-ppss-stats 2)))
214                    (incf (cdr (aref syntax-ppss-stats 2)) (- pos pt-best))
215                    (setq ppss (parse-partial-sexp pt-best pos nil nil ppss-best)))
216                   ;; Slow case: compute the state from some known position and
217                   ;; populate the cache so we won't need to do it again soon.
218                   (t
219                    (incf (car (aref syntax-ppss-stats 3)))
220                    (incf (cdr (aref syntax-ppss-stats 3)) (- pos pt-min))
221    
222                    ;; If `pt-min' is too far, add a few intermediate entries.
223                    (while (> (- pos pt-min) (* 2 syntax-ppss-max-span))
224                      (setq ppss (parse-partial-sexp
225                                  pt-min (setq pt-min (/ (+ pt-min pos) 2))
226                                  nil nil ppss))
227                      (let ((pair (cons pt-min ppss)))
228                        (if cache-pred
229                            (push pair (cdr cache-pred))
230                          (push pair syntax-ppss-cache))))
231    
232                    ;; Compute the actual return value.
233                    (setq ppss (parse-partial-sexp pt-min pos nil nil ppss))
234    
235                    ;; Debugging check.
236                    ;; (let ((real-ppss (parse-partial-sexp (point-min) pos)))
237                    ;;   (setcar (last ppss 4) 0)
238                    ;;   (setcar (last real-ppss 4) 0)
239                    ;;   (setcar (last ppss 8) nil)
240                    ;;   (setcar (last real-ppss 8) nil)
241                    ;;   (unless (equal ppss real-ppss)
242                    ;;     (message "!!Syntax: %s != %s" ppss real-ppss)
243                    ;;     (setq ppss real-ppss)))
244    
245                    ;; Store it in the cache.
246                    (let ((pair (cons pos ppss)))
247                      (if cache-pred
248                          (if (> (- (caar cache-pred) pos) syntax-ppss-max-span)
249                              (push pair (cdr cache-pred))
250                            (setcar cache-pred pair))
251                        (if (or (null syntax-ppss-cache)
252                                (> (- (caar syntax-ppss-cache) pos)
253                                   syntax-ppss-max-span))
254                            (push pair syntax-ppss-cache)
255                          (setcar syntax-ppss-cache pair)))))))))
256    
257              (setq syntax-ppss-last (cons pos ppss))
258              ppss)
259          (args-out-of-range
260           ;; If the buffer is more narrowed than when we built the cache,
261           ;; we may end up calling parse-partial-sexp with a position before
262           ;; point-min.  In that case, just parse from point-min assuming
263           ;; a nil state.
264           (parse-partial-sexp (point-min) pos)))))
265    
266  ;; Debugging functions  ;; Debugging functions
267    
# Line 283  Point is at POS when this function retur Line 289  Point is at POS when this function retur
289  ;;     (syntax-ppss-depth (syntax-ppss))))  ;;     (syntax-ppss-depth (syntax-ppss))))
290    
291  (provide 'syntax)  (provide 'syntax)
292    
293    ;;; arch-tag: 302f1eeb-e77c-4680-a8c5-c543e01161a5
294  ;;; syntax.el ends here  ;;; syntax.el ends here

Legend:
Removed from v.1.5.2.1  
changed lines
  Added in v.1.5.2.2

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26