X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-fun.el;h=0f28bf5e5eaea9c94189f18a9d420140035c8a03;hb=576f700c4b3e7702f2c2f64fdc9298c8bbe8beb3;hp=9140394d828a5a348ee1aa537ee689d2554f77a5;hpb=0fd27ffa960ebecdc1a624050d41021119da8df2;p=gnus diff --git a/lisp/gnus-fun.el b/lisp/gnus-fun.el index 9140394d8..0f28bf5e5 100644 --- a/lisp/gnus-fun.el +++ b/lisp/gnus-fun.el @@ -1,88 +1,86 @@ ;;; 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, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news ;; This file is part of GNU Emacs. -;; GNU Emacs is free software; you can redistribute it and/or modify +;; 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) -;; any later version. +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; 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. +;; along with GNU Emacs. If not, see . ;;; Commentary: ;;; Code: +;; For Emacs <22.2 and XEmacs. +(eval-and-compile + (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) + (eval-when-compile (require 'cl)) (require 'mm-util) (require 'gnus-ems) (require 'gnus-util) +(require 'gnus) + +(defvar gnus-face-properties-alist) (defcustom gnus-x-face-directory (expand-file-name "x-faces" gnus-directory) "*Directory where X-Face PBM files are stored." - :version "21.4" + :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 "21.4" + :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. -By default it takes a GIF filename and output the X-Face header data -on stdout." - :version "21.4" - :group 'gnus-fun - :type 'string) +The command must take a image filename (use \"%s\") as input. +The output must be the Face header data on stdout in PNG format. -(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 +By default it takes a GIF filename and output the X-Face header data on stdout." - :version "21.4" + :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." + :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 + "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 '(repeat (cons :format "%v" (symbol :tag "Image type") plist))) + :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." @@ -109,6 +107,8 @@ Output to the current buffer, replace text, and don't mingle error." (format gnus-convert-pbm-to-x-face-command (shell-quote-argument file))))))) +(autoload 'message-goto-eoh "message" nil t) + ;;;###autoload (defun gnus-insert-random-x-face-header () "Insert a random X-Face header from `gnus-x-face-directory'." @@ -124,8 +124,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 @@ -133,8 +136,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 "") @@ -149,7 +155,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))) @@ -201,10 +207,15 @@ The colors from this face are used as the foreground and background colors of the displayed X-Faces." :group 'gnus-article-headers) +(declare-function article-narrow-to-head "gnus-art" ()) +(declare-function gnus-article-goto-header "gnus-art" (header)) +(declare-function gnus-add-image "gnus-art" (category image)) +(declare-function gnus-add-wash-type "gnus-art" (type)) + (defun gnus-display-x-face-in-from (data) "Display the X-Face DATA in the From header." - (let ((default-enable-multibyte-characters nil) - pbm) + (require 'gnus-art) + (let (pbm) (when (or (gnus-image-type-available-p 'xface) (and (gnus-image-type-available-p 'pbm) (setq pbm (uncompface data)))) @@ -279,5 +290,4 @@ colors of the displayed X-Faces." (provide 'gnus-fun) -;;; arch-tag: 9d000a69-15cc-4491-9dc0-4627484f50c1 ;;; gnus-fun.el ends here