-;;; gnus-fun.el --- various frivoluos extension functions to Gnus
-;; Copyright (C) 2002 Free Software Foundation, Inc.
+;;; gnus-fun.el --- various frivolous extension functions to Gnus
+
+;; Copyright (C) 2002-2011 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; 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 <http://www.gnu.org/licenses/>.
;;; 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 "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"
- "Command for converting a GIF to an X-Face."
+(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
+ "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 '(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."
;;;###autoload
(defun gnus-random-x-face ()
- "Insert a random X-Face header from `gnus-x-face-directory'."
+ "Return X-Face header data chosen randomly from `gnus-x-face-directory'."
(interactive)
(when (file-exists-p gnus-x-face-directory)
(let* ((files (directory-files gnus-x-face-directory t "\\.pbm$"))
(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'."
+ (interactive)
+ (let ((data (gnus-random-x-face)))
+ (save-excursion
+ (message-goto-eoh)
+ (if data
+ (insert "X-Face: " data)
+ (message
+ "No face returned by `gnus-random-x-face'. Does %s/*.pbm exist?"
+ gnus-x-face-directory)))))
+
;;;###autoload
(defun gnus-x-face-from-file (file)
- "Insert an X-Face header based on an image file."
- (interactive "fImage file name:" )
+ "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
- (shell-quote-argument file)))))
-
-(defun gnus-convert-image-to-gray-x-face (file depth)
- (let* ((mapfile (make-temp-name (expand-file-name "gnus." mm-tmp-directory)))
- (levels (expt 2 depth))
- (step (/ 255 (1- levels)))
- color-alist bits bits-list mask pixel x-faces)
- (with-temp-file mapfile
- (insert "P3\n")
- (insert (format "%d 1\n" levels))
- (insert "255\n")
- (dotimes (i levels)
- (insert (format "%d %d %d\n"
- (* step i) (* step i) (* step i)))
- (push (cons (* step i) i) color-alist)))
- (when (file-exists-p file)
- (with-temp-buffer
- (insert (gnus-shell-command-to-string
- (format "giftopnm %s | ppmnorm | pnmscale -width 48 -height 48 | ppmquant -fs -map %s | ppmtopgm | pnmnoraw"
- (shell-quote-argument file)
- mapfile)))
- (goto-char (point-min))
- (forward-line 3)
- (while (setq pixel (ignore-errors (read (current-buffer))))
- (push (cdr (assq pixel color-alist)) bits-list))
- (setq bits-list (nreverse bits-list))
- (dotimes (bit-number depth)
- (setq mask (expt 2 bit-number))
- (with-temp-buffer
- (insert "P1\n48 48\n")
- (dolist (bits bits-list)
- (insert (if (zerop (logand bits mask)) "0 " "1 ")))
- (gnus-shell-command-on-region
- (point-min) (point-max)
- ;; the following is taken from xbmtoikon:
- "pbmtoicon | sed '/^[ ]*[*\\\\/]/d; s/[ ]//g; s/,$//' | tr , '\\012' | sed 's/^0x//; s/^/0x/' | pr -l1 -t -w22 -3 -s, | sed 's/,*$/,/' | compface")
- (push (buffer-string) x-faces))))
- (dotimes (i (length x-faces))
- (insert (if (zerop i) "X-Face:" (format "X-Face-%s:" i))
- (nth i x-faces))))
- (delete-file mapfile)))
+ (shell-quote-argument (expand-fil
projects / gnus / blobdiff