X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus-fun.el;h=52eba3045c6ba18f7ef85c034def4bcd8b6ff711;hb=4cacb5f23eb830e6950dba987063f413977708d7;hp=8791640f508d8dd2ce5f8cbe27a630f2f43bba25;hpb=e6b31519e256eaa52280b45df80d5b436c1539b1;p=elisp%2Fgnus.git-

diff --git a/lisp/gnus-fun.el b/lisp/gnus-fun.el
index 8791640..52eba30 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 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: news
@@ -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:
 
@@ -29,13 +30,18 @@
   (require 'cl)
   (require 'mm-util))
 
+(require 'gnus-ems)
+(require 'gnus-util)
+
 (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)
 
@@ -43,16 +49,42 @@
   "Command for converting an image to an X-Face.
 By default it takes a GIF filename and output the X-Face header data
 on stdout."
+  :version "22.1"
   :group 'gnus-fun
   :type '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.
+  "Command for converting an image to a Face.
 By default it takes a JPEG filename and output the Face header data
 on stdout."
+  :version "22.1"
   :group 'gnus-fun
   :type 'string)
 
+(defcustom gnus-face-properties-alist (if (featurep 'xemacs)
+					  '((xface . (:face gnus-x-face)))
+					'((pbm . (:face gnus-x-face))
+					  (png . nil)))
+  "Alist of image types and properties applied to Face and X-Face images.
+Here are examples:
+
+;; Specify the altitude of Face images in the From header.
+\(setq gnus-face-properties-alist
+      '((pbm . (:face gnus-x-face :ascent 80))
+	(png . (:ascent 80))))
+
+;; Show Face images as pressed buttons.
+\(setq gnus-face-properties-alist
+      '((pbm . (:face gnus-x-face :relief -2))
+	(png . (:relief -2))))
+
+See the manual for the valid properties for various image types.
+Currently, `pbm' is used for X-Face images and `png' is used for Face
+images in Emacs.  Only the `:face' property is effective on the `xface'
+image type in XEmacs if it is built with the libcompface library."
+  :group 'gnus-fun
+  :type '(repeat (cons :format "%v" (symbol :tag "Image type") plist)))
+
 (defun gnus-shell-command-to-string (command)
   "Like `shell-command-to-string' except not mingling ERROR."
   (with-output-to-string
@@ -102,7 +134,7 @@ 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."
+  "Return a Face header based on an image file."
   (interactive "fImage file name (by default JPEG): ")
   (when (file-exists-p file)
     (let ((done nil)
@@ -119,8 +151,8 @@ Output to the current buffer, replace text, and don't mingle error."
 	(if (> (length attempt) 726)
 	    (progn
 	      (setq quant (- quant 2))
-	      (message "Length %d; trying quant %d"
-		       (length attempt) quant))
+	      (gnus-message 9 "Length %d; trying quant %d"
+			    (length attempt) quant))
 	  (setq done t)))
       (if done
 	  (mm-with-unibyte-buffer
@@ -188,11 +220,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 :ascent 'center :face 'gnus-x-face)
-	      (gnus-create-image
-	       pbm 'pbm t :ascent 'center :face 'gnus-x-face))))
+		(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 ()