[Mew-dist 12073] Re: mew-summary-hl でこんなこと...
Hideyuki SHIRAI ( 白井秀行 )
shirai at example.com
2000年 1月 19日 (水) 12:20:14 JST
Mew-Win32 方面で
From: Ichiro Murata <ichigo at example.com> さん曰く
Subject: [Mew-Win32 02350] mew-summary-hlでこんなこと...
Message-ID: <20000114.224256.00601862.ichigo at example.com>
Date: Fri, 14 Jan 2000 22:42:56 +0900 (JST)
村田> さて、mew-summary-hlについての質問させて下さい。
村田> summary bufferで、ある特定の人から来たメールの色を変えることは出来ない
村田> でしょうか？
村田> マークのついている行に色が付くように、特定の人（例えばAddrbookに登録さ
村田> れている人）からのメールに自動的に色を付けるということがやってみたいん
村田> です。
というリクエストがあり、やってみました。
default 状態は従来と変わりませんが、
(setq mew-summary-hl-special-persons
'("Kazu Yamamoto (山本和彦)"
"Shuichi KITAGUCHI (北口修一)"
"Hideyuki SHIRAI (白井秀行)"
"hoge Hogeo"))
と設定すると、その人の表示部分は別の色が付きます。
~~~~~~~~ .im/Config:Form の %-14A の部分
(setq mew-summary-hl-special-use-addrbook t)
とすると Addrbook で nickname が設定されている人も色が変わります。
二つの変数は独立なので、片方のみ設定、両方設定ができます。
また、従来、face の設定は XEmacs の read-passwd の bug 対応のた
めに立ち上げ時のみだったのですが、あの bug ももう収まったような
ので、Mew の立ち上げ時と、'Z' のときに face の設定と特別な人の設
定を行なうようにしました。
--
白井秀行 (mailto:shirai at example.com)
-------------- next part --------------
--- mew-summary-hl.el 1999-09-28 19:31:39+09 1.7
+++ mew-summary-hl.el 2000-01-19 12:03:41+09
@@ -23,12 +23,9 @@
;; (locate-library "mew-summary-hl"))
;; (eval-after-load "mew" '(require 'mew-summary-hl)))
;;
-;;;; 使用上の注意
-;;; XEmacs は良くわからないので、変だったら教えて下さい。(_ _)
-;;
(eval-when-compile (require 'mew))
-(defconst mew-summary-hl-version "mew-summary-hl 0.10")
+(defconst mew-summary-hl-version "mew-summary-hl 0.12")
;; default で対象としている ~/.im/Config の 'From' は以下の通り
;;; imget.Form=%+4n %m%d %h:%E %+2KK %-24A %S || %b
@@ -49,11 +46,22 @@
;; (setq mew-summary-hl-from-width 14)
;; あとは自分の環境に合わせて下さい。(_ _)
+;; 特別な人を設定する。
+(defvar mew-summary-hl-special-persons nil)
+;; 例えば、以下のような感じに From: の comment 部分を書く。
+;; (setq mew-summary-hl-special-persons
+;; '("hogeo HOGEMOTO (ほげもとほげお)"
+;; "Hideyuki SHIRAI (白井秀行)"
+;; "foo BAR"
+;; "\"Sin'ich\""
+;; ))
+
+;; Addrbook の nickname も特別な人にするなら non-nil にする。
+(defvar mew-summary-hl-special-use-addrbook nil)
+
;; face の書体と色はお好みで変えよう。
;; この設定だと http://www.netlaputa.ne.jp/~hshirai/Image/summary1.png
;; のようになります。
-(defvar mew-sumamry-hl-face-list '("num" "from" "to" "ml" "subject" "body"))
-
(defvar mew-summary-hl-face-num-type 'italic)
(defvar mew-summary-hl-face-num-color "Maroon")
@@ -63,6 +71,9 @@
(defvar mew-summary-hl-face-to-type 'bold-italic)
(defvar mew-summary-hl-face-to-color "DarkOrange3")
+(defvar mew-summary-hl-face-special-type 'bold-italic)
+(defvar mew-summary-hl-face-special-color "navy")
+
(defvar mew-summary-hl-face-ml-type 'italic)
(defvar mew-summary-hl-face-ml-color "DarkGreen")
@@ -75,6 +86,11 @@
;; MUE/MHC などの色づけ用関数を定義する
(defvar mew-summary-hl-external-function nil)
+;; 内部変数
+(defvar mew-summary-hl-special-list nil)
+(defvar mew-sumamry-hl-face-list
+ '("num" "from" "to" "ml" "special" "subject" "body"))
+
;; hook の追加
(add-hook 'mew-summary-mode-hook 'mew-summary-hl-enable)
(add-hook 'mew-virtual-mode-hook 'mew-summary-hl-enable)
@@ -116,30 +132,43 @@
(mew-elet
(goto-char beg)
(beginning-of-line)
- (setq beg (point))
- (remove-text-properties beg end '(face nil))
+ (remove-text-properties (point) end '(face nil))
(while (< (point) end)
(cond
;; 普通の行
((looking-at mew-summary-hl-start-regex)
(put-text-property (match-beginning 1) (match-end 1)
'face 'mew-summary-hl-face-num)
- (goto-char (match-end 0))
+ (setq beg (goto-char (match-end 0)))
(if (looking-at "To:")
;; 自分のメール
- (put-text-property (point)
+ (put-text-property beg
(progn (move-to-column
(+ (current-column)
mew-summary-hl-from-width))
(point))
'face 'mew-summary-hl-face-to)
- ;; 他の人のメール
- (put-text-property (point)
- (progn (move-to-column
- (+ (current-column)
- mew-summary-hl-from-width))
- (point))
- 'face 'mew-summary-hl-face-from))
+ (if mew-summary-hl-special-list
+ (if (member (mew-buffer-substring beg
+ (progn
+ (move-to-column
+ (+ (current-column)
+ mew-summary-hl-from-width))
+ (point)))
+ mew-summary-hl-special-list)
+ ;; 特別な人のメール
+ (put-text-property beg (point)
+ 'face 'mew-summary-hl-face-special)
+ ;; 他の人のメール
+ (put-text-property beg (point)
+ 'face 'mew-summary-hl-face-from))
+ ;; 他の人のメール
+ (put-text-property beg
+ (progn (move-to-column
+ (+ (current-column)
+ mew-summary-hl-from-width))
+ (point))
+ 'face 'mew-summary-hl-face-from)))
(if (not (looking-at mew-summary-hl-ml))
()
;; [mew-dist 0123] や (pgp-users 1234) があった
@@ -176,7 +205,7 @@
'face 'mew-summary-hl-face-num))))
(forward-line)))))
-(defun mew-summary-hl-setup ()
+(defun mew-summary-hl-face-setup ()
(let ((flist mew-sumamry-hl-face-list)
fname type color)
(mapcar
@@ -190,8 +219,55 @@
(set-face-foreground fname (symbol-value color)))
flist)))
-;; load したときに face を作ってしまう。
-(mew-summary-hl-setup)
+(defun mew-summary-hl-special-setup ()
+ (setq mew-summary-hl-special-list nil)
+ (if (and mew-summary-hl-special-persons
+ (listp mew-summary-hl-special-persons))
+ (let ((sp-list mew-summary-hl-special-persons))
+ (while sp-list
+ (if (stringp (car sp-list))
+ (setq mew-summary-hl-special-list
+ (append (list (mew-summary-hl-special-make (car sp-list)))
+ mew-summary-hl-special-list)))
+ (setq sp-list (cdr sp-list)))))
+ (if (and mew-summary-hl-special-use-addrbook
+ mew-addrbook-alist
+ (listp mew-addrbook-alist))
+ (let ((ad-list mew-addrbook-alist) nickname)
+ (while ad-list
+ (if (and (setq nickname (nth 2 (car ad-list)))
+ (stringp nickname))
+ (setq mew-summary-hl-special-list
+ (append (list (mew-summary-hl-special-make nickname))
+ mew-summary-hl-special-list)))
+ (setq ad-list (cdr ad-list))))))
+
+(defun mew-summary-hl-special-make (str)
+ (if (fboundp 'mew-string-to-list)
+ (let ((char-list (mew-string-to-list str))
+ cw (i 0) (w 0) (ow 0) (spc (string-to-char " ")))
+ (catch 'loop
+ (while char-list
+ (setq cw (mew-char-width (car char-list)))
+ (setq w (+ w cw))
+ (if (> w mew-summary-hl-from-width) (throw 'loop nil))
+ (setq ow (+ ow cw))
+ (setq i (+ i (length (char-to-string (car char-list)))))
+ (setq char-list (cdr char-list))))
+ (if (> mew-summary-hl-from-width ow)
+ (concat (substring str 0 i)
+ (make-string (- mew-summary-hl-from-width ow) spc))
+ (substring str 0 i)))
+ (let ((len (length str))
+ (spc (string-to-char " ")))
+ (if (< len mew-summary-hl-from-width)
+ (concat str (make-string (- mew-summary-hl-from-width len) spc))
+ (substring str 0 mew-summary-hl-from-width)))))
+
+;; Mew が立ち上がったときと "Z" したとき setup する。
+(defadvice mew-addrbook-setup (after hl-setup activate)
+ (mew-summary-hl-special-setup)
+ (mew-summary-hl-face-setup))
(provide 'mew-summary-hl)
Mew-dist メーリングリストの案内