[gnus git] branch master updated: m0-9-5-g620f7dd =1= Add support for random Face headers

Lars Ingebrigtsen <[email protected]>
Newsgroups gmane.emacs.gnus.cvs
Message-ID <[email protected]>
       via  620f7dd653e097f1b7b088d5c9c5cecd5e81df64 (commit)
      from  1ca214b3cc4e7f9548424cc38fc8ee9f57f8dcad (commit)


- Log -----------------------------------------------------------------
commit 620f7dd653e097f1b7b088d5c9c5cecd5e81df64
Author: Rasmus Pank Roulund <[email protected]>
Date:   Fri Jan 31 15:46:46 2014 -0800

    Add support for random Face headers
    
    * gnus-fun.el (gnus-x-face-omit-files): Regexp to omit matched results
    from random face commands.
    (gnus-face-directory): Like `gnus-x-face-directory` for png files and
    Face.
    (gnus-face-omit-files): Like `gnus-x-face-omit-files` for Face.
    (gnus--random-face-with-type): Generic function returning a face-type
    as a string.
    (gnus--insert-random-face-with-type): Generic function inserting a face
    in a message buffer header.
    (gnus-random-x-face): Rewritten to use `gnus--random-face-with-type`.
    (gnus-insert-random-x-face-header): Rewritten to use
    `gnus--insert-random-face-with-type`.
    (gnus-random-face): Return random (png) Face as string.
    (nus-insert-random-face-header): Insert random (png) Face in a message
    buffer.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index bbc1508..b0814fb 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,21 @@
+2013-09-04  Rasmus Pank Roulund  <[email protected]>
+
+	* gnus-fun.el (gnus-x-face-omit-files): Regexp to omit matched results
+	from random face commands.
+	(gnus-face-directory): Like `gnus-x-face-directory` for png files and
+	Face.
+	(gnus-face-omit-files): Like `gnus-x-face-omit-files` for Face.
+	(gnus--random-face-with-type): Generic function returning a face-type
+	as a string.
+	(gnus--insert-random-face-with-type): Generic function inserting a face
+	in a message buffer header.
+	(gnus-random-x-face): Rewritten to use `gnus--random-face-with-type`.
+	(gnus-insert-random-x-face-header): Rewritten to use
+	`gnus--insert-random-face-with-type`.
+	(gnus-random-face): Return random (png) Face as string.
+	(nus-insert-random-face-header): Insert random (png) Face in a message
+	buffer.
+
 2014-01-31  Lars Ingebrigtsen  <[email protected]>
 
 	* mm-url.el: Remove all usage of w3.
diff --git a/lisp/gnus-fun.el b/lisp/gnus-fun.el
index 5007682..0ffa71d 100644
--- a/lisp/gnus-fun.el
+++ b/lisp/gnus-fun.el
@@ -44,6 +44,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 "24.3"
+  :group 'gnus-fun
+  :type 'string)
+
+(defcustom gnus-face-directory (expand-file-name "faces" gnus-directory)
+  "*Directory where Face PNG files are stored."
+  :version "24.3"
+  :group 'gnus-fun
+  :type 'directory)
+
+(defcustom gnus-face-omit-files nil
+  "Regexp to match faces in `gnus-face-directory' to be omitted."
+  :version "24.3"
+  :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 +104,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$"))
+(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 +166,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 +231,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 randome 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

-----------------------------------------------------------------------
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we listed those
revisions in full, above.

Summary of changes:
 lisp/ChangeLog   |   18 +++++++++++
 lisp/gnus-fun.el |   93 +++++++++++++++++++++++++++++++++++++++++++-----------
 2 files changed, 92 insertions(+), 19 deletions(-)

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "Gnus Project".

The branch, master has been updated


hooks/post-receive
-- 
Gnus Project
lmpx.com only provides a reader for public news (NNTP) servers. It is not affiliated with the servers or forums shown here and is not responsible for the content of articles, which is written by their respective authors.