X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-fun.el;h=162cc7e198453dd9620dc7d6eb2f501f427f8484;hb=76aee12382f9d631bd1a1c51db62be5318e55881;hp=a27ae2f6c592f8ee2a1810a581e5f6a51b29c0e2;hpb=d04f6feff631b10b131089ff336f180b4be2c8c9;p=gnus

diff --git a/lisp/gnus-fun.el b/lisp/gnus-fun.el
index a27ae2f6c..162cc7e19 100644
--- a/lisp/gnus-fun.el
+++ b/lisp/gnus-fun.el
@@ -1,5 +1,6 @@
 ;;; gnus-fun.el --- various frivolous extension functions to Gnus
-;; Copyright (C) 2002, 2003 Free Software Foundation, Inc.
+
+;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: news
@@ -8,7 +9,7 @@
 
 ;; GNU Emacs is free software; you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
+;; the Free Software Foundation; either version 3, or (at your option)
 ;; any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
@@ -18,8 +19,8 @@
 
 ;; You should have received a copy of the GNU General Public License
 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
 
 ;;; Commentary:
 
@@ -31,30 +32,51 @@
 (require 'mm-util)
 (require 'gnus-ems)
 (require 'gnus-util)
+(require 'gnus)
 
 (defcustom gnus-x-face-directory (expand-file-name "x-faces" gnus-directory)
   "*Directory where X-Face PBM files are stored."
+  :version "22.1"
   :group 'gnus-fun
   :type 'directory)
 
 (defcustom gnus-convert-pbm-to-x-face-command "pbmtoxbm %s | compface"
   "Command for converting a PBM to an X-Face."
+  :version "22.1"
   :group 'gnus-fun
   :type 'string)
 
-(defcustom gnus-convert-image-to-x-face-command "giftopnm %s | ppmnorm | pnmscale -width 48 -height 48 | ppmtopgm | pgmtopbm | pbmtoxbm | compface"
+(defcustom gnus-convert-image-to-x-face-command
+  "convert -scale 48x48! %s xbm:- | xbm2xface.pl"
   "Command for converting an image to an X-Face.
+The command must take a image filename (use \"%s\") as input.
+The output must be the Face header data on stdout in PNG format.
+
 By default it takes a GIF filename and output the X-Face header data
 on stdout."
+  :version "22.1"
   :group 'gnus-fun
-  :type 'string)
+  :type '(choice (const :tag "giftopnm, netpbm (GIF input only)"
+			"giftopnm %s | ppmnorm | pnmscale -width 48 -height 48 | ppmtopgm | pgmtopbm | pbmtoxbm | compface")
+		 (const :tag "convert"
+			"convert -scale 48x48! %s xbm:- | xbm2xface.pl")
+		 (string)))
 
-(defcustom gnus-convert-image-to-face-command "djpeg %s | ppmnorm | pnmscale -width 48 -height 48 | ppmquant %d | pnmtopng"
-  "Command for converting an image to an Face.
-By default it takes a JPEG filename and output the Face header data
-on stdout."
+(defcustom gnus-convert-image-to-face-command
+  "convert -scale 48x48! %s -colors %d png:-"
+  "Command for converting an image to a Face.
+
+The command must take an image filename (first format argument
+\"%s\") and the number of colors (second format argument: \"%d\")
+as input.  The output must be the Face header data on stdout in
+PNG format."
+  :version "22.1"
   :group 'gnus-fun
-  :type 'string)
+  :type '(choice (const :tag "djpeg, netpbm (JPG input only)"
+			"djpeg %s | ppmnorm | pnmscale -width 48 -height 48 | ppmquant %d | pnmtopng")
+		 (const :tag "convert"
+			"convert -scale 48x48! %s -colors %d png:-")
+		 (string)))
 
 (defun gnus-shell-command-to-string (command)
   "Like `shell-command-to-string' except not mingling ERROR."
@@ -96,8 +118,11 @@ Output to the current buffer, replace text, and don't mingle error."
 
 ;;;###autoload
 (defun gnus-x-face-from-file (file)
-  "Insert an X-Face header based on an image file."
-  (interactive "fImage file name (by default GIF): ")
+  "Insert an X-Face header based on an image file.
+
+Depending on `gnus-convert-image-to-x-face-command' it may accept
+different input formats."
+  (interactive "fImage file name: ")
   (when (file-exists-p file)
     (gnus-shell-command-to-string
      (format gnus-convert-image-to-x-face-command
@@ -105,8 +130,11 @@ Output to the current buffer, replace text, and don't mingle error."
 
 ;;;###autoload
 (defun gnus-face-from-file (file)
-  "Return an Face header based on an image file."
-  (interactive "fImage file name (by default JPEG): ")
+  "Return a Face header based on an image file.
+
+Depending on `gnus-convert-image-to-face-command' it may accept
+different input formats."
+  (interactive "fImage file name: ")
   (when (file-exists-p file)
     (let ((done nil)
 	  (attempt "")
@@ -121,7 +149,7 @@ Output to the current buffer, replace text, and don't mingle error."
 			 quant))))
 	(if (> (length attempt) 726)
 	    (progn
-	      (setq quant (- quant 2))
+	      (setq quant (- quant (if (< quant 10) 1 2)))
 	      (gnus-message 9 "Length %d; trying quant %d"
 			    (length attempt) quant))
 	  (setq done t)))
@@ -191,11 +219,11 @@ colors of the displayed X-Faces."
 	   'xface
 	   (gnus-put-image
 	    (if (gnus-image-type-available-p 'xface)
-		(gnus-create-image
-		 (concat "X-Face: " data)
-		 'xface t :face 'gnus-x-face)
-	      (gnus-create-image
-	       pbm 'pbm t :face 'gnus-x-face)) nil 'xface))
+		(apply 'gnus-create-image (concat "X-Face: " data) 'xface t
+		       (cdr (assq 'xface gnus-face-properties-alist)))
+	      (apply 'gnus-create-image pbm 'pbm t
+		     (cdr (assq 'pbm gnus-face-properties-alist))))
+	    nil 'xface))
 	  (gnus-add-wash-type 'xface))))))
 
 (defun gnus-grab-cam-x-face ()
@@ -251,4 +279,5 @@ colors of the displayed X-Faces."
 
 (provide 'gnus-fun)
 
+;;; arch-tag: 9d000a69-15cc-4491-9dc0-4627484f50c1
 ;;; gnus-fun.el ends here