X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-picon.el;h=7f046508321d20459b9e8b9a9bb9816cf95bbf42;hb=754a007c9c67f3506008dab6e7e8943eb51848f2;hp=a6f4ed41c9a9c71ec160fa489ed7ec8c7dbed475;hpb=5e41e8fe689e36563914d967fc9b702502bfebcb;p=gnus

diff --git a/lisp/gnus-picon.el b/lisp/gnus-picon.el
index a6f4ed41c..7f0465083 100644
--- a/lisp/gnus-picon.el
+++ b/lisp/gnus-picon.el
@@ -1,5 +1,5 @@
 ;;; gnus-picon.el --- displaying pretty icons in Gnus
-;; Copyright (C) 1996,97 Free Software Foundation, Inc.
+;; Copyright (C) 1996,97,98 Free Software Foundation, Inc.
 
 ;; Author: Wes Hardaker <hardaker@ece.ucdavis.edu>
 ;; Keywords: news xpm annotation glyph faces
@@ -23,9 +23,6 @@
 
 ;;; Commentary:
 
-;;; TODO:
-;; See the comment in gnus-picons-remove
-
 ;;; Code:
 
 (require 'gnus)
@@ -45,53 +42,61 @@ depending on what gnus-picons-display-where is set to.  You must
 also add gnus-article-display-picons to gnus-article-display-hook."
   :group 'gnus-visual)
 
-(defcustom gnus-picons-buffer "*Icon Buffer*"
-  "Buffer name to display the icons in if gnus-picons-display-where is 'picons."
-  :type 'string
-  :group 'picons)
-
 (defcustom gnus-picons-display-where 'picons
   "Where to display the group and article icons.
 Legal values are `article' and `picons'."
   :type '(choice symbol string)
   :group 'picons)
 
+(defcustom gnus-picons-has-modeline-p t
+  "*Whether the picons window should have a modeline.
+This is only useful if `gnus-picons-display-where' is `picons'."
+  :type 'boolean
+  :group 'picons)
+
 (defcustom gnus-picons-database "/usr/local/faces"
-  "Defines the location of the faces database.
+  "*Defines the location of the faces database.
 For information on obtaining this database of pretty pictures, please
 see http://www.cs.indiana.edu/picons/ftp/index.html"
   :type 'directory
   :group 'picons)
 
-(defcustom gnus-picons-news-directory "news"
-  "Sub-directory of the faces database containing the icons for newsgroups."
-  :type 'string
+(defcustom gnus-picons-news-directories '("news")
+  "*List of directories to search for newsgroups faces."
+  :type '(repeat string)
   :group 'picons)
+(define-obsolete-variable-alias 'gnus-picons-news-directory
+  'gnus-picons-news-directories)
 
 (defcustom gnus-picons-user-directories '("local" "users" "usenix" "misc")
-  "List of directories to search for user faces."
+  "*List of directories to search for user faces."
   :type '(repeat string)
   :group 'picons)
 
 (defcustom gnus-picons-domain-directories '("domains")
-  "List of directories to search for domain faces.
+  "*List of directories to search for domain faces.
 Some people may want to add \"unknown\" to this list."
   :type '(repeat string)
   :group 'picons)
 
 (defcustom gnus-picons-refresh-before-display nil
-  "If non-nil, display the article buffer before computing the picons."
+  "*If non-nil, display the article buffer before computing the picons."
   :type 'boolean
   :group 'picons)
 
+(defcustom gnus-picons-group-excluded-groups nil
+  "*If this regexp matches the group name, group picons will be disabled."
+  :type 'regexp
+  :group 'picons)
+
 (defcustom gnus-picons-x-face-file-name
   (format "/tmp/picon-xface.%s.xbm" (user-login-name))
-  "The name of the file in which to store the converted X-face header."
+  "*The name of the file in which to store the converted X-face header."
   :type 'string
   :group 'picons)
 
 (defcustom gnus-picons-convert-x-face (format "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | pbmtoxbm > %s" gnus-picons-x-face-file-name)
-  "Command to convert the x-face header into a xbm file."
+  "*Command to convert the x-face header into a xbm file."
   :type 'string
   :group 'picons)
 
@@ -108,7 +113,7 @@ Some people may want to add \"unknown\" to this list."
       (when (featurep 'xpm)
 	(push "xpm" types))
       types))
-  "List of suffixes on picon file names to try."
+  "*List of suffixes on picon file names to try."
   :type '(repeat string)
   :group 'picons)
 
@@ -130,7 +135,7 @@ Otherwise the cache will be cleared every time you exit Gnus."
 
 (defcustom gnus-picons-piconsearch-url nil
   "*The url to query for picons.  Setting this to nil will disable it.
-The only plublicly available address currently known is
+The only publicly available address currently known is
 http://www.cs.indiana.edu:800/piconsearch.  If you know of any other,
 please tell me so that we can list it."
   :type '(choice (const :tag "Disable" :value nil)
@@ -139,6 +144,10 @@ please tell me so that we can list it."
 		 (string))
   :group 'picons)
 
+(defface gnus-picons-xbm-face '((t (:foreground "black" :background "white")))
+  "Face to show X face"
+  :group 'picons)
+
 ;;; Internal variables:
 
 (defvar gnus-picons-processes-alist nil
@@ -150,17 +159,6 @@ List of pairs (KEY . GLYPH) where KEY is either a filename or an URL.")
   "Picons file names cache.
 List of pairs (KEY . NAME) where KEY is (USER HOST DBS) and NAME is an URL.")
 
-(defvar gnus-group-annotations nil
-  "List of annotations added/removed when selecting/exiting a group")
-(defvar gnus-group-annotations-lock nil)
-(defvar gnus-article-annotations nil
-  "List of annotations added/removed when selecting an article")
-(defvar gnus-article-annotations-lock nil)
-(defvar gnus-x-face-annotations nil
-  "List of annotations added/removed when selecting an article with an
-X-Face.")
-(defvar gnus-x-face-annotations-lock nil)
-
 (defvar gnus-picons-jobs-alist nil
   "List of jobs that still need be done.
 This is a list of (SYM-ANN TAG ARGS...) where SYM-ANN three annotations list,
@@ -173,37 +171,16 @@ arguments necessary for the job.")
 
 ;;; Functions:
 
-(defsubst gnus-picons-lock (symbol)
-  (intern (concat (symbol-name symbol) "-lock")))
-
-(defun gnus-picons-remove (symbol)
-  "Remove all annotations in variable named SYMBOL.
-This function is careful to set it to nil before removing anything so that
-asynchronous process don't get crazy."
-  ;; clear the lock
-  (set (gnus-picons-lock symbol) nil)
-  ;; clear all annotations
-  (mapc (function (lambda (item)
-		    (if (annotationp item)
-			(delete-annotation item))))
-	(prog1 (symbol-value symbol)
-	  (set symbol nil)))
-  ;; FIXME: there's a race condition here.  If a job is already
-  ;; running, it has already removed itself from this queue...  But
-  ;; will still display its picon.
-  ;; TODO: push a request to clear an annotation.  Then
-  ;; gnus-picons-next-job will be able to clean up when it gets the
-  ;; hand
-  (setq gnus-picons-jobs-alist (remassq symbol gnus-picons-jobs-alist)))
-
 (defun gnus-picons-remove-all ()
   "Removes all picons from the Gnus display(s)."
   (interactive)
-  (gnus-picons-remove 'gnus-article-annotations)
-  (gnus-picons-remove 'gnus-group-annotations)
-  (gnus-picons-remove 'gnus-x-face-annotations)
-  (when (bufferp gnus-picons-buffer)
-    (kill-buffer gnus-picons-buffer)))
+  (map-extents (function (lambda (ext unused) (delete-annotation ext) nil))
+	       nil nil nil nil nil 'gnus-picon)
+  (setq gnus-picons-jobs-alist '())
+  ;; notify running job that it may have been preempted
+  (if (and (listp gnus-picons-job-already-running)
+	   gnus-picons-job-already-running)
+      (setq gnus-picons-job-already-running t)))
 
 (defun gnus-get-buffer-name (variable)
   "Returns the buffer name associated with the contents of a variable."
@@ -214,46 +191,49 @@ asynchronous process don't get crazy."
 				    ((stringp newvar) newvar))))
         ((stringp variable) variable)))
 
-(defun gnus-picons-prepare-for-annotations (annotations)
-  "Prepare picons buffer for puting annotations memorized in ANNOTATIONS.
-ANNOTATIONS should be a symbol naming a variable wich contains a list of
-annotations.  Sets buffer to `gnus-picons-display-where'."
-  ;; let drawing catch up
-  (when gnus-picons-refresh-before-display
-    (sit-for 0))
-  (set-buffer (get-buffer-create
-	       (gnus-get-buffer-name gnus-picons-display-where)))
+(defun gnus-picons-set-buffer ()
+  (set-buffer
+   (get-buffer-create (gnus-get-buffer-name gnus-picons-display-where)))
   (gnus-add-current-to-buffer-list)
   (goto-char (point-min))
   (if (and (eq gnus-picons-display-where 'article)
 	   gnus-picons-display-article-move-p)
-      (when (search-forward "\n\n" nil t)
-	(forward-line -1))
-    (make-local-variable 'inhibit-read-only)
-    (setq buffer-read-only t
-	  inhibit-read-only nil))
-  (gnus-picons-remove annotations))
+      (if (search-forward "\n\n" nil t)
+	  (forward-line -1)
+	(goto-char (point-max)))
+    (setq buffer-read-only t)
+    (unless gnus-picons-has-modeline-p
+      (set-specifier has-modeline-p
+		     (list (list (current-buffer)
+				 (cons nil gnus-picons-has-modeline-p)))))))
+
+(defun gnus-picons-prepare-for-annotations ()
+  "Prepare picons buffer for putting annotations."
+  ;; let drawing catch up
+  (when gnus-picons-refresh-before-display
+    (sit-for 0))
+  (gnus-picons-set-buffer)
+  (gnus-picons-remove-all))
+
+(defun gnus-picons-make-annotation (&rest args)
+  (let ((annot (apply 'make-annotation args)))
+    (set-extent-property annot 'gnus-picon t)
+    (set-extent-property annot 'duplicable t)
+    annot))
 
 (defun gnus-picons-article-display-x-face ()
   "Display the x-face header bitmap in the 'gnus-picons-display-where buffer."
-  ;; delete any old ones.
-  ;; This is needed here because gnus-picons-display-x-face will not
-  ;; be called if there is no X-Face header
-  (gnus-picons-remove 'gnus-x-face-annotations)
-  ;; display the new one.
   (let ((gnus-article-x-face-command 'gnus-picons-display-x-face))
     (gnus-article-display-x-face)))
 
 (defun gnus-picons-x-face-sentinel (process event)
-  (let* ((env (assq process gnus-picons-processes-alist))
-	 (annot (cdr env)))
-    (setq gnus-picons-processes-alist (remassq process
-					       gnus-picons-processes-alist))
-    (when annot
-      (set-annotation-glyph annot
-			    (make-glyph gnus-picons-x-face-file-name))
-      (if (memq annot gnus-x-face-annotations)
-	  (delete-file gnus-picons-x-face-file-name)))))
+  (when (memq process gnus-picons-processes-alist)
+    (setq gnus-picons-processes-alist
+	  (delq process gnus-picons-processes-alist))
+    (gnus-picons-set-buffer)
+    (gnus-picons-make-annotation (make-glyph gnus-picons-x-face-file-name)
+				 nil 'text)
+    (delete-file gnus-picons-x-face-file-name)))
 
 (defun gnus-picons-display-x-face (beg end)
   "Function to display the x-face header in the picons window.
@@ -261,33 +241,24 @@ To use:  (setq gnus-article-x-face-command 'gnus-picons-display-x-face)"
   (interactive)
   (if (featurep 'xface)
       ;; Use builtin support
-      (let ((buf (current-buffer)))
-	(save-excursion
-	  (gnus-picons-prepare-for-annotations 'gnus-x-face-annotations)
-	  (setq gnus-x-face-annotations
-		(cons (make-annotation
-		       (vector 'xface
-			       :data (concat "X-Face: "
-					     (buffer-substring beg end buf)))
-				       nil 'text)
-		      gnus-x-face-annotations))))
+      (save-excursion
+	(gnus-picons-set-buffer)
+	(gnus-picons-make-annotation
+	 (vector 'xface
+		 :data (concat "X-Face: " (buffer-substring beg end)))
+	 nil 'text))
     ;; convert the x-face header to a .xbm file
     (let* ((process-connection-type nil)
-	   (annot (save-excursion
-		    (gnus-picons-prepare-for-annotations
-		     'gnus-x-face-annotations)
-		    (make-annotation nil nil 'text)))
 	   (process (start-process-shell-command "gnus-x-face" nil 
 						 gnus-picons-convert-x-face)))
-      (push annot gnus-x-face-annotations)
-      (push (cons process annot) gnus-picons-processes-alist)
+      (push process gnus-picons-processes-alist)
       (process-kill-without-query process)
       (set-process-sentinel process 'gnus-picons-x-face-sentinel)
       (process-send-region process beg end)
       (process-send-eof process))))
 
 (defun gnus-article-display-picons ()
-  "Display faces for an author and his/her domain in gnus-picons-display-where."
+  "Display faces for an author and her domain in gnus-picons-display-where."
   (interactive)
   (let (from at-idx)
     (when (and (featurep 'xpm)
@@ -305,55 +276,57 @@ To use:  (setq gnus-article-x-face-command 'gnus-picons-display-x-face)"
 			     (message-tokenize-header gnus-local-domain "."))
 		       (message-tokenize-header (substring from (1+ at-idx))
 						"."))))
-	  (gnus-picons-prepare-for-annotations 'gnus-article-annotations)
+	  (gnus-picons-prepare-for-annotations)
+	  (gnus-group-display-picons)
 	  (if (null gnus-picons-piconsearch-url)
-	      (setq gnus-article-annotations
-		    (nconc gnus-article-annotations
-			   (gnus-picons-display-pairs
-			    (gnus-picons-lookup-pairs
-			     addrs gnus-picons-domain-directories)
-			    (not (or gnus-picons-display-as-address
-				     gnus-article-annotations))
-			    "." t)
-			   (if (and gnus-picons-display-as-address addrs)
-			       (list (make-annotation [string :data "@"] nil
-						      'text nil nil nil t)))
-			   (gnus-picons-display-picon-or-name
-			    (gnus-picons-lookup-user username addrs)
-			    username t)))
+	      (progn
+		(gnus-picons-display-pairs (gnus-picons-lookup-pairs
+					    addrs
+					    gnus-picons-domain-directories)
+					   gnus-picons-display-as-address
+					   "." t)
+		(if (and gnus-picons-display-as-address addrs)
+		    (gnus-picons-make-annotation
+		     [string :data "@"] nil 'text nil nil nil t))
+		(gnus-picons-display-picon-or-name
+		 (gnus-picons-lookup-user username addrs)
+		 username t))
 	    (push (list 'gnus-article-annotations 'search username addrs
 			gnus-picons-domain-directories t)
 		  gnus-picons-jobs-alist)
-	    (gnus-picons-next-job))
-
-	  (add-hook 'gnus-summary-exit-hook 'gnus-picons-remove-all))))))
+	    (gnus-picons-next-job)))))))
 
 (defun gnus-group-display-picons ()
-  "Display icons for the group in the gnus-picons-display-where buffer."
+  "Display icons for the group in the `gnus-picons-display-where' buffer."
   (interactive)
   (when (and (featurep 'xpm)
-	     (or (not (fboundp 'device-type)) (equal (device-type) 'x)))
+	     (or (not (fboundp 'device-type)) (equal (device-type) 'x))
+	     (or (null gnus-picons-group-excluded-groups)
+		 (not (string-match gnus-picons-group-excluded-groups
+				    gnus-newsgroup-name))))
     (save-excursion
-      (gnus-picons-prepare-for-annotations 'gnus-group-annotations)
+      (gnus-picons-prepare-for-annotations)
       (if (null gnus-picons-piconsearch-url)
-	  (setq gnus-group-annotations
-		(gnus-picons-display-pairs
-		 (gnus-picons-lookup-pairs (reverse (message-tokenize-header
-						     gnus-newsgroup-name "."))
-					   gnus-picons-news-directory)
-		 t "."))
+	  (gnus-picons-display-pairs
+		 (gnus-picons-lookup-pairs
+		  (reverse (message-tokenize-header
+			    (gnus-group-real-name gnus-newsgroup-name) 
+			    "."))
+		  gnus-picons-news-directories)
+		 t ".")
 	(push (list 'gnus-group-annotations 'search nil
-		    (message-tokenize-header gnus-newsgroup-name ".")
-		    (if (listp gnus-picons-news-directory)
-			gnus-picons-news-directory
-		      (list gnus-picons-news-directory))
+		    (message-tokenize-header 
+		     (gnus-group-real-name gnus-newsgroup-name) ".")
+		    (if (listp gnus-picons-news-directories)
+			gnus-picons-news-directories
+		      (list gnus-picons-news-directories))
 		    nil)
 	      gnus-picons-jobs-alist)
 	(gnus-picons-next-job))
 
       (add-hook 'gnus-summary-exit-hook 'gnus-picons-remove-all))))
 
-(defsubst gnus-picons-lookup-internal (addrs dir)
+(defun gnus-picons-lookup-internal (addrs dir)
   (setq dir (expand-file-name dir gnus-picons-database))
   (gnus-picons-try-face (dolist (part (reverse addrs) dir)
 			  (setq dir (expand-file-name part dir)))))
@@ -404,40 +377,29 @@ none, and whose CDR is the corresponding element of DOMAINS."
 
 (defun gnus-picons-display-picon-or-name (picon name &optional right-p)
   (cond (picon (gnus-picons-display-glyph picon name right-p))
-	(gnus-picons-display-as-address (list (make-annotation
+	(gnus-picons-display-as-address (list (gnus-picons-make-annotation
 					       (vector 'string :data name)
 					       nil 'text
 					       nil nil nil right-p)))))
 
 (defun gnus-picons-display-pairs (pairs &optional bar-p dot-p right-p)
   "Display picons in list PAIRS."
-  (let ((bar (and bar-p (or gnus-picons-display-as-address
-			    (annotations-in-region (point)
-						   (min (point-max)
-							(1+ (point)))
-						   (current-buffer)))))
-	(domain-p (and gnus-picons-display-as-address dot-p))
+  (let ((domain-p (and gnus-picons-display-as-address dot-p))
 	pair picons)
-    (while pairs
-      (setq pair (pop pairs)
-	    picons (nconc (if (and domain-p picons (not right-p))
-			      (list (make-annotation
+    (when (and bar-p domain-p right-p)
+      (setq picons (gnus-picons-display-glyph
+		    (let ((gnus-picons-file-suffixes '("xbm")))
+		      (gnus-picons-try-face
+		       gnus-xmas-glyph-directory "bar."))
+		    nil right-p)))
+    (while (setq pair (pop pairs))
+      (setq picons (nconc picons
+			  (gnus-picons-display-picon-or-name
+			   (car pair) (cadr pair) right-p)
+			  (if (and domain-p pairs)
+			      (list (gnus-picons-make-annotation
 				     (vector 'string :data dot-p)
-				     nil 'text nil nil nil right-p)))
-			  (gnus-picons-display-picon-or-name (car pair)
-							     (cadr pair)
-							     right-p)
-			  (if (and domain-p pairs right-p)
-			      (list (make-annotation
-				     (vector 'string :data dot-p)
-				     nil 'text nil nil nil right-p)))
-			  (when (and bar domain-p)
-			    (setq bar nil)
-			    (gnus-picons-display-glyph
-			     (gnus-picons-try-face gnus-xmas-glyph-directory
-						   "bar.")
-			     nil t))
-			  picons)))
+				     nil 'text nil nil nil right-p))))))
     picons))
 
 (defun gnus-picons-try-face (dir &optional filebase)
@@ -446,28 +408,32 @@ none, and whose CDR is the corresponding element of DOMAINS."
 	 (key (concat dir filebase))
 	 (glyph (cdr (assoc key gnus-picons-glyph-alist)))
 	 (suffixes gnus-picons-file-suffixes)
-	 f)
-    (while (and suffixes (null glyph))
-      (when (file-exists-p (setq f (expand-file-name (concat filebase
-								 (pop suffixes))
-							 dir)))
-	(setq glyph (make-glyph f))
+	 f suf)
+    (while (setq suf (pop suffixes))
+      (when (file-exists-p (setq f (expand-file-name
+				    (concat filebase suf)
+				    dir)))
+	(setq suffixes nil
+	      glyph (make-glyph f))
+	(when (equal suf "xbm")
+	  (set-glyph-face glyph 'gnus-picons-xbm-face))
 	(push (cons key glyph) gnus-picons-glyph-alist)))
     glyph))
 
 (defun gnus-picons-display-glyph (glyph &optional part rightp)
-  (let ((new (make-annotation glyph (point) 'text nil nil nil rightp)))
+  (let ((new (gnus-picons-make-annotation
+	      glyph (point) 'text nil nil nil rightp)))
     (when (and part gnus-picons-display-as-address)
-      (set-annotation-data new (cons new
-				     (make-glyph (vector 'string :data part))))
+      (set-annotation-data
+       new (cons new (make-glyph (vector 'string :data part))))
       (set-annotation-action new 'gnus-picons-action-toggle))
     (nconc
      (list new)
      (if (and (eq major-mode 'gnus-article-mode)
 	      (not gnus-picons-display-as-address)
 	      (not part))
-	 (list (make-annotation [string :data " "]
-				(point) 'text nil nil nil rightp))))))
+	 (list (gnus-picons-make-annotation [string :data " "] (point)
+					    'text nil nil nil rightp))))))
 
 (defun gnus-picons-action-toggle (data)
   "Toggle annotation"
@@ -480,7 +446,8 @@ none, and whose CDR is the corresponding element of DOMAINS."
 (defun gnus-picons-clear-cache ()
   "Clear the picons cache"
   (interactive)
-  (setq gnus-picons-glyph-alist nil))
+  (setq gnus-picons-glyph-alist nil
+	gnus-picons-url-alist nil))
 
 (gnus-add-shutdown 'gnus-picons-close 'gnus)
 
@@ -497,14 +464,13 @@ none, and whose CDR is the corresponding element of DOMAINS."
 (defun gnus-picons-url-retrieve (url fn arg)
   (let ((old-asynch (default-value 'url-be-asynchronous))
 	(url-working-buffer (generate-new-buffer " *picons*"))
-	(url-request-method nil)
 	(url-package-name "Gnus")
-	(url-package-version gnus-version-number))
+	(url-package-version gnus-version-number)
+	url-request-method)
     (setq-default url-be-asynchronous t)
     (save-excursion
       (set-buffer url-working-buffer)
       (setq url-be-asynchronous t
-	    url-show-status nil
 	    url-current-callback-data arg
 	    url-current-callback-func fn)
       (url-retrieve url t))
@@ -588,10 +554,8 @@ none, and whose CDR is the corresponding element of DOMAINS."
 ;;; picon network display functions :
 
 (defun gnus-picons-network-display-internal (sym-ann glyph part right-p)
-  (set-buffer
-   (get-buffer-create (gnus-get-buffer-name gnus-picons-display-where)))
-  (set sym-ann (nconc (symbol-value sym-ann)
-		      (gnus-picons-display-picon-or-name glyph part right-p)))
+  (gnus-picons-set-buffer)
+  (gnus-picons-display-picon-or-name glyph part right-p)
   (gnus-picons-next-job-internal))
 
 (defun gnus-picons-network-display-callback (url part sym-ann right-p)
@@ -599,7 +563,11 @@ none, and whose CDR is the corresponding element of DOMAINS."
 						   w3-image-mappings)))))
     (kill-buffer (current-buffer))
     (push (cons url glyph) gnus-picons-glyph-alist)
-    (gnus-picons-network-display-internal sym-ann glyph part right-p)))
+    ;; only do the job if it has not been preempted.
+    (if (equal gnus-picons-job-already-running
+	       (list sym-ann 'picon url part right-p))
+	(gnus-picons-network-display-internal sym-ann glyph part right-p)
+      (gnus-picons-next-job-internal))))
 
 (defun gnus-picons-network-display (url part sym-ann right-p)
   (let ((cache (assoc url gnus-picons-glyph-alist)))
@@ -665,8 +633,16 @@ none, and whose CDR is the corresponding element of DOMAINS."
       (if (and gnus-picons-display-as-address new-jobs)
 	  (push (list sym-ann "@" right-p) new-jobs))
       (push (list sym-ann 'picon (cdr cache) user right-p) new-jobs))
-    (setq gnus-picons-jobs-alist (nconc (nreverse new-jobs)
-					gnus-picons-jobs-alist))
+    (if (and gnus-picons-display-as-address (not right-p))
+	(push (list sym-ann 'bar right-p) new-jobs))
+    ;; only put the jobs in the queue if this job has not been preempted.
+    (if (equal gnus-picons-job-already-running
+	       (list sym-ann 'search user addrs dbs right-p))
+	(setq gnus-picons-jobs-alist
+	      (nconc (if (and gnus-picons-display-as-address right-p)
+			 (list (list sym-ann 'bar right-p)))
+		     (nreverse new-jobs)
+		     gnus-picons-jobs-alist)))
     (gnus-picons-next-job-internal)))
 
 (defun gnus-picons-network-search-callback (user addrs dbs sym-ann right-p)
@@ -674,6 +650,7 @@ none, and whose CDR is the corresponding element of DOMAINS."
 				       (prog1 (gnus-picons-parse-filenames)
 					 (kill-buffer (current-buffer)))))
 
+;; Initiate a query on the picon database
 (defun gnus-picons-network-search (user addrs dbs sym-ann right-p)
   (let* ((host (mapconcat 'identity addrs "."))
 	 (key (list (or user "unknown") host (if user
@@ -696,31 +673,35 @@ none, and whose CDR is the corresponding element of DOMAINS."
       (gnus-picons-network-search-internal user addrs dbs sym-ann right-p))))
 
 ;;; Main jobs dispatcher function
-;; Given that XEmacs is not really multi threaded, this locking should
-;; be sufficient
 
 (defun gnus-picons-next-job-internal ()
-  (if gnus-picons-jobs-alist
-      (let* ((job (pop gnus-picons-jobs-alist))
+  (if (setq gnus-picons-job-already-running (pop gnus-picons-jobs-alist))
+      (let* ((job gnus-picons-job-already-running)
 	     (sym-ann (pop job))
 	     (tag (pop job)))
 	(if tag
 	    (cond ((stringp tag);; (SYM-ANN "..." RIGHT-P)
 		   (gnus-picons-network-display-internal sym-ann nil tag
 							 (pop job)))
+		  ((eq 'bar tag)
+		   (gnus-picons-network-display-internal
+		    sym-ann
+		    (let ((gnus-picons-file-suffixes '("xbm")))
+		      (gnus-picons-try-face
+		       gnus-xmas-glyph-directory "bar."))
+		    nil (pop job)))
 		  ((eq 'search tag);; (SYM-ANN 'search USER ADDRS DBS RIGHT-P)
 		   (gnus-picons-network-search
 		    (pop job) (pop job) (pop job) sym-ann (pop job)))
 		  ((eq 'picon tag);; (SYM-ANN 'picon URL PART RIGHT-P)
 		   (gnus-picons-network-display
 		    (pop job) (pop job) sym-ann (pop job)))
-		  (t (error "Unknown picon job tag %s" tag)))))
-    (setq gnus-picons-job-already-running nil)))
+		  (t (setq gnus-picons-job-already-running nil)
+		     (error "Unknown picon job tag %s" tag)))))))
 
 (defun gnus-picons-next-job ()
-  "Start processing the job queue."
+  "Start processing the job queue if it is not in progress"
   (unless gnus-picons-job-already-running
-    (setq gnus-picons-job-already-running t)
     (gnus-picons-next-job-internal)))
 
 (provide 'gnus-picon)