[slime-cvs] CVS slime/contrib
CVS User trittweiler
trittweiler at common-lisp.net
Sat May 16 12:54:33 UTC 2009
Update of /project/slime/cvsroot/slime/contrib
In directory cl-net:/tmp/cvs-serv24396/contrib
Modified Files:
ChangeLog slime-fontifying-fu.el
Log Message:
Optimize font-lock-magic.
* slime-fontifying-fu.el (slime-search-suppressed-forms-match-data):
New var, to inhibit consing.
(slime-search-suppressed-forms-internal): Use it.
(slime-extend-region-for-font-lock): Do not call
`slime-connected-p', it's not needed in this place.
(slime-search-directly-preceding-reader-conditional): Do not use
`values', and `multiple-value-bind'.
(slime-beginning-of-tlf): When we know the current paren depth,
use it to jump directly over all parens rather than jumping to
each open paren in turn.
(slime-compute-region-for-font-lock): Use it.
--- /project/slime/cvsroot/slime/contrib/ChangeLog 2009/05/15 20:02:43 1.209
+++ /project/slime/cvsroot/slime/contrib/ChangeLog 2009/05/16 12:54:33 1.210
@@ -1,3 +1,19 @@
+2009-05-16 Tobias C. Rittweiler <tcr at freebits.de>
+
+ Optimize font-lock-magic.
+
+ * slime-fontifying-fu.el (slime-search-suppressed-forms-match-data):
+ New var, to inhibit consing.
+ (slime-search-suppressed-forms-internal): Use it.
+ (slime-extend-region-for-font-lock): Do not call
+ `slime-connected-p', it's not needed in this place.
+ (slime-search-directly-preceding-reader-conditional): Do not use
+ `values', and `multiple-value-bind'.
+ (slime-beginning-of-tlf): When we know the current paren depth,
+ use it to jump directly over all parens rather than jumping to
+ each open paren in turn.
+ (slime-compute-region-for-font-lock): Use it.
+
2009-05-15 Tobias C. Rittweiler <tcr at freebits.de>
* slime-fontifying-fu.el (slime-search-suppressed-forms-internal):
--- /project/slime/cvsroot/slime/contrib/slime-fontifying-fu.el 2009/05/15 20:02:43 1.3
+++ /project/slime/cvsroot/slime/contrib/slime-fontifying-fu.el 2009/05/16 12:54:33 1.4
@@ -29,6 +29,8 @@
"Face for compiler notes while selected."
:group 'slime-mode-faces)
+(defvar slime-search-suppressed-forms-match-data (list nil nil))
+
(defun slime-search-suppressed-forms-internal (limit)
(when (search-forward-regexp slime-reader-conditionals-regexp limit t)
(if (let ((state (slime-current-parser-state)))
@@ -52,8 +54,7 @@
;; With extending the region properly, this assertion
;; would truly mean a bug now.
(assert (<= (point) limit))
- (let ((md (match-data)))
- (fill md nil)
+ (let ((md (match-data nil slime-search-suppressed-forms-match-data)))
(setf (first md) start)
(setf (second md) (point))
(set-match-data md)
@@ -63,8 +64,7 @@
(defun slime-search-suppressed-forms (limit)
"Find reader conditionalized forms where the test is false."
(when (and slime-highlight-suppressed-forms
- (slime-connected-p)
- (<= (point) limit))
+ (slime-connected-p))
(condition-case condition
(slime-search-suppressed-forms-internal limit)
(end-of-file ; e.g. #+(
@@ -73,11 +73,11 @@
;; reason; however, there may still be other reader conditionals
;; before `limit'.
(invalid-read-syntax ; e.g. #+#.foo
- (slime-search-suppressed-forms limit))
+ (slime-search-suppressed-forms-internal limit))
(scan-error ; e.g. #| #+(or) #|
- (slime-search-suppressed-forms limit))
+ (slime-search-suppressed-forms-internal limit))
(slime-unknown-feature-expression ; e.g. #+(foo)
- (slime-search-suppressed-forms limit))
+ (slime-search-suppressed-forms-internal limit))
(error
(slime-bug
(concat "Caught error during fontification while searching for forms\n"
@@ -93,22 +93,20 @@
;;; no other intervening sexp, and we check that the reader
;;; conditional is at the same nesting level.
(condition-case nil
- (let ((orig-pt (point)))
- (multiple-value-bind (reader-conditional-pt parser-state)
- (save-excursion
- (when-let (pt (search-backward-regexp slime-reader-conditionals-regexp
- ;; We restrict the search to the
- ;; beginning of the /previous/ defun.
- (save-match-data
- (save-excursion
- (beginning-of-defun) (point)))
- t))
- (values pt (parse-partial-sexp (progn (goto-char (+ pt 2))
- (forward-sexp) ; skip feature expr.
- (point))
- orig-pt))))
- (let ((paren-depth (nth 0 parser-state))
- (last-sexp-pt (nth 2 parser-state)))
+ (let* ((orig-pt (point)))
+ (when-let (reader-conditional-pt
+ (search-backward-regexp slime-reader-conditionals-regexp
+ ;; We restrict the search to the
+ ;; beginning of the /previous/ defun.
+ (save-excursion (beginning-of-defun) (point))
+ t))
+ (let* ((parser-state
+ (parse-partial-sexp (progn (goto-char (+ reader-conditional-pt 2))
+ (forward-sexp) ; skip feature expr.
+ (point))
+ orig-pt))
+ (paren-depth (car parser-state))
+ (last-sexp-pt (caddr parser-state)))
(if (and paren-depth (not (plusp paren-depth)) ; no opening parenthesis in between?
(not last-sexp-pt)) ; no complete sexp in between?
reader-conditional-pt
@@ -127,7 +125,7 @@
;;; to the beginning or end of a toplevel form. So we never miss a
;;; reader-conditional, or point in mid of one.
(defun slime-extend-region-for-font-lock ()
- (when (and slime-highlight-suppressed-forms (slime-connected-p))
+ (when slime-highlight-suppressed-forms
(condition-case c
(let (changedp)
(multiple-value-setq (changedp font-lock-beg font-lock-end)
@@ -140,25 +138,32 @@
"Further: font-lock-beg=%d, font-lock-end=%d.")
c font-lock-beg font-lock-end)))))
+(defun slime-beginning-of-tlf ()
+ (let* ((state (slime-current-parser-state))
+ (depth (nth 0 state)))
+ (if (plusp depth)
+ (up-list (- depth))
+ (when-let (upper-pt (nth 1 state))
+ (goto-char upper-pt)
+ (while (when-let (upper-pt (nth 1 (slime-current-parser-state)))
+ (goto-char upper-pt)))))))
+
(defun slime-compute-region-for-font-lock (orig-beg orig-end)
- (flet ((beginning-of-tlf ()
- (while (when-let (upper-pt (nth 1 (slime-current-parser-state)))
- (goto-char upper-pt)))))
- (let ((beg orig-beg)
- (end orig-end))
- (goto-char beg)
- (beginning-of-tlf)
- (assert (not (plusp (nth 0 (slime-current-parser-state)))))
- (setq beg (or (slime-search-directly-preceding-reader-conditional)
- (point)))
- (goto-char end)
- (when (search-backward-regexp slime-reader-conditionals-regexp beg t)
- ;; Nested reader conditionals, yuck!
- (while (when-let (pt (slime-search-directly-preceding-reader-conditional))
- (goto-char pt)))
- (ignore-errors (slime-forward-reader-conditional))
- (setq end (max end (point))))
- (values (or (/= beg orig-beg) (/= end orig-end)) beg end))))
+ (let ((beg orig-beg)
+ (end orig-end))
+ (goto-char beg)
+ (inline (slime-beginning-of-tlf))
+ (assert (not (plusp (nth 0 (slime-current-parser-state)))))
+ (setq beg (or (slime-search-directly-preceding-reader-conditional)
+ (point)))
+ (goto-char end)
+ (when (search-backward-regexp slime-reader-conditionals-regexp beg t)
+ ;; Nested reader conditionals, yuck!
+ (while (when-let (pt (slime-search-directly-preceding-reader-conditional))
+ (goto-char pt)))
+ (ignore-errors (slime-forward-reader-conditional))
+ (setq end (max end (point))))
+ (values (or (/= beg orig-beg) (/= end orig-end)) beg end)))
(defun slime-activate-font-lock-magic ()
@@ -193,4 +198,12 @@
;;; extend-region hook.
)
-(provide 'slime-fontifying-fu)
\ No newline at end of file
+(provide 'slime-fontifying-fu)
+
+(let ((byte-compile-warnings '()))
+ (mapc #'byte-compile
+ '(slime-extend-region-for-font-lock
+ slime-compute-region-for-font-lock
+ slime-search-directly-preceding-reader-conditional
+ slime-search-suppressed-forms
+ slime-beginning-of-tlf)))
More information about the slime-cvs
mailing list