Synch to Oort Gnus.
authoryamaoka <yamaoka>
Thu, 13 Feb 2003 00:37:27 +0000 (00:37 +0000)
committeryamaoka <yamaoka>
Thu, 13 Feb 2003 00:37:27 +0000 (00:37 +0000)
lisp/ChangeLog
lisp/gnus-art.el
lisp/gnus-util.el

index 121ed5f..5c7b65b 100644 (file)
@@ -1,3 +1,10 @@
+2003-02-13  Katsumi Yamaoka  <yamaoka@jpl.org>
+
+       * gnus-art.el (gnus-article-only-boring-p): Make sure that the
+       gnus-article-boring-faces variable is bound; use gnus-faces-at.
+
+       * gnus-util.el (gnus-faces-at): New macro.
+
 2003-02-13  Michael Shields  <shields@msrl.com>
 
        * gnus-cite.el
index 53394c2..40cb604 100644 (file)
@@ -5129,19 +5129,15 @@ Argument LINES specifies lines to be scrolled down."
 Something \"interesting\" is a word of at least two letters that does
 not have a face in `gnus-article-boring-faces'."
   (when (and gnus-article-skip-boring
-            gnus-article-boring-faces)
+            (boundp 'gnus-article-boring-faces)
+            (symbol-value 'gnus-article-boring-faces))
     (save-excursion
       (catch 'only-boring
        (while (re-search-forward "\\b\\w\\w" nil t)
          (forward-char -1)
          (when (not (gnus-intersection
-                     (cons (plist-get (text-properties-at (point))
-                                      'face)
-                           (mapcar-extents
-                            '(lambda (extent)
-                               (extent-property extent 'face))
-                            nil (current-buffer) (point) (point)))
-                     gnus-article-boring-faces))
+                     (gnus-faces-at (point))
+                     (symbol-value 'gnus-article-boring-faces)))
            (throw 'only-boring nil)))
        (throw 'only-boring t)))))
 
index 551f264..6bd573d 100644 (file)
@@ -744,6 +744,24 @@ and `print-level' to nil."
           b (setq b (next-single-property-change b 'gnus-face nil end))
           prop val))))))
 
+(defmacro gnus-faces-at (pos)
+  "Return a list of faces at POS."
+  (if (featurep 'xemacs)
+      `(let* ((pos ,pos)
+             (faces (list (get-text-property pos 'face))))
+        (mapcar-extents
+         (lambda (extent)
+           (pushnew (extent-property extent 'face) faces))
+         nil (current-buffer) pos pos)
+        (delq nil faces))
+    `(let* ((pos ,pos)
+           (faces (list (get-text-property pos 'face)))
+           (overlays (overlays-at pos)))
+       (while overlays
+        (pushnew (plist-get (overlay-properties (pop overlays)) 'face)
+                 faces))
+       (delq nil faces))))
+
 ;;; Protected and atomic operations.  dmoore@ucsd.edu 21.11.1996
 ;;; The primary idea here is to try to protect internal datastructures
 ;;; from becoming corrupted when the user hits C-g, or if a hook or