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

[KORIYAMA Naohiro]

[Mew-dist 2646]で、Emacs,MuleでX-Faceを、Fromの隣にinline表示させるた
めのパッチを出しましたが、今度は同じ機能(+α)をパッチという形でなく、
独立したファイルにしました。(mew-xface-mule.el)

使用するためには、
まず、前提条件として、bitmap-muleが動く必要があります。
bitmap-muleは、"tm (tools for mime)"のパッケージの中に入っています。
また、bitmap-mule単体でも配布されていますが、単体では動かないので、
apelというパッケージも必要になります。
tm等のpackageは、ftp://ftp.jaist.ac.jp/pub/elisp/mime あたりにあります。

あと、最低限必要な設定は、~/.emacsに
(if window-system
     (progn
       (require 'mew-xface-mule)
       (setq mew-opt-highlight-x-face t)))
のような感じです。

すると、X-Face が From: field の隣に表示されるはずです。

また、X-Face が From: field の隣に表示されるのが嫌いな場合は、
(setq mew-opt-highlight-x-face-type 'xface)
とかしておけば、X-Face: field の隣に表示されます。
mew-opt-highlight-x-face-typeには、fromまたはxfaceが設定できますので、
気分によって切り替えてもよいかもしれないです。(from,xface以外を設定し
た場合にはなにも表示されません。)

これで、XEmacsに移行しようとしている人の何割かを抑えられるはず(^_^;;

あと、コードとかはあらゆる意味で汚いまんまなので、修正とかしてくれる人
がいたら歓迎します。
# etl版bitmap.elでやるのは面倒そう…

# mew-1.92/contrib/x-face.elに[Mew-dist 2646]で出したのがありますが、
# できましたら、これ(mew-xface-mule.el)と置き換えていただけないでしょ
# うか > Kazuさん
--
こおりやま@かいしゃ
-------------- 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.01
;;; Created: 1997/10/24
;;; Revised: 
;;; 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.
;;; 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.
;;;
;;; [TODO]
;;; many

;;; 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)))))))

;;; 
(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-headr () 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)