/[emacs]/emacs/lisp/jit-lock.el
ViewVC logotype

Diff of /emacs/lisp/jit-lock.el

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

revision 1.28 by eliz, Sun Nov 25 18:02:45 2001 UTC revision 1.28.4.1 by miles, Fri Apr 4 06:20:08 2003 UTC
# Line 38  Line 38 
38               (progn ,@body)               (progn ,@body)
39             (unless ,modified             (unless ,modified
40               (restore-buffer-modified-p nil))))))               (restore-buffer-modified-p nil))))))
41      
42    (defmacro with-buffer-prepared-for-jit-lock (&rest body)    (defmacro with-buffer-prepared-for-jit-lock (&rest body)
43      "Execute BODY in current buffer, overriding several variables.      "Execute BODY in current buffer, overriding several variables.
44  Preserves the `buffer-modified-p' state of the current buffer."  Preserves the `buffer-modified-p' state of the current buffer."
# Line 52  Preserves the `buffer-modified-p' state Line 52  Preserves the `buffer-modified-p' state
52              buffer-file-truename)              buffer-file-truename)
53          ,@body))))          ,@body))))
54    
55      
56    
57  ;;; Customization.  ;;; Customization.
58    
# Line 82  To reduce machine load during stealth fo Line 82  To reduce machine load during stealth fo
82  taking longer to fontify, you could increase the value of this variable.  taking longer to fontify, you could increase the value of this variable.
83  See also `jit-lock-stealth-load'."  See also `jit-lock-stealth-load'."
84    :type '(choice (const :tag "never" nil)    :type '(choice (const :tag "never" nil)
85                   (number :tag "seconds"))                           (number :tag "seconds"))
86    :group 'jit-lock)    :group 'jit-lock)
87    
88    
89  (defcustom jit-lock-stealth-load  (defcustom jit-lock-stealth-load
90    (if (condition-case nil (load-average) (error)) 200)    (if (condition-case nil (load-average) (error)) 200)
# Line 297  is active." Line 297  is active."
297  Defaults to the whole buffer.  END can be out of bounds."  Defaults to the whole buffer.  END can be out of bounds."
298    (with-buffer-prepared-for-jit-lock    (with-buffer-prepared-for-jit-lock
299     (save-excursion     (save-excursion
300       (save-restriction       (unless start (setq start (point-min)))
301         (widen)       (setq end (if end (min end (point-max)) (point-max)))
302         (unless start (setq start (point-min)))       ;; This did bind `font-lock-beginning-of-syntax-function' to
303         (setq end (if end (min end (point-max)) (point-max)))       ;; nil at some point, for an unknown reason.  Don't do this; it
304         ;; This did bind `font-lock-beginning-of-syntax-function' to       ;; can make highlighting slow due to expensive calls to
305         ;; nil at some point, for an unknown reason.  Don't do this; it       ;; `parse-partial-sexp' in function
306         ;; can make highlighting slow due to expensive calls to       ;; `font-lock-fontify-syntactically-region'.  Example: paging
307         ;; `parse-partial-sexp' in function       ;; from the end of a buffer to its start, can do repeated
308         ;; `font-lock-fontify-syntactically-region'.  Example: paging       ;; `parse-partial-sexp' starting from `point-min', which can
309         ;; from the end of a buffer to its start, can do repeated       ;; take a long time in a large buffer.
310         ;; `parse-partial-sexp' starting from `point-min', which can       (let (next)
311         ;; take a long time in a large buffer.         (save-match-data
312         (let (next)           ;; Fontify chunks beginning at START.  The end of a
313           (save-match-data           ;; chunk is either `end', or the start of a region
314             ;; Fontify chunks beginning at START.  The end of a           ;; before `end' that has already been fontified.
315             ;; chunk is either `end', or the start of a region           (while start
316             ;; before `end' that has already been fontified.             ;; Determine the end of this chunk.
317             (while start             (setq next (or (text-property-any start end 'fontified t)
318               ;; Determine the end of this chunk.                            end))
319               (setq next (or (text-property-any start end 'fontified t)  
320                              end))             ;; Decide which range of text should be fontified.
321               ;; The problem is that START and NEXT may be in the
322               ;; Decide which range of text should be fontified.             ;; middle of something matched by a font-lock regexp.
323               ;; The problem is that START and NEXT may be in the             ;; Until someone has a better idea, let's start
324               ;; middle of something matched by a font-lock regexp.             ;; at the start of the line containing START and
325               ;; Until someone has a better idea, let's start             ;; stop at the start of the line following NEXT.
326               ;; at the start of the line containing START and             (goto-char next)  (setq next (line-beginning-position 2))
327               ;; stop at the start of the line following NEXT.             (goto-char start) (setq start (line-beginning-position))
328               (goto-char next)  (setq next (line-beginning-position 2))  
329               (goto-char start) (setq start (line-beginning-position))             ;; Fontify the chunk, and mark it as fontified.
330                           ;; We mark it first, to make sure that we don't indefinitely
331               ;; Fontify the chunk, and mark it as fontified.             ;; re-execute this fontification if an error occurs.
332               ;; We mark it first, to make sure that we don't indefinitely             (put-text-property start next 'fontified t)
333               ;; re-execute this fontification if an error occurs.             (run-hook-with-args 'jit-lock-functions start next)
              (put-text-property start next 'fontified t)  
              (run-hook-with-args 'jit-lock-functions start next)  
334    
335               ;; Find the start of the next chunk, if any.             ;; Find the start of the next chunk, if any.
336               (setq start (text-property-any next end 'fontified nil)))))))))             (setq start (text-property-any next end 'fontified nil))))))))
337    
338    
339  ;;; Stealth fontification.  ;;; Stealth fontification.
# Line 380  Value is nil if there is nothing more to Line 378  Value is nil if there is nothing more to
378                             ((< (- around start) (- next around)) start)                             ((< (- around start) (- next around)) start)
379                             (t next))))                             (t next))))
380          result))))          result))))
381            
382    
383  (defun jit-lock-stealth-fontify ()  (defun jit-lock-stealth-fontify ()
384    "Fontify buffers stealthily.    "Fontify buffers stealthily.
# Line 395  This functions is called after Emacs has Line 393  This functions is called after Emacs has
393        (while (and buffers (not (input-pending-p)))        (while (and buffers (not (input-pending-p)))
394          (let ((buffer (car buffers)))          (let ((buffer (car buffers)))
395            (setq buffers (cdr buffers))            (setq buffers (cdr buffers))
396              
397            (with-current-buffer buffer            (with-current-buffer buffer
398              (when jit-lock-mode              (when jit-lock-mode
399                ;; This is funny.  Calling sit-for with 3rd arg non-nil                ;; This is funny.  Calling sit-for with 3rd arg non-nil
# Line 449  This functions is called after Emacs has Line 447  This functions is called after Emacs has
447                    (while (and (setq start                    (while (and (setq start
448                                      (jit-lock-stealth-chunk-start point))                                      (jit-lock-stealth-chunk-start point))
449                                (sit-for nice))                                (sit-for nice))
450                        
451                      ;; fontify a block.                      ;; fontify a block.
452                      (jit-lock-fontify-now start (+ start jit-lock-chunk-size))                      (jit-lock-fontify-now start (+ start jit-lock-chunk-size))
453                      ;; If stealth jit-locking is done backwards, this leads to                      ;; If stealth jit-locking is done backwards, this leads to
454                      ;; excessive O(n^2) refontification.   -stef                      ;; excessive O(n^2) refontification.   -stef
455                      ;; (when (>= jit-lock-first-unfontify-pos start)                      ;; (when (>= jit-lock-first-unfontify-pos start)
456                      ;;   (setq jit-lock-first-unfontify-pos end))                      ;;   (setq jit-lock-first-unfontify-pos end))
457                        
458                      ;; Wait a little if load is too high.                      ;; Wait a little if load is too high.
459                      (when (and jit-lock-stealth-load                      (when (and jit-lock-stealth-load
460                                 (> (car (load-average)) jit-lock-stealth-load))                                 (> (car (load-average)) jit-lock-stealth-load))
# Line 491  This functions is called after Emacs has Line 489  This functions is called after Emacs has
489        (sit-for 0)        (sit-for 0)
490        ;; (message "Jit-Defer Done")        ;; (message "Jit-Defer Done")
491        )))        )))
492          
493    
494  (defun jit-lock-after-change (start end old-len)  (defun jit-lock-after-change (start end old-len)
495    "Mark the rest of the buffer as not fontified after a change.    "Mark the rest of the buffer as not fontified after a change.
# Line 510  will take place when text is fontified s Line 508  will take place when text is fontified s
508         ;; be inconsistent with the buffer's content.         ;; be inconsistent with the buffer's content.
509         (goto-char start)         (goto-char start)
510         (setq start (line-beginning-position))         (setq start (line-beginning-position))
511          
512         ;; If we're in text that matches a multi-line font-lock pattern,         ;; If we're in text that matches a multi-line font-lock pattern,
513         ;; make sure the whole text will be redisplayed.         ;; make sure the whole text will be redisplayed.
514         ;; I'm not sure this is ever necessary and/or sufficient.  -stef         ;; I'm not sure this is ever necessary and/or sufficient.  -stef
# Line 518  will take place when text is fontified s Line 516  will take place when text is fontified s
516           (setq start (or (previous-single-property-change           (setq start (or (previous-single-property-change
517                            start 'font-lock-multiline)                            start 'font-lock-multiline)
518                           (point-min))))                           (point-min))))
519          
520         ;; Make sure we change at least one char (in case of deletions).         ;; Make sure we change at least one char (in case of deletions).
521         (setq end (min (max end (1+ start)) (point-max)))         (setq end (min (max end (1+ start)) (point-max)))
522         ;; Request refontification.         ;; Request refontification.
# Line 527  will take place when text is fontified s Line 525  will take place when text is fontified s
525        (when jit-lock-first-unfontify-pos        (when jit-lock-first-unfontify-pos
526          (setq jit-lock-first-unfontify-pos          (setq jit-lock-first-unfontify-pos
527                (min jit-lock-first-unfontify-pos start))))))                (min jit-lock-first-unfontify-pos start))))))
528      
529  (provide 'jit-lock)  (provide 'jit-lock)
530    
531  ;;; jit-lock.el ends here  ;;; jit-lock.el ends here

Legend:
Removed from v.1.28  
changed lines
  Added in v.1.28.4.1

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