From: morioka <morioka>
Date: Tue, 4 Mar 1997 20:17:52 +0000 (+0000)
Subject: *** empty log message ***
X-Git-Tag: emh-0_21~43
X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=a6e7b8f8b189fabaa3e48af92607725492e8534d;p=elisp%2Femh.git

*** empty log message ***
---

diff --git a/emh-face.el b/emh-face.el
new file mode 100644
index 0000000..3197e75
--- /dev/null
+++ b/emh-face.el
@@ -0,0 +1,176 @@
+;;; emh-face.el --- header highlighting in emh.
+
+;; Copyright (C) 1997 MORIOKA Tomohiko
+
+;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; Created: 1997/3/4
+;; Version: $Id: emh-face.el,v 0.0 1997-03-04 20:17:52 morioka Exp $
+;; Keywords: header, highlighting
+
+;; This file is part of emh.
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or (at
+;; your option) any later version.
+
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
+(or (find-face 'from-field-body)
+    (progn
+      (make-face 'from-field-body)
+      (and (member "blue" (x-defined-colors))
+	   (set-face-foreground 'from-field-body "blue")
+	   )
+      ))
+(or (find-face 'from-field-name)
+    (progn
+      (copy-face 'from-field-body 'from-field-name)
+      (make-face-bold 'from-field-name nil 'no-error)
+      ))
+
+(or (find-face 'subject-field-body)
+    (progn
+      (make-face 'subject-field-body)
+      (and (member "violet red" (x-defined-colors))
+	   (set-face-foreground 'subject-field-body "violet red")
+	   )
+      ))
+(or (find-face 'subject-field-name)
+    (progn
+      (copy-face 'subject-field-body 'subject-field-name)
+      (make-face-bold 'subject-field-name nil 'no-error)
+      ))
+
+(or (find-face 'to-field-body)
+    (progn
+      (make-face 'to-field-body)
+      (and (member "red" (x-defined-colors))
+	   (set-face-foreground 'to-field-body "red")
+	   )
+      ))
+(or (find-face 'to-field-name)
+    (progn
+      (copy-face 'to-field-body 'to-field-name)
+      (make-face-bold 'to-field-name nil 'no-error)
+      ))
+
+(or (find-face 'cc-field-body)
+    (progn
+      (make-face 'cc-field-body)
+      (and (member "pink" (x-defined-colors))
+	   (set-face-foreground 'cc-field-body "pink")
+	   )
+      ))
+(or (find-face 'cc-field-name)
+    (progn
+      (copy-face 'cc-field-body 'cc-field-name)
+      (make-face-bold 'cc-field-name nil 'no-error)
+      ))
+
+(or (find-face '-to-field-body)
+    (progn
+      (make-face '-to-field-body)
+      (and (member "salmon" (x-defined-colors))
+	   (set-face-foreground '-to-field-body "salmon")
+	   )
+      ))
+(or (find-face '-to-field-name)
+    (progn
+      (copy-face '-to-field-body '-to-field-name)
+      (make-face-bold '-to-field-name nil 'no-error)
+      ))
+
+(or (find-face 'date-field-body)
+    (progn
+      (make-face 'date-field-body)
+      (and (member "blue violet" (x-defined-colors))
+	   (set-face-foreground 'date-field-body "blue violet")
+	   )
+      ))
+(or (find-face 'date-field-name)
+    (progn
+      (copy-face 'date-field-body 'date-field-name)
+      (make-face-bold 'date-field-name nil 'no-error)
+      ))
+
+(or (find-face 'message-id-field-body)
+    (progn
+      (make-face 'message-id-field-body)
+      (and (member "royal blue" (x-defined-colors))
+	   (set-face-foreground 'message-id-field-body "royal blue")
+	   )
+      ))
+(or (find-face 'message-id-field-name)
+    (progn
+      (copy-face 'message-id-field-body 'message-id-field-name)
+      (make-face-bold 'message-id-field-name nil 'no-error)
+      ))
+
+(or (find-face 'field-body)
+    (progn
+      (make-face 'field-body)
+      (and (member "dark green" (x-defined-colors))
+	   (set-face-foreground 'field-body "dark green")
+	   )
+      (make-face-italic 'field-body nil 'no-error)
+      ))
+(or (find-face 'field-name)
+    (progn
+      (make-face 'field-name)
+      (and (member "dark green" (x-defined-colors))
+	   (set-face-foreground 'field-name "dark green")
+	   )
+      (make-face-bold 'field-name nil 'no-error)
+      ))
+
+(defvar emh-header-face
+  '(("^From:"		from-field-name		from-field-body)
+    ("^Subject:"	subject-field-name	subject-field-body)
+    ("^To:"		to-field-name		to-field-body)
+    ("^cc:"		cc-field-name		cc-field-body)
+    ("^.+-To:"		-to-field-name		-to-field-body)
+    ("^Date:"		date-field-name		date-field-body)
+    ("^Message-Id:"	message-id-field-name	message-id-field-body)
+    (t			field-name		field-body)
+    ))
+
+(defun emh-highlight-header ()
+  (goto-char (point-min))
+  (while (looking-at "^[^:]+:")
+    (let* ((beg (match-beginning 0))
+	   (med (match-end 0))
+	   (end (std11-field-end))
+	   (field-name (buffer-substring beg med))
+	   (rule (cdr (or (assoc-if (function
+				     (lambda (key)
+				       (and (stringp key)
+					    (string-match key field-name)
+					    )))
+				    emh-header-face)
+			  (assq t emh-header-face)
+			  )))
+	   )
+      (overlay-put (make-overlay beg med) 'face (car rule))
+      (overlay-put (make-overlay med end) 'face (second rule))
+      )
+    (forward-char)
+    ))
+
+
+;;; @ end
+;;;
+
+(provide 'emh-face)
+
+;;; emh-face.el ends here