X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-xmas.el;h=2e0586d4d5a157d58450c88242426430746998c4;hb=b0eccd76f35ef80c3ad13f09e588d49358e9c22a;hp=7fe972cfc93aa367a1b19b0bb6863eb8f652146c;hpb=5b892c6ecb84f375cc38fd0e78bd472834ea27e2;p=gnus

diff --git a/lisp/gnus-xmas.el b/lisp/gnus-xmas.el
index 7fe972cfc..2e0586d4d 100644
--- a/lisp/gnus-xmas.el
+++ b/lisp/gnus-xmas.el
@@ -856,72 +856,6 @@ XEmacs compatibility workaround."
     (goto-char (event-point event))
     (funcall (event-function response) (event-object response))))
 
-(defun gnus-group-add-icon ()
-  "Add an icon to the current line according to `gnus-group-icon-list'."
-  (let* ((p (point))
-	 (end (point-at-eol))
-	 ;; now find out where the line starts and leave point there.
-	 (beg (progn (beginning-of-line) (point))))
-    (save-restriction
-      (narrow-to-region beg end)
-      (goto-char beg)
-      (when (search-forward "==&&==" nil t)
-	(let* ((group (gnus-group-group-name))
-	       (entry (gnus-group-entry group))
-	       (unread (if (numberp (car entry)) (car entry) 0))
-	       (active (gnus-active group))
-	       (total (if active (1+ (- (cdr active) (car active))) 0))
-	       (info (nth 2 entry))
-	       (method (gnus-server-get-method group (gnus-info-method info)))
-	       (marked (gnus-info-marks info))
-	       (mailp (memq 'mail (assoc (symbol-name
-					  (car (or method gnus-select-method)))
-					 gnus-valid-select-methods)))
-	       (level (or (gnus-info-level info) gnus-level-killed))
-	       (score (or (gnus-info-score info) 0))
-	       (ticked (gnus-range-length (cdr (assq 'tick marked))))
-	       (group-age (gnus-group-timestamp-delta group))
-	       (inhibit-read-only t)
-	       (list gnus-group-icon-list)
-	       (mystart (match-beginning 0))
-	       (myend (match-end 0)))
-	  (goto-char (point-min))
-	  (while (and list
-		      (not (eval (caar list))))
-	    (setq list (cdr list)))
-	  (if list
-	      (let* ((file (cdar list))
-		     (glyph (gnus-group-icon-create-glyph
-			     (buffer-substring mystart myend)
-			     file)))
-		(if glyph
-		    (progn
-		      (mapc 'delete-annotation (annotations-at myend))
-		      (let ((ext (make-extent mystart myend))
-			    (ant (make-annotation glyph myend 'text)))
-			;; set text extent params
-			(set-extent-property ext 'end-open t)
-			(set-extent-property ext 'start-open t)
-			(set-extent-property ext 'invisible t)))
-		  (delete-region mystart myend)))
-	    (delete-region mystart myend))))
-      (widen))
-    (goto-char p)))
-
-(defun gnus-group-icon-create-glyph (substring pixmap)
-  "Create a glyph for insertion into a group line."
-  (or
-   (cdr-safe (assoc pixmap gnus-group-icon-cache))
-   (let* ((glyph (make-glyph
-		  (list
-		   (cons 'x
-			 (expand-file-name pixmap gnus-xmas-glyph-directory))
-		   (cons 'tty substring)))))
-     (setq gnus-group-icon-cache
-	   (cons (cons pixmap glyph) gnus-group-icon-cache))
-     (set-glyph-face glyph 'default)
-     glyph)))
-
 (defun gnus-xmas-mailing-list-menu-add ()
   (gnus-xmas-menu-add mailing-list
 		      gnus-mailing-list-menu))
@@ -933,9 +867,12 @@ XEmacs compatibility workaround."
        (featurep (if (eq type 'pbm) 'xbm type))))
 
 (defun gnus-xmas-create-image (file &optional type data-p &rest props)
-  (let ((type (if type
-		  (symbol-name type)
-		(car (last (split-string file "[.]")))))
+  (let ((type (cond
+	       (type
+		(symbol-name type))
+	       ((and (not data-p)
+		     (string-match "[.]" file))
+		(car (last (split-string file "[.]"))))))
 	(face (plist-get props :face))
 	glyph)
     (when (equal type "pbm")
@@ -957,31 +894,30 @@ XEmacs compatibility workaround."
 		(insert-file-contents-literally file))
 	      (make-glyph
 	       (vector
-		(or (intern type)
-		    (mm-image-type-from-buffer))
+		(if type
+		    (intern type)
+		  (mm-image-type-from-buffer))
 		:data (buffer-string))))))
     (when face
       (set-glyph-face glyph face))
     glyph))
 
-(defun gnus-xmas-put-image (glyph &optional string category point)
+(defun gnus-xmas-put-image (glyph &optional string category)
   "Insert STRING, but display GLYPH.
 Warning: Don't insert text immediately after the image."
-  (let ((begin (or point (point)))
+  (let ((begin (point))
 	extent)
-    (save-excursion
-      (goto-char begin)
-      (if (and (bobp) (not string))
-	  (setq string " "))
-      (if string
-	  (insert string)
-	(setq begin (1- begin)))
-      (setq extent (make-extent begin (point)))
-      (set-extent-property extent 'gnus-image category)
-      (set-extent-property extent 'duplicable t)
-      (if string
-	  (set-extent-property extent 'invisible t))
-      (set-extent-property extent 'end-glyph glyph)))
+    (if (and (bobp) (not string))
+	(setq string " "))
+    (if string
+	(insert string)
+      (setq begin (1- begin)))
+    (setq extent (make-extent begin (point)))
+    (set-extent-property extent 'gnus-image category)
+    (set-extent-property extent 'duplicable t)
+    (if string
+	(set-extent-property extent 'invisible t))
+    (set-extent-property extent 'end-glyph glyph))
   glyph)
 
 (defun gnus-xmas-remove-image (image &optional category)
@@ -1002,5 +938,4 @@ Warning: Don't insert text immediately after the image."
 
 (provide 'gnus-xmas)
 
-;;; arch-tag: 4e84de3f-ea0a-4ee3-bfeb-e03d46fcacef
 ;;; gnus-xmas.el ends here