/[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.8 by monnier, Wed Jul 16 15:17:02 2003 UTC revision 1.9 by monnier, Wed Jul 16 15:40:25 2003 UTC
# 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 118  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-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))  
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    

Legend:
Removed from v.1.8  
changed lines
  Added in v.1.9

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