X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fgnus-fun.el;h=fa78b5c6e1580ff9ba4104ae7466ff2d6984bce5;hp=08ec3c4ffb0f6e8aa1b14fe8e073ae691a6dc83e;hb=b52037f4a9c6bee1ff556c22750e158da1208d4b;hpb=ca4edeb73a031281a1f659251d035558a2b9dc6d;ds=sidebyside

diff --git a/lisp/gnus-fun.el b/lisp/gnus-fun.el
index 08ec3c4ff..fa78b5c6e 100644
--- a/lisp/gnus-fun.el
+++ b/lisp/gnus-fun.el
@@ -1,6 +1,6 @@
 ;;; gnus-fun.el --- various frivolous extension functions to Gnus
 
-;; Copyright (C) 2002-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2016 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"
@@ -85,43 +99,58 @@ PNG format."
     (call-process shell-file-name nil (list standard-output nil)
 		  nil shell-command-switch command)))
 
-(defun gnus-shell-command-on-region (start end command)
-  "A simplified `shell-command-on-region'.
-Output to the current buffer, replace text, and don't mingle error."
-  (call-process-region start end shell-file-name t
-		       (list (current-buffer) nil)
-		       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."
@@ -133,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."
@@ -198,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
@@ -221,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
@@ -257,27 +301,28 @@ 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 ()
-  (let* ((possibilites '("%02x0000" "00%02x00" "0000%02x"
-			"%02x%02x00" "00%02x%02x" "%02x00%02x"))
+  (let* ((possibilities '("%02x0000" "00%02x00" "0000%02x"
+			  "%02x%02x00" "00%02x%02x" "%02x00%02x"))
 	 (format (concat "'#%02x%02x%02x' '#"
-			 (nth (random 6) possibilites)
+			 (nth (random 6) possibilities)
 			 "'"))
 	 (values nil))
   (dotimes (i 255)
@@ -285,6 +330,10 @@ colors of the displayed X-Faces."
 	  values))
   (mapconcat 'identity values " ")))
 
+(defun gnus-funcall-no-warning (function &rest args)
+  (when (fboundp function)
+    (apply function args)))
+
 (provide 'gnus-fun)
 
 ;;; gnus-fun.el ends here