diff options
Diffstat (limited to 'lisp/gnus/gnus-fun.el')
| -rw-r--r-- | lisp/gnus/gnus-fun.el | 110 |
1 files changed, 81 insertions, 29 deletions
diff --git a/lisp/gnus/gnus-fun.el b/lisp/gnus/gnus-fun.el index 1c9b4ceaf94..2a535cb71dd 100644 --- a/lisp/gnus/gnus-fun.el +++ b/lisp/gnus/gnus-fun.el @@ -1,6 +1,6 @@ ;;; gnus-fun.el --- various frivolous extension functions to Gnus -;; Copyright (C) 2002-2013 Free Software Foundation, Inc. +;; Copyright (C) 2002-2015 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> ;; Keywords: news @@ -24,10 +24,6 @@ ;;; Code: -;; For Emacs <22.2 and XEmacs. -(eval-and-compile - (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) - (eval-when-compile (require 'cl)) @@ -44,6 +40,24 @@ :group 'gnus-fun :type 'directory) +(defcustom gnus-x-face-omit-files nil + "Regexp to match faces in `gnus-x-face-directory' to be omitted." + :version "25.1" + :group 'gnus-fun + :type 'string) + +(defcustom gnus-face-directory (expand-file-name "faces" gnus-directory) + "*Directory where Face PNG files are stored." + :version "25.1" + :group 'gnus-fun + :type 'directory) + +(defcustom gnus-face-omit-files nil + "Regexp to match faces in `gnus-face-directory' to be omitted." + :version "25.1" + :group 'gnus-fun + :type 'string) + (defcustom gnus-convert-pbm-to-x-face-command "pbmtoxbm %s | compface" "Command for converting a PBM to an X-Face." :version "22.1" @@ -86,35 +100,57 @@ PNG format." nil shell-command-switch command))) ;;;###autoload -(defun gnus-random-x-face () - "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$")) - (file (nth (random (length files)) files))) +(defun gnus--random-face-with-type (dir ext omit fun) + "Return file from DIR with extension EXT, omitting matches of OMIT, processed by FUN." + (when (file-exists-p dir) + (let* ((files + (remove nil (mapcar + (lambda (f) (unless (string-match (or omit "^$") f) f)) + (directory-files dir t ext)))) + (file (nth (random (length files)) files))) (when file - (gnus-shell-command-to-string - (format gnus-convert-pbm-to-x-face-command - (shell-quote-argument file))))))) + (funcall fun file))))) +;;;###autoload (autoload 'message-goto-eoh "message" nil t) +(autoload 'message-insert-header "message" nil t) + +(defun gnus--insert-random-face-with-type (fun type) + "Get a random face using FUN and insert it as a header TYPE. + +For instance, to insert an X-Face use `gnus-random-x-face' as FUN + and \"X-Face\" as TYPE." + (let ((data (funcall fun))) + (save-excursion + (if data + (progn (message-goto-eoh) + (insert type ": " data "\n")) + (message + "No face returned by the function %s." (symbol-name fun)))))) + + + +;;;###autoload +(defun gnus-random-x-face () + "Return X-Face header data chosen randomly from `gnus-x-face-directory'. + +Files matching `gnus-x-face-omit-files' are not considered." + (interactive) + (gnus--random-face-with-type gnus-x-face-directory "\\.pbm$" gnus-x-face-omit-files + (lambda (file) + (gnus-shell-command-to-string + (format gnus-convert-pbm-to-x-face-command + (shell-quote-argument file)))))) ;;;###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))))) + (gnus--insert-random-face-with-type 'gnus-random-x-face 'X-Face)) ;;;###autoload (defun gnus-x-face-from-file (file) - "Insert an X-Face header based on an image file. + "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." @@ -126,7 +162,7 @@ different input formats." ;;;###autoload (defun gnus-face-from-file (file) - "Return a Face header based on an image file. + "Return a Face header based on an image FILE. Depending on `gnus-convert-image-to-face-command' it may accept different input formats." @@ -191,6 +227,21 @@ FILE should be a PNG file that's 48x48 and smaller than or equal to (buffer-size))) (gnus-face-encode))) +;;;###autoload +(defun gnus-random-face () + "Return randomly chosen Face from `gnus-face-directory'. + +Files matching `gnus-face-omit-files' are not considered." + (interactive) + (gnus--random-face-with-type gnus-face-directory "\\.png$" + gnus-face-omit-files + 'gnus-convert-png-to-face)) + +;;;###autoload +(defun gnus-insert-random-face-header () + "Insert a random Face header from `gnus-face-directory'." + (gnus--insert-random-face-with-type 'gnus-random-face 'Face)) + (defface gnus-x-face '((t (:foreground "black" :background "white"))) "Face to show X-Face. The colors from this face are used as the foreground and background @@ -214,7 +265,7 @@ colors of the displayed X-Faces." (article-narrow-to-head) (gnus-article-goto-header "from") (when (bobp) - (insert "From: [no `from' set]\n") + (insert "From: [no 'from' set]\n") (forward-char -17)) (gnus-add-image 'xface @@ -250,20 +301,21 @@ colors of the displayed X-Faces." (interactive) (shell-command "xawtv-remote snap ppm") (let ((file nil) + (tempfile (make-temp-file "gnus-face-" nil ".ppm")) result) (while (null (setq file (directory-files "/tftpboot/sparky/tmp" t "snap.*ppm"))) (sleep-for 1)) (setq file (car file)) (shell-command - (format "pnmcut -left 110 -top 30 -width 144 -height 144 '%s' | pnmscale -width 48 -height 48 | ppmtopgm > /tmp/gnus.face.ppm" - file)) + (format "pnmcut -left 110 -top 30 -width 144 -height 144 '%s' | pnmscale -width 48 -height 48 | ppmtopgm >> %s" + file tempfile)) (let ((gnus-convert-image-to-face-command (format "cat '%%s' | ppmquant %%d | ppmchange %s | pnmtopng" (gnus-fun-ppm-change-string)))) - (setq result (gnus-face-from-file "/tmp/gnus.face.ppm"))) + (setq result (gnus-face-from-file tempfile))) (delete-file file) - ;;(delete-file "/tmp/gnus.face.ppm") + ;;(delete-file tempfile) ; FIXME why are we not deleting it?! result)) (defun gnus-fun-ppm-change-string () |