2002-01-02 ShengHuo ZHU <zsh@cs.rochester.edu>

	Display picons in XEmacs without showing text.

	* gnus-xmas.el (gnus-xmas-create-image): Don't use
	mm-create-image-xemacs to create xbm glyph, because it deletes
	temporary files.
	(gnus-xmas-put-image): Use end-glyph. Make text invisible.
	(gnus-xmas-remove-image): Make text visible, remove glyph.

	* gnus-picon.el (gnus-picon-transform-newsgroups)
	(gnus-picon-transform-address): Insert spec backward, due to the
	incompatibility of gnus-xmas-put-image.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 57b5673..aafd28a 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,17 @@
+2002-01-02  ShengHuo ZHU  <zsh@cs.rochester.edu>
+
+       Display picons in XEmacs without showing text.
+
+       * gnus-xmas.el (gnus-xmas-create-image): Don't use
+       mm-create-image-xemacs to create xbm glyph, because it deletes
+       temporary files.
+       (gnus-xmas-put-image): Use end-glyph. Make text invisible.
+       (gnus-xmas-remove-image): Make text visible, remove glyph.
+       
+       * gnus-picon.el (gnus-picon-transform-newsgroups)
+       (gnus-picon-transform-address): Insert spec backward, due to the
+       incompatibility of gnus-xmas-put-image.
+
 2002-01-02  Pavel Jan\e,Bm\e(Bk  <Pavel@Janik.cz>
 
        * gnus-fun.el (gnus-convert-pbm-to-x-face-command): Doc fix. 

diff --git a/lisp/gnus-picon.el b/lisp/gnus-picon.el
index e7f5c2c..4aff003 100644 (file)
--- a/lisp/gnus-picon.el
+++ b/lisp/gnus-picon.el
@@ -162,10 +162,9 @@ GLYPH can be either a glyph or a string."
   (gnus-with-article-headers
     (let ((addresses
           (mail-header-parse-addresses (mail-fetch-field header)))
-         first spec file)
+         spec file point)
       (dolist (address addresses)
-       (setq address (car address)
-             first t)
+       (setq address (car address))
        (when (and (stringp address)
                   (setq spec (gnus-picon-split-address address)))
          (when (setq file (or (gnus-picon-find-face
@@ -192,13 +191,15 @@ GLYPH can be either a glyph or a string."
          (mail-header-narrow-to-field)
          (when (search-forward address nil t)
            (delete-region (match-beginning 0) (match-end 0))
+           (setq spec (nreverse spec))
+           (setq point (point))
            (while spec
-             (gnus-picon-insert-glyph (pop spec) category)
-             (when spec
-               (if (not first)
-                   (insert ".")
-                 (insert "@")
-                 (setq first nil))))))))))
+             (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)
@@ -207,7 +208,7 @@ GLYPH can be either a glyph or a string."
           (sort
            (message-tokenize-header (mail-fetch-field header))
            (lambda (g1 g2) (> (length g1) (length g2)))))
-         spec file)
+         spec file point)
       (dolist (group groups)
        (setq spec (nreverse (split-string group "[.]")))
        (dotimes (i (length spec))
@@ -224,11 +225,12 @@ GLYPH can be either a glyph or a string."
        (mail-header-narrow-to-field)
        (when (search-forward group nil t)
          (delete-region (match-beginning 0) (match-end 0))
-         (setq spec (nreverse spec))
+         (setq point (point))
          (while spec
-           (gnus-picon-insert-glyph (pop spec) 'newsgroups-picon)
-           (when spec
-             (insert "."))))))))
+           (goto-char point)
+           (if (> (length spec) 1)
+               (insert "."))
+           (gnus-picon-insert-glyph (pop spec) 'newsgroups-picon)))))))
 
 ;;; Commands:
 

diff --git a/lisp/gnus-xmas.el b/lisp/gnus-xmas.el
index 15a300c..eccc24a 100644 (file)
--- a/lisp/gnus-xmas.el
+++ b/lisp/gnus-xmas.el
@@ -823,24 +823,31 @@ XEmacs compatibility workaround."
   (featurep type))
 
 (defun gnus-xmas-create-image (file)
-  (with-temp-buffer
-    (insert-file-contents file)
-    (mm-create-image-xemacs (car (last (split-string file "[.]"))))))
+  (let ((type (car (last (split-string file "[.]")))))
+    (if (equal type "xbm")
+       (make-glyph (list (cons 'x file)))
+      (with-temp-buffer
+       (insert-file-contents file)
+       (mm-create-image-xemacs type)))))
 
 (defun gnus-xmas-put-image (glyph &optional string)
+  "Insert STRING, but display GLYPH.
+Warning: Don't insert text immediately after the image."
   (let ((begin (point))
        extent)
     (insert string)
     (setq extent (make-extent begin (point)))
     (set-extent-property extent 'gnus-image t)
     (set-extent-property extent 'duplicable t)
-    (set-extent-property extent 'begin-glyph glyph)))
+    (set-extent-property extent 'invisible t)
+    (set-extent-property extent 'end-glyph glyph)))
 
 (defun gnus-xmas-remove-image (image)
   (map-extents
    (lambda (ext unused)
-     (when (equal (extent-begin-glyph ext) image)
-       (set-extent-property ext 'begin-glyph nil))
+     (when (equal (extent-end-glyph ext) image)
+       (set-extent-property ext 'invisible nil)
+       (set-extent-property ext 'end-glyph nil))
      nil)
    nil nil nil nil nil 'gnus-image))