X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-fun.el;h=fe39d859d8dabfd14afe653e879414a3dc7a7c1a;hb=b0a647ce416c0364b57c36a85dd5ac8ae84922d5;hp=ca5cdea2948f153ba172dda019a95bcdd89f3b7a;hpb=299c947dde266c2d2cec625b91c662a3c9f71dad;p=gnus diff --git a/lisp/gnus-fun.el b/lisp/gnus-fun.el index ca5cdea29..fe39d859d 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 ;; Keywords: news @@ -18,40 +19,87 @@ ;; 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: ;;; Code: (eval-when-compile - (require 'cl) - (require 'mm-util)) + (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) -(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))) + +(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." @@ -93,8 +141,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 @@ -102,8 +153,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 "") @@ -119,8 +173,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 +242,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 () @@ -248,4 +302,5 @@ colors of the displayed X-Faces." (provide 'gnus-fun) +;;; arch-tag: 9d000a69-15cc-4491-9dc0-4627484f50c1 ;;; gnus-fun.el ends here