[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 メーリングリストの案内