From fa56a7a11cd43eac24c5f3c74795933dd4d76259 Mon Sep 17 00:00:00 2001 From: teranisi Date: Fri, 26 Dec 2003 03:56:16 +0000 Subject: [PATCH] * 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/ChangeLog | 7 +++++++ wl/wl-demo.el | 30 ++++++++++++++++++++++++++++-- wl/wl-vars.el | 12 ++++++++++++ 3 files changed, 47 insertions(+), 2 deletions(-) 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 + * 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." -- 1.7.10.4