[Mew-Win32 01985] summary の色づけ

[Hideyuki SHIRAI ( 白井秀行 )]

白井です。(やっぱり、こういうのはこちら、ということで。。。)

# だけど、sen さんに Cc: つき。:-)

(あくまで冗談として) summary に色づけするのものを作ってみました。

サンプルを

http://www.netLaputa.ne.jp/~hshirai/Image/summary1.png
http://www.netLaputa.ne.jp/~hshirai/Image/summary2.png
http://www.netLaputa.ne.jp/~hshirai/Image/summary3.png

に置いておきましたので、見てみて下さい。次ページのものを
~/.emacs にでも書けばとりあえず色がつくのですが、

1. 遅い。
2. きっと Emacs にやさしくない。
3. 人によって全然 form が違うから、汎用的なのは書けなかった。だ
 から、自分で改造しないといけないし、当然、ある程度の elisp の知
 識を要求する。

という弱点があります。

;; summary の色づけ
(cond
 (window-system
  (add-hook
   'mew-init-hook
   '(lambda ()


      ;; 趣味で色とか書体とか指定してね
      (if (or (facep 'mew-summary-from-face)
	      (and (fboundp 'find-face)
		   (find-face 'mew-summary-from-face)))
	  ()
	(make-face 'mew-summary-from-face)
	(copy-face 'bold 'mew-summary-from-face)
	(set-face-foreground 'mew-summary-from-face "Purple"))

      (if (or (facep 'mew-summary-to-face)
	      (and (fboundp 'find-face)
		   (find-face 'mew-summary-to-face)))
	  ()
	(make-face 'mew-summary-to-face)
	(copy-face 'bold-italic 'mew-summary-to-face)
	(set-face-foreground 'mew-summary-to-face "DarkOrange3"))

      (if (or (facep 'mew-summary-subject-face)
	      (and (fboundp 'find-face)
		   (find-face 'mew-summary-subject-face)))
	  ()
	(make-face 'mew-summary-subject-face)
	(copy-face 'bold 'mew-summary-subject-face)
	(set-face-foreground 'mew-summary-subject-face "DarkGreen"))

      (if (or (facep 'mew-summary-ml-face)
	      (and (fboundp 'find-face)
		   (find-face 'mew-summary-ml-face)))
	  ()
	(make-face 'mew-summary-ml-face)
	(copy-face 'bold-italic 'mew-summary-ml-face)
	(set-face-foreground 'mew-summary-ml-face "ForestGreen"))

      (if (or (facep 'mew-summary-body-face)
	      (and (fboundp 'find-face)
		   (find-face 'mew-summary-body-face)))
	  ()
	(make-face 'mew-summary-body-face)
	(copy-face 'italic 'mew-summary-body-face)
	(set-face-foreground 'mew-summary-body-face "Grey50"))

;;; ~/.im/Config で設定する Form で全然処理が変わってしまう。
;;; default はこうなのだけど、
;;; Form=%+5n %m%d %-14A %S || %b	# default format for scanning
;;;
;;; 白井の場合はこうなっていて、
;;; imget.Form=%+4n %m%d %h:%E %+2KK %-24A %S || %b	# for imget
;;; Form=%+4n %m%d/%y %+3KK %-24A %S || %b		# for imls
;;; なおかつ %+4n や %3Kk がモノ(環境)によって幅が違うから、"K"
;;; で引っかけてみる。

      (setq mew-summary-hl-start-regex "^[^K]+K ") ;; ほとんど白井専用 ^^;
      ;; 固定 format 向け (2byte 文字は無いだろうから) '.' の数
      ;; で調節してみたりする
      ;; (setq mew-summary-hl-start-regex "^............ ")
      (setq mew-summary-hl-from-width 24) ;; %-nnA の数字を書いてね
      ;; 以下、結構いい加減な regexp が続く。。。
      ;; [mew-dist nnn] や (pgp-users nnn) の色を変えてみる
      (setq mew-summary-hl-ml " *\\([\[(][^])]*[\])]\\)")
      ;; %b が表示されているとき用の regexp
      (setq mew-summary-hl-subject-regex1 " *\\(.*\\) +\\(\|\|[^\n\r]*\\)")
      ;; %b が表示されていないとき用の regexp
      ;; summary の最後に '|' が出ても色づけしてしまうし
      (setq mew-summary-hl-subject-regex2 " *\\([^\n\r]*\\)")

      (defun mew-summary-highlight-region (beg end)
	(interactive "r")
	(and (> (- end beg) 256)
	     (message "summary face making ... "))
	(save-excursion
	  (mew-elet
	   (goto-char beg)
	   (while (< (point) end)
	     (if (not (re-search-forward mew-summary-hl-start-regex nil t))
		 ()
	       (goto-char (match-end 0))
	       (if (looking-at "To:")
		   (put-text-property (point)
				      (progn (move-to-column (+ (current-column)
								mew-summary-hl-from-width))
					     (point))
				      'face 'mew-summary-to-face)
		 (put-text-property (point)
				    (progn (move-to-column (+ (current-column)
							      mew-summary-hl-from-width))
					   (point))
				    'face 'mew-summary-from-face))
	       (if (not (looking-at mew-summary-hl-ml))
		   ()
		 (put-text-property (match-beginning 1) (match-end 1)
				    'face 'mew-summary-ml-face)
		 (goto-char (match-end 0)))
	       (if (not (looking-at mew-summary-hl-subject-regex1))
		   (if (looking-at mew-summary-hl-subject-regex2)
		       (put-text-property (match-beginning 1) (match-end 1)
					  'face 'mew-summary-subject-face))
		 (put-text-property (match-beginning 1) (match-end 1)
				    'face 'mew-summary-subject-face)
		 (put-text-property (match-beginning 2) (match-end 2)
				    'face 'mew-summary-body-face)))
	     (forward-line))))
	(and (> (- end beg) 256)
	     (message "summary face making ... done.")))

      (defadvice mew-highlight-mark-region (after summary-highlight activate)
	(mew-summary-highlight-region beg end))

      (defadvice mew-highlight-unmark-line (after summary-highlight activate)
	(save-excursion
	  (mew-summary-highlight-region
	   (progn (beginning-of-line) (point))
	   (progn (forward-line) (point)))))

;; これから下は、人によりけり。
;;;      (defadvice mew-summary-virtual-review (after summary-highlight activate)
;;;	(mew-summary-highlight-region (point-min) (point-max)))

;;;      (defadvice mew-nmz-virtual (after summary-highlight activate)
;;;	(mew-summary-highlight-region (point-min) (point-max)))
      ))))

-- 
白井秀行＠本当に冗談なので、あまり深く考えていません。(__)