From: yamaoka <yamaoka>
Date: Tue, 18 May 2004 12:23:09 +0000 (+0000)
Subject: Synch to No Gnus 200405181221.
X-Git-Tag: t-gnus-6_17_4-quimby-~923
X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=7bbdccd06e2c81154ecbed9dbb0103f864b04b47;p=elisp%2Fgnus.git-

Synch to No Gnus 200405181221.
---

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index dce3bf9..575403e 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,7 +1,14 @@
+2004-05-18  Reiner Steib  <Reiner.Steib@gmx.de>
+
+	* gnus-picon.el (gnus-picon-style): New variable.
+	(gnus-picon-insert-glyph): Added optional `nostring' argument.
+	(gnus-picon-transform-address): Support `gnus-picon-style'.  From
+	Jesper Harder <harder@ifa.au.dk>.	
+
 2004-05-18  Lars Magne Ingebrigtsen  <larsi@gnus.org>
 
 	* gnus-start.el (gnus-get-unread-articles-in-group): Don't do
-	stuff for non-living group.s
+	stuff for non-living groups.
 
 2004-05-18  Jesper Harder  <harder@ifa.au.dk>
 
@@ -194,7 +201,7 @@
 	(spam-bsfilter-unregister-spam-routine)
 	(spam-bsfilter-register-ham-routine)
 	(spam-bsfilter-unregister-ham-routine): New functions.
-	(spam-generic-score): Supprt bsfilter; Accept an optional argument
+	(spam-generic-score): Support bsfilter; Accept an optional argument
 	to recalcurate spam score even if scoring header has already been
 	added.
 	(spam-bogofilter-score, spam-spamassassin-score): Accept an
diff --git a/lisp/gnus-picon.el b/lisp/gnus-picon.el
index ebd226d..a155e84 100644
--- a/lisp/gnus-picon.el
+++ b/lisp/gnus-picon.el
@@ -74,6 +74,15 @@ Some people may want to add \"unknown\" to this list."
   :type '(repeat string)
   :group 'gnus-picon)
 
+(defcustom gnus-picon-style 'inline
+  "How should picons be displayed.
+If `inline', the textual representation is replaced.  If `right', picons are
+added right to the textual representation."
+  ;; FIXME: `right' needs improvement for XEmacs.
+  :type '(choice (const inline)
+		 (const right))
+  :group 'gnus-picon)
+
 (defface gnus-picon-xbm-face '((t (:foreground "black" :background "white")))
   "Face to show xbm picon in."
   :group 'gnus-picon)
@@ -135,14 +144,17 @@ List of pairs (KEY . GLYPH) where KEY is either a filename or an URL.")
 	file
       nil)))
 
-(defun gnus-picon-insert-glyph (glyph category)
+(defun gnus-picon-insert-glyph (glyph category &optional nostring)
   "Insert GLYPH into the buffer.
-GLYPH can be either a glyph or a string."
+GLYPH can be either a glyph or a string.  When NOSTRING, no textual
+replacement is added."
+  ;; Using NOSTRING prevents wrong BBDB entries with `gnus-picon-style' set to
+  ;; 'right.
   (if (stringp glyph)
       (insert glyph)
     (gnus-add-wash-type category)
     (gnus-add-image category (car glyph))
-    (gnus-put-image (car glyph) (cdr glyph) category)))
+    (gnus-put-image (car glyph) (unless nostring (cdr glyph)) category)))
 
 (defun gnus-picon-create-glyph (file)
   (or (cdr (assoc file gnus-picon-glyph-alist))
@@ -162,7 +174,7 @@ GLYPH can be either a glyph or a string."
 	       (mail-encode-encoded-word-string
 		(or (mail-fetch-field header) "")))
 	     (mail-fetch-field header))))
-	  spec file point cache)
+	  spec file point cache len)
       (dolist (address addresses)
 	(setq address (car address))
 	(when (and (stringp address)
@@ -193,16 +205,37 @@ GLYPH can be either a glyph or a string."
 
 	  (gnus-article-goto-header header)
 	  (mail-header-narrow-to-field)
-	  (when (search-forward address nil t)
-	    (delete-region (match-beginning 0) (match-end 0))
-	    (setq point (point))
-	    (while spec
-	      (goto-char point)
-	      (if (> (length spec) 2)
-		  (insert ".")
-		(if (= (length spec) 2)
-		  (insert "@")))
-	      (gnus-picon-insert-glyph (pop spec) category))))))))
+	  (case gnus-picon-style
+	    (right
+	     (when (= (length addresses) 1)
+	       (setq len (apply '+ (mapcar (lambda (x)
+					     (condition-case nil
+						 (car (image-size (car x)))
+					       (error 0))) spec)))
+	       (when (> len 0)
+		 (goto-char (point-at-eol))
+		 (insert (propertize
+			  " " 'display
+			  (cons 'space
+				(list :align-to (- (window-width) 1 len))))))
+	       (goto-char (point-at-eol))
+	       (setq point (point-at-eol))
+	       (dolist (image spec)
+		 (unless (stringp image)
+		   (goto-char point)
+		   (gnus-picon-insert-glyph image category 'nostring)))))
+	    (inline
+	      (when (search-forward address nil t)
+		(delete-region (match-beginning 0) (match-end 0))
+		(setq point (point))
+		(while spec
+		  (goto-char point)
+		  (if (> (length spec) 2)
+		      (insert ".")
+		    (if (= (length spec) 2)
+			(insert "@")))
+		  (gnus-picon-insert-glyph (pop spec) category)))))
+	      )))))
 
 (defun gnus-picon-transform-newsgroups (header)
   (interactive)