(gnus-test-font-lock-add-keywords): New function.

(gnus-message-add-citation-keywords, gnus-message-remove-citation-keywords):
 Use it; fix the emulating versions of font-lock-add-keywords and
 font-lock-remove-keywords to work with XEmacs correctly.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 39c21d2..f9b44c1 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,11 @@
+2007-02-08  Katsumi Yamaoka  <yamaoka@jpl.org>
+
+       * gnus-cite.el (gnus-test-font-lock-add-keywords): New function.
+       (gnus-message-add-citation-keywords)
+       (gnus-message-remove-citation-keywords): Use it; fix the emulating
+       versions of font-lock-add-keywords and font-lock-remove-keywords to
+       work with XEmacs correctly.
+
 2007-02-07  Katsumi Yamaoka  <yamaoka@jpl.org>
 
        * gnus-cite.el (gnus-cite-face-list): Set the values of

diff --git a/lisp/gnus-cite.el b/lisp/gnus-cite.el
index 115106f..8bb687c 100644 (file)
--- a/lisp/gnus-cite.el
+++ b/lisp/gnus-cite.el
@@ -1160,24 +1160,44 @@ Returns nil if there is no such line before LIMIT, t otherwise."
   "Keywords for highlighting different levels of message citations.")
 
 (eval-when-compile
+  (autoload 'font-lock-add-keywords "font-lock")
+  (autoload 'font-lock-compile-keyword "font-lock")
   (autoload 'font-lock-compile-keywords "font-lock")
-  (defvar font-lock-keywords)
-  (unless (fboundp 'font-lock-add-keywords)
-    (autoload 'font-lock-add-keywords "font-lock"))
-  (unless (fboundp 'font-lock-remove-keywords)
-    (autoload 'font-lock-remove-keywords "font-lock")))
+  (autoload 'font-lock-remove-keywords "font-lock")
+  (defvar font-lock-keywords))
+
+(defun gnus-test-font-lock-add-keywords ()
+  "Return non-nil if `font-lock-add-keywords' seems to work.
+Emacs uses the `(t KEYWORDS COMPILED...)' form for compiled keywords
+while Emacs uses the `(t COMPILED...)' form.  In some version(s) of
+XEmacs, `font-lock-add-keywords' and `font-lock-remove-keywords' assume
+the form of the Emacs style for compiled keywords mistakenly."
+  (if (featurep 'xemacs)
+      (progn
+       (require 'font-lock)
+       (if (fboundp 'font-lock-add-keywords)
+           (let ((default-major-mode 'fundamental-mode))
+             (with-temp-buffer
+               (let ((font-lock-keywords '(t (x) (y)))
+                     font-lock-auto-fontify font-lock-mode-enable-list)
+                 (ignore-errors
+                   (font-lock-add-keywords nil '((z)))
+                   (assq 'y (cdr-safe font-lock-keywords))))))))
+    t))
 
 (defun gnus-message-add-citation-keywords ()
   "Add font-lock for nested citations to current buffer."
-  (if (fboundp 'font-lock-add-keywords)
+  (if (gnus-test-font-lock-add-keywords)
       (font-lock-add-keywords nil gnus-message-citation-keywords 'append)
     (font-lock-set-defaults)
     (let ((was-compiled (eq (car font-lock-keywords) t)))
       (setq font-lock-keywords (copy-sequence (if was-compiled
-                                                 (cadr font-lock-keywords)
+                                                 (cdr font-lock-keywords)
                                                font-lock-keywords)))
       (dolist (keyword gnus-message-citation-keywords)
-       (setq font-lock-keywords (delete keyword font-lock-keywords)))
+       (setq font-lock-keywords
+             (delete (font-lock-compile-keyword keyword)
+                     (delete keyword font-lock-keywords))))
       (let ((old (if (eq (car-safe font-lock-keywords) t)
                     (cdr font-lock-keywords)
                   font-lock-keywords)))
@@ -1188,15 +1208,17 @@ Returns nil if there is no such line before LIMIT, t otherwise."
 
 (defun gnus-message-remove-citation-keywords ()
   "Remove font-lock for nested citations from current buffer."
-  (if (fboundp 'font-lock-remove-keywords)
+  (if (gnus-test-font-lock-add-keywords)
       (font-lock-remove-keywords nil gnus-message-citation-keywords)
     (font-lock-set-defaults)
     (let ((was-compiled (eq (car font-lock-keywords) t)))
       (if was-compiled
-         (setq font-lock-keywords (cadr font-lock-keywords)))
+         (setq font-lock-keywords (cdr font-lock-keywords)))
       (setq font-lock-keywords (copy-sequence font-lock-keywords))
       (dolist (keyword gnus-message-citation-keywords)
-       (setq font-lock-keywords (delete keyword font-lock-keywords)))
+       (setq font-lock-keywords
+             (delete (font-lock-compile-keyword keyword)
+                     (delete keyword font-lock-keywords))))
       (if was-compiled
          (setq font-lock-keywords
                (font-lock-compile-keywords font-lock-keywords))))))