X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus-picon.el;h=9a4c9ba4f28529ca56adf55b731356e4ff195b1f;hb=8d5b94488b8fe507a83eb5475ecaa54afb8a98b8;hp=02916903d69a8ccdad01ff55f971d5ed56dadec9;hpb=ddc5d2abd802f4d56406bf2d9aa978e10be92838;p=elisp%2Fgnus.git-

diff --git a/lisp/gnus-picon.el b/lisp/gnus-picon.el
index 0291690..9a4c9ba 100644
--- a/lisp/gnus-picon.el
+++ b/lisp/gnus-picon.el
@@ -1,5 +1,7 @@
 ;;; gnus-picon.el --- displaying pretty icons in Gnus
-;; Copyright (C) 1996,97,98 Free Software Foundation, Inc.
+
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000
+;;      Free Software Foundation, Inc.
 
 ;; Author: Wes Hardaker <hardaker@ece.ucdavis.edu>
 ;; Keywords: news xpm annotation glyph faces
@@ -25,8 +27,10 @@
 
 ;;; Code:
 
+(eval-when-compile (require 'cl))
+
 (require 'gnus)
-(require 'xpm)
+;; (require 'xpm)
 (require 'annotations)
 (require 'custom)
 (require 'gnus-art)
@@ -36,15 +40,13 @@
 
 (defgroup picons nil
   "Show pictures of people, domains, and newsgroups (XEmacs).
-For this to work, you must add gnus-group-display-picons to the
-gnus-summary-display-hook or to the gnus-article-display-hook
-depending on what gnus-picons-display-where is set to.  You must
-also add gnus-article-display-picons to gnus-article-display-hook."
+For this to work, you must switch on the `gnus-treat-display-picons'
+variable."
   :group 'gnus-visual)
 
 (defcustom gnus-picons-display-where 'picons
   "Where to display the group and article icons.
-Legal values are `article' and `picons'."
+Valid values are `article' and `picons'."
   :type '(choice symbol string)
   :group 'picons)
 
@@ -89,17 +91,6 @@ Some people may want to add \"unknown\" to this list."
   :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."
-  :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."
-  :type 'string
-  :group 'picons)
-
 (defcustom gnus-picons-display-as-address t
   "*If t display textual email addresses along with pictures."
   :type 'boolean
@@ -109,15 +100,15 @@ Some people may want to add \"unknown\" to this list."
   (when (featurep 'x)
     (let ((types (list "xbm")))
       (when (featurep 'gif)
-	(push "gif" types))
+	(setq types (cons "gif" types)))
       (when (featurep 'xpm)
-	(push "xpm" types))
+	(setq types (cons "xpm" types)))
       types))
   "*List of suffixes on picon file names to try."
   :type '(repeat string)
   :group 'picons)
 
-(defcustom gnus-picons-display-article-move-p t
+(defcustom gnus-picons-display-article-move-p nil
   "*Whether to move point to first empty line when displaying picons.
 This has only an effect if `gnus-picons-display-where' has value `article'."
   :type 'boolean
@@ -145,11 +136,21 @@ please tell me so that we can list it."
   :group 'picons)
 
 (defface gnus-picons-xbm-face '((t (:foreground "black" :background "white")))
-  "Face to show X face"
+  "Face to show xbm picons in."
   :group 'picons)
 
+(defface gnus-picons-face '((t (:foreground "black" :background "white")))
+  "Face to show picons in."
+  :group 'picons)
+
+(defcustom gnus-picons-setup-hook nil
+  "Hook run in Picons buffers."
+  :group 'picons
+  :type 'hook)
+
 ;;; Internal variables:
 
+(defvar gnus-picons-setup-p nil)
 (defvar gnus-picons-processes-alist nil
   "Picons processes currently running and their environment.")
 (defvar gnus-picons-glyph-alist nil
@@ -184,9 +185,9 @@ arguments necessary for the job.")
 
 (defun gnus-get-buffer-name (variable)
   "Returns the buffer name associated with the contents of a variable."
-  (let ((buf (get-buffer-create (gnus-window-to-buffer-helper
-				 (cdr 
-				  (assq variable gnus-window-to-buffer))))))
+  (let ((buf (gnus-get-buffer-create
+	      (gnus-window-to-buffer-helper
+	       (cdr (assq variable gnus-window-to-buffer))))))
     (and buf
 	 (buffer-name buf))))
 
@@ -203,18 +204,22 @@ arguments necessary for the job.")
 
 (defun gnus-picons-kill-buffer ()
   (let ((buf (get-buffer (gnus-picons-buffer-name))))
-    (if (buffer-live-p buf)
-	(kill-buffer buf))))
+    (when (and (buffer-live-p buf)
+	       (string-match "Picons" (buffer-name buf)))
+      (kill-buffer buf))))
 
 (defun gnus-picons-setup-buffer ()
   (let ((name (gnus-picons-buffer-name)))
     (save-excursion
-      (if (get-buffer name)
+      (if (and (get-buffer name)
+	       (with-current-buffer name
+		 gnus-picons-setup-p))
 	  (set-buffer name)
-	(set-buffer (get-buffer-create name))
+	(set-buffer (gnus-get-buffer-create name))
 	(buffer-disable-undo)
 	(setq buffer-read-only t)
-	(gnus-add-current-to-buffer-list)
+	(run-hooks 'gnus-picons-setup-hook)
+	(set (make-local-variable 'gnus-picons-setup-p) t)
 	(add-hook 'gnus-summary-prepare-exit-hook 'gnus-picons-kill-buffer))
       (current-buffer))))
 
@@ -246,48 +251,6 @@ arguments necessary for the job.")
     (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."
-  (let ((gnus-article-x-face-command 'gnus-picons-display-x-face))
-    (gnus-article-display-x-face)))
-
-(defun gnus-picons-x-face-sentinel (process event)
-  (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)
-    (when (file-exists-p gnus-picons-x-face-file-name)
-      (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.
-To use:  (setq gnus-article-x-face-command 'gnus-picons-display-x-face)"
-  (interactive)
-  (if (featurep 'xface)
-      ;; Use builtin support
-      (save-excursion
-	;; Don't remove this binding, it is really needed: when
-	;; `gnus-picons-set-buffer' changes buffer (like when it is
-	;; set to display picons outside of the article buffer), BEG
-	;; and END still refer the buffer current now !
-	(let ((buf (current-buffer)))
-	  (gnus-picons-set-buffer)
-	  (gnus-picons-make-annotation
-	   (vector 'xface
-		   :data (concat "X-Face: " (buffer-substring beg end buf)))
-	   nil 'text nil nil nil t)))
-    ;; convert the x-face header to a .xbm file
-    (let* ((process-connection-type nil)
-	   (process (start-process-shell-command "gnus-x-face" nil 
-						 gnus-picons-convert-x-face)))
-      (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 her domain in gnus-picons-display-where."
   (interactive)
@@ -310,6 +273,14 @@ To use:  (setq gnus-article-x-face-command 'gnus-picons-display-x-face)"
 						"."))))
 	  (gnus-picons-prepare-for-annotations)
 	  (gnus-group-display-picons)
+	  (unless gnus-picons-display-article-move-p
+	    (let ((buffer-read-only nil)
+		  (case-fold-search t))
+	      (when (re-search-forward "^From *: *" nil t)
+		(when (search-forward from (gnus-point-at-eol) t)
+		  (gnus-put-text-property
+		   (match-beginning 0) (match-end 0)
+		   'invisible t)))))
 	  (if (null gnus-picons-piconsearch-url)
 	      (progn
 		(gnus-picons-display-pairs (gnus-picons-lookup-pairs
@@ -324,7 +295,7 @@ To use:  (setq gnus-article-x-face-command 'gnus-picons-display-x-face)"
 		 (gnus-picons-lookup-user username addrs)
 		 username t))
 	    (push (list 'gnus-article-annotations 'search username addrs
-			gnus-picons-domain-directories t)
+			gnus-picons-domain-directories t (point-marker))
 		  gnus-picons-jobs-alist)
 	    (gnus-picons-next-job)))))))
 
@@ -336,27 +307,45 @@ To use:  (setq gnus-article-x-face-command 'gnus-picons-display-x-face)"
 	     (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)
-      (if (null gnus-picons-piconsearch-url)
-	  (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-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))))
+    (let* ((newsgroups (mail-fetch-field "newsgroups"))
+	   (groups
+	    (if (or gnus-picons-display-article-move-p
+		    (not newsgroups))
+		(list (gnus-group-real-name gnus-newsgroup-name))
+	      (split-string newsgroups ",")))
+	   group)
+      (save-excursion
+	(gnus-picons-prepare-for-annotations)
+	(while (setq group (pop groups))
+	  (unless gnus-picons-display-article-move-p
+	    (let ((buffer-read-only nil)
+		  (case-fold-search t))
+	      (goto-char (point-min))
+	      (if (and (re-search-forward "^Newsgroups *: *" nil t)
+		       (search-forward group (gnus-point-at-eol) t))
+		  (gnus-put-text-property
+		   (match-beginning 0) (match-end 0)
+		   'invisible t)
+		(let ((article-goto-body-goes-to-point-min-p nil))
+		  (article-goto-body))
+		(unless (bobp)
+		  (backward-char 1)))))
+	  (if (null gnus-picons-piconsearch-url)
+	      (gnus-picons-display-pairs
+	       (gnus-picons-lookup-pairs
+		(reverse (split-string group "\\."))
+		gnus-picons-news-directories)
+	       t ".")
+	    (push (list 'gnus-group-annotations 'search nil
+			(split-string group "\\.")
+			(if (listp gnus-picons-news-directories)
+			    gnus-picons-news-directories
+			  (list gnus-picons-news-directories))
+			nil (point-marker))
+		  gnus-picons-jobs-alist)
+	    (gnus-picons-next-job))
+
+	  (add-hook 'gnus-summary-exit-hook 'gnus-picons-remove-all))))))
 
 (defun gnus-picons-lookup-internal (addrs dir)
   (setq dir (expand-file-name dir gnus-picons-database))
@@ -418,7 +407,8 @@ none, and whose CDR is the corresponding element of DOMAINS."
   "Display picons in list PAIRS."
   (let ((domain-p (and gnus-picons-display-as-address dot-p))
 	pair picons)
-    (when (and bar-p domain-p right-p)
+    (when (and bar-p domain-p right-p
+	       gnus-picons-display-article-move-p)
       (setq picons (gnus-picons-display-glyph
 		    (let ((gnus-picons-file-suffixes '("xbm")))
 		      (gnus-picons-try-face
@@ -447,12 +437,14 @@ none, and whose CDR is the corresponding element of DOMAINS."
 				    dir)))
 	(setq suffixes nil
 	      glyph (make-glyph f))
-	(when (equal suf "xbm")
-	  (set-glyph-face glyph 'gnus-picons-xbm-face))
+	(if (equal suf "xbm")
+	    (set-glyph-face glyph 'gnus-picons-xbm-face)
+	  (set-glyph-face glyph 'gnus-picons-face))
 	(push (cons key glyph) gnus-picons-glyph-alist)))
     glyph))
 
 (defun gnus-picons-display-glyph (glyph &optional part rightp)
+  (set-glyph-baseline glyph 70)
   (let ((new (gnus-picons-make-annotation
 	      glyph (point) 'text nil nil nil rightp)))
     (when (and part gnus-picons-display-as-address)
@@ -490,8 +482,10 @@ none, and whose CDR is the corresponding element of DOMAINS."
 
 ;;; Query a remote DB.  This requires some stuff from w3 !
 
-(require 'url)
-(require 'w3-forms)
+(eval-and-compile
+  (ignore-errors
+    (require 'url)
+    (require 'w3-forms)))
 
 (defun gnus-picons-url-retrieve (url fn arg)
   (let ((old-asynch (default-value 'url-be-asynchronous))
@@ -532,86 +526,102 @@ none, and whose CDR is the corresponding element of DOMAINS."
 
 (defun gnus-picons-parse-value (name)
   (goto-char (point-min))
-  (re-search-forward (concat "<strong>"
-			     (regexp-quote name)
-			     "</strong> *= *<kbd> *\\([^ <][^<]*\\) *</kbd>"))
-  (buffer-substring (match-beginning 1) (match-end 1)))
+  (if (re-search-forward (concat "<strong>"
+				 (regexp-quote name)
+				 "</strong> *= *<kbd> *\\([^ <][^<]*\\) *</kbd>")
+			 nil t)
+      (buffer-substring (match-beginning 1) (match-end 1))))
 
 (defun gnus-picons-parse-filenames ()
   ;; returns an alist of ((USER ADDRS DB) . URL)
-  (let* ((case-fold-search t)
-	 (user (gnus-picons-parse-value "user"))
-	 (host (gnus-picons-parse-value "host"))
-	 (dbs (message-tokenize-header (gnus-picons-parse-value "db") " "))
-	 (start-re
-	  (concat
-	   ;; dbs
-	   "^\\(" (mapconcat 'identity dbs "\\|") "\\)/"
-	   ;; host
-	   "\\(\\(" (replace-in-string host "\\." "/\\|" t) "/\\|MISC/\\)*\\)"
-	   ;; user
-	   "\\(" (regexp-quote user) "\\|unknown\\)/"
-	   "face\\."))
-	 cur-db cur-host cur-user types res)
+  (let ((case-fold-search t)
+	(user (gnus-picons-parse-value "user"))
+	(host (gnus-picons-parse-value "host"))
+	(dbs (message-tokenize-header (gnus-picons-parse-value "db") " "))
+	start-re cur-db cur-host cur-user types res)
     ;; now point will be somewhere in the header.  Find beginning of
     ;; entries
-    (re-search-forward "<p>[ \t\n]*")
-    (while (re-search-forward start-re nil t)
-      (setq cur-db (buffer-substring (match-beginning 1) (match-end 1))
-	    cur-host (buffer-substring (match-beginning 2) (match-end 2))
-	    cur-user (buffer-substring (match-beginning 4) (match-end 4))
-	    cur-host (nreverse (message-tokenize-header cur-host "/")))
-      ;; XXX - KLUDGE: there is a blank picon in news/MISC/unknown
-      (unless (and (string-equal cur-db "news")
-		   (string-equal cur-user "unknown")
-		   (equal cur-host '("MISC")))
-	;; ok now we have found an entry (USER HOST DB), find the
-	;; corresponding picon URL
-	(save-restriction
-	  ;; restrict region to this entry
-	  (narrow-to-region (point) (search-forward "<br>"))
-	  (goto-char (point-min))
-	  (setq types gnus-picons-file-suffixes)
-	  (while (and types
-		      (not (re-search-forward
-			    (concat "<a[ \t\n]+href=\"\\([^\"]*\\."
-				    (regexp-quote (car types)) "\\)\"")
-			    nil t)))
-	    (pop types))
-	  (push (cons (list cur-user cur-host cur-db)
-		      (buffer-substring (match-beginning 1) (match-end 1)))
-		res))))
-    (nreverse res)))
+    (when (and user host dbs)
+      (setq start-re
+	    (concat
+	     ;; dbs
+	     "^\\(" (mapconcat 'regexp-quote dbs "\\|") "\\)/"
+	     ;; host
+	     "\\(\\(" (mapconcat 'regexp-quote
+				 (message-tokenize-header host ".") "/\\|")
+	     "/\\|MISC/\\)*\\)"
+	     ;; user
+	     "\\(" (regexp-quote user) "\\|unknown\\)/"
+	     "face\\."))
+      (re-search-forward "<p>[ \t\n]*")
+      (while (re-search-forward start-re nil t)
+	(setq cur-db (buffer-substring (match-beginning 1) (match-end 1))
+	      cur-host (buffer-substring (match-beginning 2) (match-end 2))
+	      cur-user (buffer-substring (match-beginning 4) (match-end 4))
+	      cur-host (nreverse (message-tokenize-header cur-host "/")))
+	;; XXX - KLUDGE: there is a blank picon in news/MISC/unknown
+	(unless (and (string-equal cur-db "news")
+		     (string-equal cur-user "unknown")
+		     (equal cur-host '("MISC")))
+	  ;; ok now we have found an entry (USER HOST DB), find the
+	  ;; corresponding picon URL
+	  (save-restriction
+	    ;; restrict region to this entry
+	    (narrow-to-region (point) (search-forward "<br>"))
+	    (goto-char (point-min))
+	    (setq types gnus-picons-file-suffixes)
+	    (while (and types
+			(not (re-search-forward
+			      (concat "<a[ \t\n]+href=\"\\([^\"]*\\."
+				      (regexp-quote (car types)) "\\)\"")
+			      nil t)))
+	      (pop types))
+	    (push (cons (list cur-user cur-host cur-db)
+			(buffer-substring (match-beginning 1) (match-end 1)))
+		  res))))
+      (nreverse res))))
 
 ;;; picon network display functions :
 
-(defun gnus-picons-network-display-internal (sym-ann glyph part right-p)
-  (gnus-picons-set-buffer)
-  (gnus-picons-display-picon-or-name glyph part right-p)
+(defun gnus-picons-network-display-internal (sym-ann glyph part right-p marker)
+  (let ((buf (marker-buffer marker))
+	(pos (marker-position marker)))
+    (if (and buf pos)
+	(save-excursion
+	  (set-buffer buf)
+	  (goto-char pos)
+	  (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)
+(defun gnus-picons-network-display-callback (url part sym-ann right-p marker)
   (let ((glyph (gnus-picons-make-glyph (cdr (assoc url-current-mime-type
 						   w3-image-mappings)))))
     (kill-buffer (current-buffer))
     (push (cons url glyph) gnus-picons-glyph-alist)
     ;; 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)
+	       (list sym-ann 'picon url part right-p marker))
+	(gnus-picons-network-display-internal
+	 sym-ann glyph part right-p marker)
       (gnus-picons-next-job-internal))))
 
-(defun gnus-picons-network-display (url part sym-ann right-p)
+(defun gnus-picons-network-display (url part sym-ann right-p marker)
   (let ((cache (assoc url gnus-picons-glyph-alist)))
     (if (or cache (null url))
-	(gnus-picons-network-display-internal sym-ann (cdr cache) part right-p)
+	(gnus-picons-network-display-internal
+	 sym-ann (cdr cache) part right-p marker)
       (gnus-picons-url-retrieve url 'gnus-picons-network-display-callback
-				(list url part sym-ann right-p)))))
+				(list url part sym-ann right-p marker)))))
 
 ;;; search job functions
 
+(defun gnus-picons-display-bar-p ()
+  (if (eq gnus-picons-display-where 'article)
+      gnus-picons-display-article-move-p
+    gnus-picons-display-as-address))
+
 (defun gnus-picons-network-search-internal (user addrs dbs sym-ann right-p
-						 &optional fnames)
+						 marker &optional fnames)
   (let (curkey dom pfx url dbs-tmp cache new-jobs)
     ;; First do the domain search
     (dolist (part (if right-p
@@ -640,8 +650,8 @@ none, and whose CDR is the corresponding element of DOMAINS."
 	(push (setq cache (cons curkey url)) gnus-picons-url-alist))
       ;; Put this glyph in the job list
       (if (and (not (eq dom part)) gnus-picons-display-as-address)
-	  (push (list sym-ann "." right-p) new-jobs))
-      (push (list sym-ann 'picon (cdr cache) part right-p) new-jobs))
+	  (push (list sym-ann "." right-p marker) new-jobs))
+      (push (list sym-ann 'picon (cdr cache) part right-p marker) new-jobs))
     ;; next, the user search
     (when user
       (setq curkey (list user dom gnus-picons-user-directories))
@@ -663,31 +673,34 @@ none, and whose CDR is the corresponding element of DOMAINS."
 	    (push (setq cache (cons curkey (cdr picon)))
 		  gnus-picons-url-alist)))
       (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))
-    (if (and gnus-picons-display-as-address (not right-p))
-	(push (list sym-ann 'bar right-p) new-jobs))
+	  (push (list sym-ann "@" right-p marker) new-jobs))
+      (push (list sym-ann 'picon (cdr cache) user right-p marker) new-jobs))
+    (if (and (gnus-picons-display-bar-p) (not right-p))
+	(push (list sym-ann 'bar right-p marker) 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))
+	       (list sym-ann 'search user addrs dbs right-p marker))
 	(setq gnus-picons-jobs-alist
-	      (nconc (if (and gnus-picons-display-as-address right-p)
-			 (list (list sym-ann 'bar right-p)))
+	      (nconc (if (and (gnus-picons-display-bar-p) right-p)
+			 (list (list sym-ann 'bar right-p marker)))
 		     (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)
-  (gnus-picons-network-search-internal user addrs dbs sym-ann right-p
-				       (prog1 (gnus-picons-parse-filenames)
-					 (kill-buffer (current-buffer)))))
+(defun gnus-picons-network-search-callback (user addrs dbs sym-ann right-p
+						 marker)
+  (gnus-picons-network-search-internal
+   user addrs dbs sym-ann right-p marker
+   (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)
+(defun gnus-picons-network-search (user addrs dbs sym-ann right-p marker)
   (let* ((host (mapconcat 'identity addrs "."))
 	 (key (list (or user "unknown") host (if user
-						  gnus-picons-user-directories
-						dbs)))
+						 gnus-picons-user-directories
+					       dbs)))
 	 (cache (assoc key gnus-picons-url-alist)))
     (if (null cache)
 	(gnus-picons-url-retrieve
@@ -701,35 +714,38 @@ none, and whose CDR is the corresponding element of DOMAINS."
 				     dbs)
 				   "+"))
 	 'gnus-picons-network-search-callback
-	 (list user addrs dbs sym-ann right-p))
-      (gnus-picons-network-search-internal user addrs dbs sym-ann right-p))))
+	 (list user addrs dbs sym-ann right-p marker))
+      (gnus-picons-network-search-internal
+       user addrs dbs sym-ann right-p marker))))
 
 ;;; Main jobs dispatcher function
 
 (defun gnus-picons-next-job-internal ()
-  (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 (setq gnus-picons-job-already-running nil)
-		     (error "Unknown picon job tag %s" tag)))))))
+  (when (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)))
+      (when tag
+	(cond
+	 ((stringp tag);; (SYM-ANN "..." RIGHT-P MARKER)
+	  (gnus-picons-network-display-internal
+	   sym-ann nil tag (pop job) (pop job)))
+	 ((eq 'bar tag);; (SYM-ANN 'bar RIGHT-P MARKER)
+	  (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) (pop job)))
+	 ((eq 'search tag);; (SYM-ANN 'search USER ADDRS DBS RIGHT-P MARKER)
+	  (gnus-picons-network-search
+	   (pop job) (pop job) (pop job) sym-ann (pop job) (pop job)))
+	 ((eq 'picon tag);; (SYM-ANN 'picon URL PART RIGHT-P MARKER)
+	  (gnus-picons-network-display
+	   (pop job) (pop job) sym-ann (pop job) (pop job)))
+	 (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 if it is not in progress."