[Mew-dist 2726] Re: show X-Face like XEmacs

[KORIYAMA Naohiro]

ほんとうに度々もうしわけないです。
先程、[Mew-dist 2718]で出した、mew-xface-mule.elなんですが、付け加え忘
れた機能があったので、出してしまいます。

(mew-toggle-x-face-type) x-faceの表示タイプのtoggle
です。
# 複数付いてくるX-Face(geometry付きのもの)とかにも対応しようかと、考え
# 中。なにかいいアイデアがあったら、教えてください。
--
こおりやま
-------------- next part --------------
;;; mew-xface-mule.el -- show X-Face in Mew message buffer for Emacs, MULE

;;; Copyright (C) 1997 KORIYAMA Naohiro
;;; Author: KORIYAMA Naohiro <koriyama at example.com>
;;; Version: 0.02
;;; Created: 1997/10/24
;;; Revised: 1997/10/24
;;; Keywords: mew, X-Face, bitmap, Emacs, MULE

;;; This program is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 2, or (at your option)
;;; any later version.
;;;
;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Emacs; see the file COPYING.  If not, write to the
;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;;; Boston, MA 02111-1307, USA.

;;; [USAGE]
;;; 1. you must prepare "bitmap-mule" package and related packages.
;;;    also "compface.tar.gz" (uncompface)
;;; 2. add the following in your .emacs
;;;    (if window-system
;;;      (progn
;;;        (require 'mew-xface-mule)
;;;        (setq mew-opt-highlight-x-face t)))
;;; 3. that's all! (?)
;;;
;;; [CUSTOMIZATION]
;;; 1. if you don't want to show X-Face by the side of "From:" field, 
;;;    you should add the following in your .emacs
;;;    (setq mew-opt-highlight-x-face-type 'xface)
;;;    and you will look X-Face by the side of "X-Face:" field.
;;;
;;; [USER FUNCTION]
;;; (mew-toggle-x-face-type) toggle show method. from->xface->nil->from...
;;;
;;; [TODO & WANT]
;;; 1. show multiple X-Face and color X-Face (maybe impossible -- color)
;;; 2. cool code!
;;; 3. easy operation (menu bar etc)
;;; 4. and many many thing

;;; Code:
(require 'x-face-mule)

(defvar mew-opt-highlight-x-face-type 'from
  "*Where to show X-Face.
'from is side of From: field, 'xface is side of X-Face: field.")

(setq mew-opt-highlight-x-face-function 
	  (function
	   (lambda (beg end)
		 (interactive)
		 (if (and window-system mew-opt-highlight-x-face)
			 (cond 
			  ((equal mew-opt-highlight-x-face-type 'from)
			   (x-face-decode-message-header-to-from))
			  ((equal mew-opt-highlight-x-face-type 'xface)
			   (x-face-decode-message-header-to-xface)))))))

;;; functions

;;; toggle x-face-type
(defun mew-toggle-x-face-type ()
  (interactive)
  (cond ((equal mew-opt-highlight-x-face-type 'from)
		 (message "Show X-Face side by X-Face:")
		 (setq mew-opt-highlight-x-face-type 'xface))
		((equal mew-opt-highlight-x-face-type 'xface)
		 (message "Don't Show X-Face")
		 (setq mew-opt-highlight-x-face-type nil))
		(t
		 (message "Show X-Face side by From:")
		 (setq mew-opt-highlight-x-face-type 'from)))
  (mew-summary-display))

;;; show X-Face by the side of X-Face: field. 
(defalias 'x-face-decode-message-header-to-xface 'x-face-decode-message-header)

;;; show X-Face by the side of From: field. 
;;; originate from 'x-face-decode-message-header () in x-face-mule.el
(defun x-face-decode-message-header-to-from ()
  (let (i k k+6 cmp temp)
	(save-restriction
	  (std11-narrow-to-header)
	  (goto-char (point-min))
	  (if (re-search-forward "^X-Face:[ \t]*" nil t)
		  (let ((p (match-beginning 0))
				(beg (match-end 0))
				(end (std11-field-end))
				(cur-buf (current-buffer)))
			(if (< end (point-max))
				(setq end (1+ end)))
			(save-restriction
			  (narrow-to-region p end)
			  (delete-region p beg)
			  (call-process-region p (point-max)
								   uncompface-program t t nil)
			  (goto-char (point-min))
			  (search-forward "0x" nil t)
			  (setq cmp (make-vector 18 nil))
			  (setq i 0)
			  (while (< i 48)
				(setq k (* (/ i 16) 6))
				(setq k+6 (+ k 6))
				(while (< k k+6)
				  (setq temp (buffer-substring (point)
											   (+ (point) 2)))
				  (aset cmp k (concat (aref cmp k) temp))
				  (setq k (1+ k))
				  (setq temp (buffer-substring (+ (point) 2)
											   (+ (point) 4)))
				  (aset cmp k (concat (aref cmp k) temp))
				  (setq k (1+ k))
				  (search-forward "0x" nil t))
				(setq i (1+ i)))
			  (delete-region (point-min)(point-max)))
			(goto-char (point-min))
			(re-search-forward "^From:[ \t]*" nil t)
			(let ((p (match-beginning 0))
				  (beg (match-end 0))
				  (end (std11-field-end))
				  (cur-buf (current-buffer)))
			  (if (< end (point-max))
				  (setq end (1+ end)))
			  (save-restriction
				(narrow-to-region p end)
				(goto-char p)
				(setq k 0)
				(setq i 0)
				(while (< i 2)
				  (insert "      ")
				  (setq k (* i 6)
						k+6 (+ k 6))
				  (while (< k k+6)
					(insert (bitmap-compose (aref cmp k)))
					(setq k (1+ k))
					)
				  (insert ?\n)
				  (setq i (1+ i)))
				(re-search-forward "^From:[ \t]*" nil t)
				(setq p (match-end 0))
				(goto-char p)
				(setq k (* i 6)
					  k+6 (+ k 6))
				(while (< k k+6)
				  (insert (bitmap-compose (aref cmp k)))
				  (setq k (1+ k)))
				(insert " "))))))))

(provide 'mew-xface-mule)

;;; mew-xface-mule.el ends here