parameters.
* gnus-art.el (article-display-x-face): Use optional parameters.
* gnus-ems.el (gnus-create-image): Take optional parameters.
* gnus-fun.el (gnus-convert-gray-x-face-to-xpm): Use uncompface.
* compface.el (compface-xbm-p): Removed.
* gnus-ems.el (gnus-article-compface-xbm): Removed.
(gnus-article-display-xface): Use compface.
* compface.el: New file.
* gnus-fun.el (gnus-convert-pbm-to-x-face-command): Remove quotes.
(gnus-convert-image-to-x-face-command): Ditto.
(gnus-random-x-face): Quote argument.
(gnus-x-face-from-file): Ditto.
+2002-01-03 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-xmas.el (gnus-xmas-create-image): Take optional
+ parameters.
+
+ * gnus-art.el (article-display-x-face): Use optional parameters.
+
+ * gnus-ems.el (gnus-create-image): Take optional parameters.
+
+ * gnus-fun.el (gnus-convert-gray-x-face-to-xpm): Use uncompface.
+
+ * compface.el (compface-xbm-p): Removed.
+
+ * gnus-ems.el (gnus-article-compface-xbm): Removed.
+ (gnus-article-display-xface): Use compface.
+
+ * compface.el: New file.
+
+ * gnus-fun.el (gnus-convert-pbm-to-x-face-command): Remove quotes.
+ (gnus-convert-image-to-x-face-command): Ditto.
+ (gnus-random-x-face): Quote argument.
+ (gnus-x-face-from-file): Ditto.
+
2002-01-03 Paul Jarc <prj@po.cwru.edu>
* nnmaildir.el (nnmaildir-request-expire-articles): evaluate
--- /dev/null
+;;; compface.el --- functions for converting X-Face headers
+;; Copyright (C) 2002 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
+;; 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.
+
+;; 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
+;; 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.
+
+;;; Commentary:
+
+;;; Code:
+
+;;;###
+(defun uncompface (face)
+ "Convert FACE to pbm.
+Requires the external programs `uncompface', and `icontopbm'. On a
+GNU/Linux system these might be in packages with names like `compface'
+or `faces-xface' and `netpbm' or `libgr-progs', for instance. See
+also `compface-xbm-p'."
+ (with-temp-buffer
+ (insert face)
+ (and (eq 0 (apply #'call-process-region (point-min) (point-max)
+ "uncompface"
+ 'delete '(t nil) nil))
+ (progn
+ (goto-char (point-min))
+ (progn (insert "/* Width=48, Height=48 */\n") t)
+ (eq 0 (call-process-region (point-min) (point-max)
+ "icontopbm"
+ 'delete '(t nil))))
+ (buffer-string))))
+
+(provide 'compface)
+
+;;; compface.el ends here
(setq from (message-fetch-field "from"))))
(if grey
(gnus-put-image
- (create-image (gnus-convert-gray-x-face-to-xpm x-faces) 'xpm t))
+ (gnus-create-image
+ (gnus-convert-gray-x-face-to-xpm x-faces) 'xpm t))
;; Sending multiple EOFs to xv doesn't work, so we only do a
;; single external face.
(when (stringp gnus-article-x-face-command)
(defvar gnus-article-xface-ring-size 6
"Length of the ring used for `gnus-article-xface-ring-internal'.")
-(defvar gnus-article-compface-xbm
- (condition-case ()
- (eq 0 (string-match "#define"
- (shell-command-to-string "uncompface -X")))
- (error nil))
- "Non-nil means the compface program supports the -X option.
-That produces XBM output.")
-
(defun gnus-article-display-xface (data)
"Display the XFace header FACE in the current buffer.
Requires support for images in your Emacs and the external programs
(let* ((cur (current-buffer))
(image (cdr-safe (assoc data (ring-elements
gnus-article-xface-ring-internal))))
- default-enable-multibyte-characters)
+ default-enable-multibyte-characters
+ face)
(unless image
- (with-temp-buffer
- (insert data)
- (and (eq 0 (apply #'call-process-region (point-min) (point-max)
- "uncompface"
- 'delete '(t nil) nil
- (if gnus-article-compface-xbm
- '("-X"))))
- (if gnus-article-compface-xbm
- t
- (goto-char (point-min))
- (progn (insert "/* Width=48, Height=48 */\n") t)
- (eq 0 (call-process-region (point-min) (point-max)
- "icontopbm"
- 'delete '(t nil))))
- ;; Miles Bader says that faces don't look right as
- ;; light on dark.
- (if (eq 'dark (cdr-safe (assq 'background-mode
- (frame-parameters))))
- (setq image (create-image (buffer-string)
- (if gnus-article-compface-xbm
- 'xbm
- 'pbm)
- t
- :ascent 'center
- :foreground "black"
- :background "white"))
- (setq image (create-image (buffer-string)
- (if gnus-article-compface-xbm
- 'xbm
- 'pbm)
- t
- :ascent 'center)))))
+ (when (setq face (uncompface data))
+ ;; Miles Bader says that faces don't look right as
+ ;; light on dark.
+ (if (eq 'dark (cdr-safe (assq 'background-mode
+ (frame-parameters))))
+ (setq image (create-image face 'pbm
+ t
+ :ascent 'center
+ :foreground "black"
+ :background "white"))
+ (setq image (create-image face 'pbm
+ t :ascent 'center))))
(ring-insert gnus-article-xface-ring-internal (cons data image)))
(when image
(goto-char (point-min))
(and (fboundp 'image-type-available-p)
(image-type-available-p type)))
-(defun gnus-create-image (file)
- (create-image file))
+(defun gnus-create-image (file &optional type data-p)
+ (create-image file type data-p))
(defun gnus-put-image (glyph &optional string)
(insert-image glyph string))
:group 'gnus-fun
:type 'directory)
-(defcustom gnus-convert-pbm-to-x-face-command "pbmtoxbm '%s' | compface"
+(defcustom gnus-convert-pbm-to-x-face-command "pbmtoxbm %s | compface"
"Command for converting a PBM to an X-Face."
:group 'gnus-fun
:type 'string)
-(defcustom gnus-convert-image-to-x-face-command "giftopnm '%s' | ppmnorm 2>/dev/null | pnmscale -width 48 -height 48 | ppmtopgm | pgmtopbm | pbmtoxbm | compface"
+(defcustom gnus-convert-image-to-x-face-command "giftopnm %s | ppmnorm 2>/dev/null | pnmscale -width 48 -height 48 | ppmtopgm | pgmtopbm | pbmtoxbm | compface"
"Command for converting a GIF to an X-Face."
:group 'gnus-fun
:type 'string)
(file (nth (random (length files)) files)))
(when file
(shell-command-to-string
- (format gnus-convert-pbm-to-x-face-command file))))))
+ (format gnus-convert-pbm-to-x-face-command
+ (shell-quote-argument file)))))))
;;;###autoload
(defun gnus-x-face-from-file (file)
(interactive "fImage file name:" )
(when (file-exists-p file)
(shell-command-to-string
- (format gnus-convert-image-to-x-face-command file))))
+ (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)))
(push (cons (* step i) i) color-alist)))
(when (file-exists-p file)
(with-temp-buffer
- (insert (shell-command-to-string (format "giftopnm '%s' | ppmnorm 2>/dev/null | pnmscale -width 48 -height 48 | ppmquant -fs -map %s 2>/dev/null | ppmtopgm | pnmnoraw"
- file mapfile)))
+ (insert (shell-command-to-string
+ (format "giftopnm %s | ppmnorm 2>/dev/null | pnmscale -width 48 -height 48 | ppmquant -fs -map %s 2>/dev/null | ppmtopgm | pnmnoraw"
+ (shell-quote-argument file)
+ mapfile)))
(goto-char (point-min))
(forward-line 3)
(while (setq pixel (ignore-errors (read (current-buffer))))
bit-list bit-lists pixels pixel)
(dolist (face faces)
(with-temp-buffer
- (insert face)
+ (insert (uncompface face))
(shell-command-on-region
(point-min) (point-max)
- "uncompface -X | xbmtopbm | pnmnoraw"
+ "pnmnoraw"
(current-buffer) t)
(goto-char (point-min))
(forward-line 2)
(defun gnus-xmas-image-type-available-p (type)
(featurep type))
-(defun gnus-xmas-create-image (file)
- (let ((type (car (last (split-string file "[.]")))))
+(defun gnus-xmas-create-image (file &optional type data-p)
+ (let ((type (if type
+ (symbol-name type)
+ (car (last (split-string file "[.]"))))))
(if (equal type "xbm")
(make-glyph (list (cons 'x file)))
- (with-temp-buffer
- (insert-file-contents file)
- (mm-create-image-xemacs type)))))
+ (with-tmp-buffer
+ (if data-p
+ (insert file)
+ (insert-file-contents file))
+ (make-glyph
+ (vector
+ (or (mm-image-type-from-buffer)
+ (intern type))
+ :data (buffer-string)))))))
(defun gnus-xmas-put-image (glyph &optional string)
"Insert STRING, but display GLYPH.
gnus-unplugged gnus-agentize gnus-agent-batch)
("gnus-vm" :interactive t gnus-summary-save-in-vm
gnus-summary-save-article-vm)
+ ("compface" uncompface)
("gnus-draft" :interactive t gnus-draft-mode gnus-group-send-queue)
("gnus-mlspl" gnus-group-split gnus-group-split-fancy)
("gnus-mlspl" :interactive t gnus-group-split-setup
projects / gnus / commitdiff