[slime-cvs] CVS update: slime/slime.el

[Helmut Eller]

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv22293

Modified Files:
	slime.el 
Log Message:
(slime-activate-font-lock-magic): Add support XEmacs.  From Raymond Toy.

Date: Thu Nov 11 23:20:06 2004
Author: heller

Index: slime/slime.el
diff -u slime/slime.el:1.420 slime/slime.el:1.421
--- slime/slime.el:1.420	Tue Nov  9 13:15:44 2004
+++ slime/slime.el	Thu Nov 11 23:20:02 2004
@@ -7030,13 +7030,14 @@
              (slime-connected-p)
 	     (re-search-forward "^\\([^;\n]*[ \t(]\\)?#[-+]" limit t))
     (ignore-errors
-      (let* ((char (char-before))
+      (let* ((start (- (point) 2))
+             (char (char-before))
              (e (read (current-buffer)))
              (val (slime-eval-feature-conditional e)))
         (when (<= (point) limit)
           (if (or (and (eq char ?+) (not val))
                   (and (eq char ?-) val))
-              (let ((start (point)))
+              (progn 
                 (forward-sexp)
                 (assert (<= (point) limit))
                 (let ((md (match-data)))
@@ -7047,14 +7048,19 @@
                   t))
             (slime-search-suppressed-forms limit)))))))
 
-;; XXX add XEmacs compatibility
 (defun slime-activate-font-lock-magic ()
-  (font-lock-add-keywords
-   'lisp-mode
-   '((slime-search-suppressed-forms 0 font-lock-comment-face t))))
+  (if (featurep 'xemacs)
+      (let ((pattern '((slime-search-suppressed-forms
+                        (0 font-lock-comment-face t)))))
+        (dolist (sym '(lisp-font-lock-keywords
+                       lisp-font-lock-keywords-1
+                       lisp-font-lock-keywords-2))
+          (set sym (append (symbol-value sym) pattern))))
+    (font-lock-add-keywords
+     'lisp-mode
+     '((slime-search-suppressed-forms 0 font-lock-comment-face t)))))
 
-(when (and (fboundp 'font-lock-add-keywords)
-           slime-highlight-suppressed-forms)
+(when slime-highlight-suppressed-forms
   (slime-activate-font-lock-magic))