From: teranisi <teranisi>
Date: Fri, 26 Dec 2003 03:56:16 +0000 (+0000)
Subject: * wl-vars.el (wl-demo-image-filter-alist): New variable
X-Git-Tag: wl-2_11_23~14
X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=fa56a7a11cd43eac24c5f3c74795933dd4d76259;p=elisp%2Fwanderlust.git

* wl-vars.el (wl-demo-image-filter-alist): New variable
(wl-demo-background-color): Ditto.

* wl-demo.el (wl-demo-xpm-set-background): New function.
(wl-demo-image-filter): Ditto.
(wl-demo-insert-image)[XEmacs,Emacs21]: Use it.
---

diff --git a/wl/ChangeLog b/wl/ChangeLog
index 518e0d5..5ab749a 100644
--- a/wl/ChangeLog
+++ b/wl/ChangeLog
@@ -1,5 +1,12 @@
 2003-12-26  Yuuichi Teranishi  <teranisi@gohome.org>
 
+	* wl-vars.el (wl-demo-image-filter-alist): New variable
+	(wl-demo-background-color): Ditto.
+
+	* wl-demo.el (wl-demo-xpm-set-background): New function.
+	(wl-demo-image-filter): Ditto.
+	(wl-demo-insert-image)[XEmacs,Emacs21]: Use it.
+
 	* wl-vars.el (wl-demo-icon-name-alist): New variable.
 
 	* wl-demo.el (wl-demo-icon-name): Define as function.
diff --git a/wl/wl-demo.el b/wl/wl-demo.el
index 39089cf..46c2f8a 100644
--- a/wl/wl-demo.el
+++ b/wl/wl-demo.el
@@ -128,6 +128,28 @@ Yet Another Message Interface On Emacsen"
 	  (delq nil (list xpm bitmap xbm '("ascii")))))
     '(("ascii"))))
 
+(defun wl-demo-xpm-set-background ()
+  "A filter function to set xpm background.
+`wl-demo-background-color' is used for the background color."
+  (when (search-forward "None" nil t)
+    (replace-match wl-demo-background-color)))
+
+(defun wl-demo-image-filter (file type)
+  "Get filtered image data.
+FILE is the image file name.
+TYPE is the filter function."
+  (let ((filter (catch 'found
+		  (dolist (pair wl-demo-image-filter-alist)
+		    (when (eq (car pair) type)
+		      (throw 'found (cdr pair)))))))
+    (with-temp-buffer
+      (set-buffer-multibyte nil)
+      (insert-file-contents file)
+      (goto-char (point-min))
+      (when filter
+	(funcall filter))
+      (buffer-string))))
+
 (defun wl-demo-insert-image (image-type)
   "Insert a logo image at the point and position it to be centered.
 IMAGE-TYPE specifies what a type of image should be displayed.
@@ -163,7 +185,9 @@ Return a number of lines that an image occupies in the buffer."
 	  (cond ((featurep 'xemacs)
 		 (setq width (window-pixel-width)
 		       height (window-pixel-height)
-		       image (make-glyph (vector image-type ':file file)))
+		       image (make-glyph (vector image-type ':data
+						 (wl-demo-image-filter
+						  file image-type))))
 		 (when (eq 'xbm image-type)
 		   (set-glyph-face image 'wl-highlight-logo-face))
 		 (insert-char ?\  (max 0 (/ (+ (* (- width (glyph-width image))
@@ -178,7 +202,9 @@ Return a number of lines that an image occupies in the buffer."
 			  (and (eq 'xbm image-type)
 			       (image-type-available-p 'xbm))))
 		 ;; Use the new redisplay engine on Emacs 21.
-		 (setq image (create-image file image-type)
+		 (setq image (create-image (wl-demo-image-filter file
+								 image-type)
+					   image-type t)
 		       width (image-size image)
 		       height (cdr width)
 		       width (car width))
diff --git a/wl/wl-vars.el b/wl/wl-vars.el
index 4cf3e50..b7ea3d7 100644
--- a/wl/wl-vars.el
+++ b/wl/wl-vars.el
@@ -493,6 +493,18 @@ You had better set this variable if you set 'wl-insert-mail-followup-to' as t."
 		       (symbol :tag "file name")))
   :group 'wl-pref)
 
+(defcustom wl-demo-image-filter-alist
+  '((xpm . wl-demo-xpm-set-background))
+  "An alist of image type and filter function."
+  :type '(repeat (cons symbol function))
+  :group 'wl-pref)
+
+(defcustom wl-demo-background-color "None"
+  "The color name for demo background.
+Used in the filter function `wl-demo-filter-xpm-background'."
+  :type '(string :tag "Color name")
+  :group 'wl-pref)
+
 (defcustom wl-envelope-from nil
   "*Envelope From used in SMTP.
 If nil, `wl-from' is used."