[Mew-dist 2646] show X-Face like XEmacs

KORIYAMA Naohiro koriyama at example.com
1997年 10月 23日 (木) 02:26:11 JST


Emacs,MuleでX-FaceをXEmacsのように、Fromの隣に表示させるためのパッチで
す。(mew 1.92b7のmew-hilight.elへのパッチ)

使用するには、
mew-opt-highlight-x-face を t にすればよいです。
あと、tmもしくは、{bitmap-muleとapel}がインストールされていなければな
りません。

このパッチは、x-face-muleを元に作成しました。
Emacs-Lispの知識のほとんどない私が、2時間ぐらいのやっつけ仕事で作った
ものですから、間違っているところや無駄なところもあると思います。
詳しい方、手直ししていただけると幸いです。

# 依然、14dotでのX-Faceの表示はうまくいかず…
--
こおりやま@いえ
-------------- next part --------------
--- mew-1.92.orig/mew-highlight.el	Wed Oct 22 10:39:39 1997
+++ mew-1.92/mew-highlight.el	Thu Oct 23 01:40:41 1997
@@ -265,9 +265,86 @@
 				 xface))))))))
 	      )))
  (t
-  (defvar mew-opt-highlight-x-face-function nil
-    "*On Text Emacs, this function is called if mew-opt-highlight-x-face
-is non nil. This is a temporary solution.")
+  (require 'std11)
+  (require 'bitmap)
+  (defvar uncompface-program "uncompface")
+  (defvar mew-opt-highlight-x-face-function 
+    (function (lambda (beg end)
+				(interactive)
+				(if (and window-system mew-opt-highlight-x-face)
+					(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 " "))))
+						  )))))))
   )
  )
 


Mew-dist メーリングリストの案内