[Mew-dist 17688] mew-fancy-summary.el
Shun-ichi TAHARA ( 田原 俊一 )
jado at example.com
2001年 6月 6日 (水) 13:43:11 JST
ちょっと気が向いたので、mew-summary-hl に手を入れてみました。
中身がまるっきり変わってしまいましたので、名前を mew-fancy-summary に
変えて流します。
[mew-summary-hl と違うところ]
・scan-form を見て色を塗る
・thread は自動判別
→ 一生懸命正規表現を書かなくてもいい
→ scan-form をいじっていても、特に設定しなくていい
→ scan-form で指定できるものには全て色を塗ることができる
・塗る色は、デフォルトでは field-spec から引き、defface で色を定義する
→ ターミナルでも色が付く
→ theme をいじっていても、特に設定しなくていい
[mew-summary-hl と同じところ]
・色を塗る機構は白井さんのオリジナルのまま
→統合するにはもうひと踏ん張り?
・特殊な塗り方(特別な人の色を変えるとか、MLへッダを塗るとか)が可能
将来的に、summary-highlight がMew本体に統合される際には、色を塗る仕組
みなどは変わってくる可能性が高いですが、設定方法に関しての指針くらいは
出せているのではないかと思っています。
設定可能な項目は以下の通りです。
・mew-fancy-summary-face-spec
デフォルトは、
'((num . mew-fancy-summary-face-marginal)
(size . mew-fancy-summary-face-marginal)
(type . mew-fancy-summary-face-type)
(truncated . mew-fancy-summary-face-truncated)
(thread . mew-fancy-summary-face-marginal)
(special . mew-fancy-summary-face-special)
(ml . mew-fancy-summary-face-tag)
(attach . mew-fancy-summary-face-marginal))
scan-form 中の各要素に対して、どの face を使って色を塗るかの対応関係
を記述。
truncated は T マーク、thread は thread-indent、special は特別な人、
ml は タイトルのMLへッダ、attach は添付行に対応する。それ以外は
scan-form に指定できる項目をそのまま指定する。
特定のへッダに対応するもの(from, to, date/year/time, subj)は、デフォ
ルトで mew-field-spec を見に行く(messageバッファと同じ色が付く)が、
違う色を塗りたい場合は、ここに書けばよい。
alist の左辺には文字列も書けるので、scan-form 中に 文字列を直接書き
込んでいる場合でも、これを塗ることが可能。
・mew-fancy-summary-special-persons
・mew-fancy-summary-special-addrbook
・mew-fancy-summary-special-to
mew-summary-hl-* のそれと同じ。
-persons に指定したFromにマッチする人や、(-addrbook が t のとき)
アドレス帳のニックネームにマッチする人には、special で色を塗る。
-to が t の場合、自分が出したメールにもこのルールを適用。
・mew-fancy-summary-ml-regex
MLサーバがメールのタイトルに付ける prefix の正規表現。
デフォルトは、"[\[(][^])\n\r]*[\])]"
[注意点]
・色を変えたい場合には、theme ファイルで custom-set-face する。
・thread-column を、scan-form の項目の間になるようにすること。
あとは コメントや docstring を参照してください。
＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿
田原 俊一 jado at example.com, shunichi_tahara at example.com
http://flowernet.gr.jp/jado/
FingerPrint: 16 9E 70 3B 05 86 5D 08 B8 4C 47 3A E7 E9 8E D9
￣￣￣￣￣￣￣￣￣￣￣￣￣￣￣￣￣￣￣￣￣￣￣￣￣￣￣￣￣￣￣
-------------- next part --------------
;;; mew-fancy-summary.el -*- Emacs-Lisp -*-
;;;
;;; Author:
;;; Shun-ichi TAHARA <jado at example.com>
;;;
;;; Time-stamp: <01/06/06 13:00:19 jado at example.com>
;;;
;;; Commentary:
;;; Fontify Mew summary buffer.
;;; Originated from mew-summary-hl.el by Hideyuki SHIRAI <shirai at example.com>.
;;; HOW TO USE:
;;;
;;; 1. BE SURE TO USE lazy-lock.
;;;
;;; (eval-after-load "mew-fancy-summary.el"
;;; '(lambda ()
;;; (require 'font-lock)
;;; (add-hook 'font-lock-mode-hook 'turn-on-lazy-lock)
;;; (if mew-xemacs-p
;;; (setq lazy-lock-minimum-size 0))))
;;;
;;; 2. Set some customize variables as you like.
;;;
;;; 3. Require this file in your init file of Emacsen.
;;;
;;; (add-hook 'mew-init-hook '(lambda () (require 'mew-fancy-summary)))
;;;
;;; * You may want to specify like below in your "theme" file
;;; to make the marked lines stand out:
;;;
;;; (custom-set-faces
;;; '(mew-face-mark-review
;;; ((((class color) (type tty)) (:background "cyan" :inverse-video t))
;;; (((class color) (background light)) (:background "SkyBlue"))
;;; (((class color) (background dark)) (:background "MediumBlue"))
;;; (t (:inverse-video t))))
;;; '(mew-face-mark-multi
;;; ((((class color) (type tty)) (:background "magenta" :inverse-video t))
;;; (((class color) (background light)) (:background "violet"))
;;; (((class color) (background dark)) (:background "DarkViolet"))
;;; (t (:inverse-video t))))
;;; '(mew-face-mark-delete
;;; ((((class color) (type tty)) (:background "red" :inverse-video t))
;;; (((class color) (background light)) (:background "OrangeRed"))
;;; (((class color) (background dark)) (:background "Firebrick"))
;;; (t (:inverse-video t))))
;;; '(mew-face-mark-unlink
;;; ((((class color) (type tty)) (:background "yellow" :inverse-video t))
;;; (((class color) (background light)) (:background "Gold"))
;;; (((class color) (background dark)) (:background "DarkOrange4"))
;;; (t (:inverse-video t))))
;;; '(mew-face-mark-refile
;;; ((((class color) (type tty)) (:background "green" :inverse-video t))
;;; (((class color) (background light)) (:background "LimeGreen"))
;;; (((class color) (background dark)) (:background "ForestGreen"))
;;; (t (:inverse-video t)))))
(eval-when-compile (require 'mew))
(defconst mew-fancy-summary-version "mew-fancy-summary 0.01")
;;; User-customizable variables
(defvar mew-fancy-summary-face-spec
'((num . mew-fancy-summary-face-marginal)
(size . mew-fancy-summary-face-marginal)
(type . mew-fancy-summary-face-type)
(truncated . mew-fancy-summary-face-truncated)
(thread . mew-fancy-summary-face-marginal)
(special . mew-fancy-summary-face-special)
(ml . mew-fancy-summary-face-tag)
(attach . mew-fancy-summary-face-marginal))
"*An alist of face specs for fancy-summary mode. Each entry consists
of a pair of string or symbol and face.
If you want to highlight the raw string in 'mew-scan-form', put the
string and the corresponding face in this alist (and also define the
face if needed, see below).
Symbol is one of those: 'num' for a message number, 'size' for the
message size, 'type' for a mark of content type (except 'T' mark),
'truncated' for 'T' mark, 'thread' for a thread indent, 'special' for
the special person (see also 'mew-fancy-summary-special-*'), 'ml' for
a subject prefix of ML (see also 'mew-fancy-summary-ml-regex'), and
'attach' for a attachment line. Among them, 'num' and 'size' can be
specified in 'mew-scan-form'. And the others, which can be in it, for
example, 'date', 'subj', and so on, also can be specified to override
the default highlight configuration.
If tne entry corresponding to certain header field is not found, the
search falls back to 'mew-field-spec' with the header field name as
a default highlight configuration. So if you want not to highlight a
certain field (e.g. Date:), add an entry like below:
(date . mew-fancy-summary-face-nothing)
or if you want to make a different face from those of Message mode,
add an entry like below:
(from . mew-fancy-summary-face-from)
The symbol to set in the entry must be corresponding to the header
field (see also 'mew-fancy-summary-face-spec-key-alist'). You may have
to define the corresponding face in your 'theme' file like below:
(defface mew-fancy-summary-face-from
'((((class color) (type tty)) (:foreground \"red\" :bold t))
(((class color) (background light)) (:foreground \"Firebrick\" :bold t))
(((class color) (background dark)) (:foreground \"OrangeRed\" :bold t))
(t (:bold t)))
nil)")
(defvar mew-fancy-summary-special-persons nil
"*Specify the 'special' person.
If the From: header corresponding to 'from' part matches a member of
this list, 'special' entry of 'mew-fancy-summary-face-spec' is used
for highlighting.")
(defvar mew-fancy-summary-special-addrbook nil
"*If non-nil, nicknames in the addrbook are treated as 'special'
person.")
(defvar mew-fancy-summary-special-to t
"*If non-nil, mails sent to 'special' person are highlighted
specially.")
(defvar mew-fancy-summary-ml-regex "[\[(][^])\n\r]*[\])]"
"*Prefix of the subject of mails posted to ML.")
;;; Faces (change them in your 'theme' file)
(defface mew-fancy-summary-face-nothing nil
"*A face for the part of Summary buffer without highlight.")
(defface mew-fancy-summary-face-marginal
'((((class color) (type tty)) nil)
(((class color) (background light)) (:foreground "gray50"))
(((class color) (background dark)) (:foreground "gray50"))
(t nil))
"*A face for marginal part of Summary buffer.")
(defface mew-fancy-summary-face-type
'((((class color) (type tty)) (:background "yellow" :inverse-video t))
(((class color) (background light)) (:background "Gold"))
(((class color) (background dark)) (:background "DarkOrange4"))
(t nil))
"*A face for 'T' mark at 'type' part of Summary buffer.")
(defface mew-fancy-summary-face-truncated
'((((class color) (type tty)) (:background "red" :inverse-video t))
(((class color) (background light)) (:background "OrangeRed"))
(((class color) (background dark)) (:background "Firebrick"))
(t (:inverse-video t)))
"*A face for 'type' part of Summary buffer (except 'T' mark).")
(defface mew-fancy-summary-face-special
'((((class color) (type tty)) (:foreground "cyan" :bold t))
(((class color) (background light)) (:foreground "MediumBlue" :bold t))
(((class color) (background dark)) (:foreground "SkyBlue" :bold t))
(t (:bold t)))
"*A face for special person in the 'from' part of Summary buffer.")
(defface mew-fancy-summary-face-tag
'((((class color) (type tty)) (:foreground "green" :bold t))
(((class color) (background light)) (:foreground "ForestGreen" :bold t))
(((class color) (background dark)) (:foreground "LimeGreen" :bold t))
(t (:bold t)))
"*A face for tag part of Summary buffer.")
;;; End of user-customizable stuffs
;;; Constants
(defconst mew-fancy-summary-invisible-fake-function
'mew-fancy-summary-remove-invisible)
(defconst mew-fancy-summary-face-spec-key-alist
'((from . "From:")
(to . "To:")
(subj . "Subject:")
(date . "Date:")
(year . "Date:")
(time . "Date:")))
;;; Internal variables
(defvar mew-fancy-summary-special-list nil)
(defvar mew-fancy-summary-scan-form nil)
(make-variable-buffer-local 'mew-fancy-summary-scan-form)
(defvar mew-fancy-summary-thread-column nil)
(make-variable-buffer-local 'mew-fancy-summary-thread-column)
;;; Initialization
(add-hook 'mew-summary-mode-hook 'mew-fancy-summary-enable)
(add-hook 'mew-virtual-mode-hook 'mew-fancy-summary-enable)
(add-hook 'mew-thread-display-hook 'mew-fancy-summary-thread-enable)
(add-hook 'mew-pop-sentinel-hook 'mew-fancy-summary-block)
(add-hook 'mew-scan-sentinel-hook 'mew-fancy-summary-block)
(setq mew-use-highlight-mark nil) ;; Hilight mark by itself, not by Mew
(defalias 'mew-summary-cook-region 'mew-fancy-summary-make-invisible-region)
(defalias 'mew-highlight-mark-line 'mew-fancy-summary-mark-line)
(cond
((fboundp 'font-lock-fontify-block)
(defalias 'mew-fancy-summary-block 'font-lock-fontify-block))
(t
;; Bogus, but for XEmacs
(defun mew-fancy-summary-block ()
(font-lock-mode 1))))
;;; Setup
(defadvice mew-addrbook-setup (after hl-setup activate)
"*Setup fancy-summary when starting up Mew or executing \"Z\"."
(mew-fancy-summary-regex-setup)
(mew-fancy-summary-special-setup))
(defun mew-fancy-summary-regex-setup ()
(setq mew-fancy-summary-thread-regex
(concat "\\("
(if mew-use-fancy-thread
(mapconcat
'(lambda (indent)
(regexp-quote indent))
mew-fancy-thread-indent-strings "\\|")
mew-thread-indent-string)
"\\)+")))
(defun mew-fancy-summary-special-setup ()
(setq mew-fancy-summary-special-list mew-fancy-summary-special-persons)
(if mew-fancy-summary-special-addrbook
(let ((addrbook mew-addrbook-alist) nickname)
(while addrbook
(setq nickname (nth 2 (car addrbook)))
(if (and (stringp nickname)
(not (member nickname mew-fancy-summary-special-list)))
(setq mew-fancy-summary-special-list
(cons nickname mew-fancy-summary-special-list)))
(setq addrbook (cdr addrbook))))))
;;; Workarounds about highlighting in Mew
(defun mew-fancy-summary-remove-invisible ()
"*Remove the invisible hook in Mew."
(remove-hook 'window-scroll-functions 'mew-summary-cook-window 'local)
(remove-hook 'pre-idle-hook 'mew-summary-cook-window))
(defun mew-fancy-summary-make-invisible-region (beg end &optional interrupt)
"*Faster invisible function for summary with many text properties."
(if (and (memq major-mode
'(mew-summary-mode mew-virtual-mode mew-refile-view-mode))
mew-summary-buffer-raw)
(let ((inhibit-point-motion-hooks t) ret)
(catch 'loop
(mew-elet
(save-excursion
(goto-char beg)
(while (and (<= (point) end) ;; Emacs 21's bug?
(search-forward "\r" end t))
(if (and interrupt (input-pending-p))
(throw 'loop (setq ret t))
(unless (get-text-property (match-beginning 0) 'invisible)
(put-text-property (match-beginning 0)
(progn (end-of-line) (point))
'invisible t)))))))
(set-buffer-modified-p nil)
ret)))
(defun mew-fancy-summary-mark-line (mark)
"*Remove property so that font-lock works properly, because
highlighting mark line is done by mew-fancy-summary."
(remove-text-properties
(save-excursion (beginning-of-line) (point))
(save-excursion (end-of-line) (point))
'(lazy-lock nil lazy-lock-fontified nil fontified nil)))
;;; Activating fancy summary
(defun mew-fancy-summary-enable ()
"*Activate mew-fancy-summary in summary or virtual buffer."
(if (mew-thread-p)
(font-lock-mode -1) ;; Acceleration
(set (make-local-variable 'font-lock-fontify-buffer-function)
'mew-fancy-summary-buffer)
(set (make-local-variable 'font-lock-fontify-region-function)
'mew-fancy-summary-region)
(setq mew-fancy-summary-scan-form
(mew-summary-scan-form (substring (mew-summary-folder-name t) 1)))
(setq mew-fancy-summary-thread-column -1)
(funcall mew-fancy-summary-invisible-fake-function)
(font-lock-mode 1)))
(defun mew-fancy-summary-thread-enable ()
"*Activate mew-fancy-summary in thread buffer."
(sit-for 0) ;; Need redraw?
(set (make-local-variable 'font-lock-fontify-buffer-function)
'mew-fancy-summary-buffer)
(set (make-local-variable 'font-lock-fontify-region-function)
'mew-fancy-summary-region)
(setq mew-fancy-summary-scan-form
(mew-summary-scan-form (substring (mew-summary-folder-name t) 1)))
(setq mew-fancy-summary-thread-column
(mew-summary-scan-form
(substring (mew-summary-folder-name t) 1) 'column))
(funcall mew-fancy-summary-invisible-fake-function)
(font-lock-mode 1))
;;; Main
(defun mew-fancy-summary-buffer ()
"*Highlight summary buffer with font-lock-mode."
(interactive)
(mew-fancy-summary-region (point-min) (point-max)))
(defun mew-fancy-summary-region (beg end &optional loudly)
"*Highlight the region of summary buffer with font-lock-mode."
(interactive "r")
(let ((pos (point)) linebeg lineend col)
(when (memq major-mode
'(mew-summary-mode mew-virtual-mode mew-refile-view-mode))
(mew-elet
(goto-char beg)
(beginning-of-line)
(setq beg (point))
;; Make invisible after \r
(while (and (<= (point) end) ;; Emacs 21's bug?
(search-forward "\r" end t))
(unless (get-text-property (match-beginning 0) 'invisible)
(put-text-property (match-beginning 0)
(progn (end-of-line) (point))
'invisible t)))
(goto-char beg)
;; Highlight each line
(while (< (point) end)
(setq linebeg (point))
(setq col 0)
(cond
;; Normal line
((and (not (mew-in-decode-syntax-p))
(looking-at mew-regex-msg)
(not (looking-at mew-regex-msg-mark)))
(let ((form mew-fancy-summary-scan-form) entry)
(while form
(setq entry (car form))
(if (= col mew-fancy-summary-thread-column)
(setq col (+ col (mew-fancy-summary-do-highlight 'thread))))
(setq col (+ col (mew-fancy-summary-do-highlight entry)))
(setq form (cdr form))))
(looking-at "[^\r\n]*")
(setq lineend (match-end 0)))
;; Marked line
((and (not (mew-in-decode-syntax-p))
(looking-at mew-regex-msg-mark))
(let ((mark (string-to-char (mew-match 2))))
(looking-at "[^\r\n]*")
(setq lineend (match-end 0))
(put-text-property linebeg lineend
'face (mew-highlight-mark-get-face mark))))
;; Others (usually, expanded multi-part)
(t
(unless (and (functionp 'mew-fancy-summary-external-function)
;; Highlight thread separator or folder of refile-view
;; by your custom function
(funcall mew-fancy-summary-external-function))
(setq lineend (progn (end-of-line) (point)))
(put-text-property linebeg lineend
'face (mew-fancy-summary-get-face 'attach))
(when mew-use-highlight-mouse-line
(remove-text-properties linebeg (min (1+ lineend) (point-max))
'(mouse-face))))))
(when mew-use-highlight-mouse-line
(put-text-property linebeg lineend
'mouse-face mew-highlight-mouse-line-face))
(forward-line)))
(set-buffer-modified-p nil)
(goto-char pos))))
;;;
(defun mew-fancy-summary-do-highlight (entry)
(let ((l 0) (col (current-column))
(spec (mew-fancy-summary-get-spec entry)) sentry)
(while spec
(setq sentry (car spec))
(if (stringp (car sentry))
(when (looking-at (car sentry))
(put-text-property (match-beginning 0) (match-end 0)
'face (cdr sentry))
(goto-char (match-end 0))
(setq l (+ l (- (current-column) col)))
(setq col (current-column)))
(let ((beg (point))
(len (car sentry)))
(setq col (+ col (- len l)))
(move-to-column col)
(setq l len)
(if (cdr sentry)
(put-text-property beg (point) 'face (cdr sentry)))))
(setq spec (cdr spec)))
l))
(defun mew-fancy-summary-get-spec (entry)
(let ((len (cond
((stringp entry) (length entry))
((listp entry) (abs (car entry)))
(t 1)))
(elem (cond
((listp entry) (nth 1 entry))
(t entry)))
face)
(if (= len 0)
(setq len "[^\r\n]*[^ \r\n]")) ;; To the tail of line
(setq face (mew-fancy-summary-get-face elem))
(cond
((eq elem 'type)
(cond
((looking-at "T")
(list (cons len (mew-fancy-summary-get-face 'truncated))))
((looking-at "[^ ]")
(list (cons len face)))
(t
(list (cons len nil)))))
((eq elem 'thread)
(list (cons mew-fancy-summary-thread-regex face)))
((eq elem 'from)
(if (and mew-scan-form-from-me-prefix
(looking-at (regexp-quote mew-scan-form-from-me-prefix)))
;; Mail from me
(let ((start (length mew-scan-form-from-me-prefix)))
(setq face (mew-fancy-summary-get-face 'to))
(if (and mew-fancy-summary-special-to
(mew-fancy-summary-special-p start (- len start)))
(list (cons (length mew-scan-form-from-me-prefix) face)
(cons len (mew-fancy-summary-get-face 'special)))
(list (cons len face))))
;; Mail to me
(if (mew-fancy-summary-special-p 0 len)
(list (cons len (mew-fancy-summary-get-face 'special)))
(list (cons len face)))))
((eq elem 'subj)
(list (cons mew-fancy-summary-ml-regex (mew-fancy-summary-get-face 'ml))
(cons len face)))
(t
(list (cons len face))))))
(defun mew-fancy-summary-get-face (key)
(if (symbolp key)
(let ((skey (or (cdr (assoc key mew-fancy-summary-face-spec-key-alist))
key)))
(if (symbolp skey)
(cdr (assoc skey mew-fancy-summary-face-spec))
(or (cdr (assoc key mew-fancy-summary-face-spec))
(mew-nspec-valface (mew-nspec-by-key skey))
'mew-face-header-marginal)))
(cdr (assoc key mew-fancy-summary-face-spec))))
(defun mew-fancy-summary-special-p (start len)
(save-excursion
(let* ((from (progn (move-to-column (+ (current-column) start)) (point)))
(to (progn (move-to-column (+ (current-column) len)) (point)))
(key (mew-buffer-substring from to))
(special mew-fancy-summary-special-list) entry)
(if (string-match "[^\r\n]*[^ \r\n]" key)
(setq key (substring key (match-beginning 0) (match-end 0))))
(setq key (concat (regexp-quote key) ".*"))
(catch 'loop
(while special
(setq entry (car special))
(if (string-match key entry)
(throw 'loop t))
(setq special (cdr special)))
nil))))
;;;
(provide 'mew-fancy-summary)
;;; Copyright Notice:
;; Copyright (C) 2001 Shun-ichi TAHARA <jado at example.com>
;; Copyright (C) 1999-2001 Hideyuki SHIRAI <shirai at example.com>
;; Copyright (C) 1994-2001 Mew developing team.
;; All rights reserved.
;; Redistribution and use in source and binary forms, with or without
;; modification, are permitted provided that the following conditions
;; are met:
;;
;; 1. Redistributions of source code must retain the above copyright
;; notice, this list of conditions and the following disclaimer.
;; 2. Redistributions in binary form must reproduce the above copyright
;; notice, this list of conditions and the following disclaimer in the
;; documentation and/or other materials provided with the distribution.
;; 3. Neither the name of the team nor the names of its contributors
;; may be used to endorse or promote products derived from this software
;; without specific prior written permission.
;;
;; THIS SOFTWARE IS PROVIDED BY THE TEAM AND CONTRIBUTORS ``AS IS'' AND
;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
;; PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE TEAM OR CONTRIBUTORS BE
;; LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
;; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
;; BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
;; OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
;; IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;;; mew-fancy-summary.el ends here
Mew-dist メーリングリストの案内