[Mew-dist 2808] Re: color of citation in Message buffer

[Masahiro MURATA ( 村田全寛 )]

  村田@神戸です。

/// On Wed, 29 Oct 1997 14:02:07 +0900
/// Kazu Yamamoto (山本和彦) wrote:

> > # 今のコードは n 個 regex が書いてあると、n 回 re-search-forward を実
> > # 行するようになっていますが、他にいいアルゴリズムがあればそちらを使い
> > # たいです。

> highlight-header-region のように、

> 	(1) 正規表現は行の制約を受ける
> 	(2) 外のループは行をなめる
> 	    (ユーザが設定した最大行まで forward-line するのみ)
> 		内側のループは正規表現をなめる
> 		(行頭で looking-at するのみ)

> するのがよいと思います。

  このような考え方で作ってみました。Mew-1.92.1 のオリジナルに対するパッチ
です。

  ただ，mew-highlight-body-keywords-regexp を新たに作る必要が出てきたので，
mew-highlight-body-keywords を変更しただけでは反映されなくなりました。この
辺りはもう少し考えないといけないかも知れませんが。mew-make-keywords-regexp
の関数名もそうだし。

# ついでに page break 後の message でも highlight-{url|body} させています。

  また，x-face の関数の設定で常に (require 'highlight-headers) されていま
すが，autoload に変更しています。mew-opt-highlight-x-face-function が常に
highlight-headers を必要とするとは限りませんので。現に x-face-1.2.9 を使え
ば highlight-headers は必要ありません。

--
村田 全寛 / MURATA Masahiro
-------------- next part --------------
--- ./mew-highlight.el.orig	Wed Oct 29 23:04:59 1997
+++ ./mew-highlight.el	Wed Oct 29 23:09:19 1997
@@ -26,6 +26,8 @@
   "*Paint marked lines in Summary mode.")
 (defvar mew-opt-highlight-header t
   "*Paint header in Message and Draft mode.")
+(defvar mew-opt-highlight-body t
+  "*Paint body in Message mode.")
 (defvar mew-opt-highlight-url t
   "*Emphasize URL lines in Message mode.")
 (defvar mew-opt-highlight-url-regex
@@ -35,6 +37,8 @@
 (defvar mew-opt-highlight-x-face mew-xemacs-p
   "*Iconify X-Face: on XEmacs in Message mode.")
 
+(defvar mew-highlight-body-max-line 200)
+
 ;;
 ;; Styles and colors
 ;;
@@ -82,6 +86,21 @@
 (defvar mew-highlight-header-color-marginal  "gray50")
 (defvar mew-highlight-header-color-xmew      "Red")
 
+(defvar mew-highlight-body-face-list
+  '(mew-highlight-body-face-quote
+    mew-highlight-body-face-comment)
+  "*A list of face symbol name to highlight body.
+Each name should be 'mew-highlight-body-face-xxx'.
+Each face will be created from 'mew-highlight-body-sytel-xxx' and
+'mew-highlight-body-color-xxx'. These faces can be used in
+'mew-highlight-body-keywords'.")
+
+(defvar mew-highlight-body-style-quote   'default)
+(defvar mew-highlight-body-style-comment 'default)
+
+(defvar mew-highlight-body-color-quote   "ForestGreen")
+(defvar mew-highlight-body-color-comment "gray50")
+
 ;; xxx hard coding...
 (defvar mew-highlight-mark-folder-list '("+inbox")
   "*A folder list to highligh marked lines.")
@@ -128,7 +147,17 @@
      mew-highlight-header-face-marginal))
   "*A list of (\"header-key-regex\" face-for-key face-for-value).
 This is used to highlight header.")
-  
+
+(defvar mew-highlight-body-keywords
+  '(("^[ \t]*\\(\\w*[A-Za-z0-9'-]*[>|]+.*\\)"
+     mew-highlight-body-face-quote)
+    ("^#+.*"
+     mew-highlight-body-face-comment))
+  "*A list of (\"body-key-regex\" face-for-body).
+This is used to highlight body.")
+
+(defvar mew-highlight-body-keywords-regexp nil)
+
 (defvar mew-highlight-mark-keywords
   (list 
    (cons mew-mark-review 'mew-highlight-mark-face-review)
@@ -245,6 +274,32 @@
 		    (mew-overlay-put overlay 'face (nth 2 assoc)))
 		(while (looking-at "[ \t]") (forward-line)))))))))
 
+(defun mew-highlight-body ()
+  "A function to highligh body in Message mode."
+  (if (and window-system mew-opt-highlight-body)
+      (save-excursion
+	(save-restriction
+	  (let ((keywords mew-highlight-body-keywords)
+		(buffer-read-only nil)
+		(line 1)
+		beg1 end1 overlay)
+	    (goto-char (point-min))
+	    (and (equal mew-message-citation 'header)
+		 (search-forward "\n\n" nil t)
+		 (narrow-to-region (point) (point-max)))
+	    (while (and (not (eobp)) (< line mew-highlight-body-max-line))
+	      (if (looking-at mew-highlight-body-keywords-regexp)
+		  (progn
+		    (setq beg1 (match-beginning 0))
+		    (setq end1 (match-end 0))
+		    (setq key (mew-match 0))
+		    (if (setq assoc (mew-assoc-match2 key keywords 0))
+			(progn
+			  (setq overlay (mew-overlay-make beg1 end1))
+			  (mew-overlay-put overlay 'face (nth 1 assoc))))))
+	      (forward-line)
+	      (setq line (1+ line))))))))
+
 ;;
 ;; X-Face:
 ;;
@@ -256,7 +311,7 @@
 
 (cond
  (mew-xemacs-p
-  (require 'highlight-headers)
+  (autoload 'highlight-headers-x-face-to-pixmap "highlight-headers")
   (defvar mew-opt-highlight-x-face-function
     (function (lambda (beg end)
 		(interactive)
@@ -314,6 +369,14 @@
 	  (set-face-foreground fname (symbol-value color))))))
 
 (mew-highlight-face-setup mew-highlight-header-face-list)
+(mew-highlight-face-setup mew-highlight-body-face-list)
 (mew-highlight-face-setup mew-highlight-mark-face-list)
+
+(defun mew-make-keywords-regexp ()
+  (setq mew-highlight-body-keywords-regexp
+	(mapconcat 'identity (mapcar 'car mew-highlight-body-keywords) "\\|"))
+  )
+
+(mew-make-keywords-regexp)
 
 (provide 'mew-highlight)
--- ./mew-summary.el.orig	Wed Oct 29 23:05:09 1997
+++ ./mew-summary.el	Wed Oct 29 22:16:34 1997
@@ -823,6 +823,7 @@
 	))
       (setq mew-decode-result nil)
       (mew-highlight-url)
+      (mew-highlight-body)
       (run-hooks 'mew-message-hook)
       )
     (set-buffer-modified-p nil)
@@ -892,6 +893,7 @@
     (if non-erase
 	()
       (mew-highlight-url)
+      (mew-highlight-body)
       (run-hooks 'mew-message-hook)
       (set-buffer-modified-p nil) ;; xxx message buffer
       )
--- ./mew-message.el.orig	Wed Oct 29 23:24:24 1997
+++ ./mew-message.el	Wed Oct 29 23:27:26 1997
@@ -107,6 +107,8 @@
 ;;	  (progn (message "End of message") t) ;Nothing more.
 	  t
 	(mew-message-narrow-to-page 1)		;Go to next page.
+	(mew-highlight-url)
+	(mew-highlight-body)
 	(run-hooks 'mew-message-hook)
 	nil
 	)