1 ;;; emh-face.el --- header highlighting in emh.
3 ;; Copyright (C) 1997,2000 Free Software Foundation, Inc.
5 ;; Author: MORIOKA Tomohiko <tomo@m17n.org>
7 ;; Keywords: header, highlighting
9 ;; This file is part of emh.
11 ;; This program is free software; you can redistribute it and/or
12 ;; modify it under the terms of the GNU General Public License as
13 ;; published by the Free Software Foundation; either version 2, or (at
14 ;; your option) any later version.
16 ;; This program is distributed in the hope that it will be useful, but
17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
19 ;; General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the
23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
24 ;; Boston, MA 02111-1307, USA.
31 (defsubst emh-set-face-foreground (face color)
33 (set-face-foreground face color)
34 (error (message "Color `%s' is not found." color))))
36 (defsubst emh-make-face-bold (face)
37 (set-face-font face (face-font 'bold)))
39 (defsubst emh-make-face-italic (face)
40 (set-face-font face (face-font 'italic)))
42 (or (find-face 'from-field-body)
44 (make-face 'from-field-body)
45 (emh-set-face-foreground 'from-field-body "dark slate blue")
46 (emh-make-face-bold 'from-field-body)
49 (or (find-face 'subject-field-body)
51 (make-face 'subject-field-body)
52 (emh-set-face-foreground 'subject-field-body "violet red")
53 (emh-make-face-bold 'subject-field-body)
56 (or (find-face 'to-field-body)
58 (make-face 'to-field-body)
59 (emh-set-face-foreground 'to-field-body "red")
60 (emh-make-face-bold 'to-field-body)
63 (or (find-face 'cc-field-body)
65 (make-face 'cc-field-body)
66 (emh-set-face-foreground 'cc-field-body "salmon")
67 (emh-make-face-bold 'cc-field-body)
70 (or (find-face 'reply-to-field-body)
72 (make-face 'reply-to-field-body)
73 (emh-set-face-foreground 'reply-to-field-body "salmon")
74 (emh-make-face-bold 'reply-to-field-body)
77 (or (find-face '-to-field-body)
79 (make-face '-to-field-body)
80 (emh-set-face-foreground '-to-field-body "red")
83 (or (find-face 'date-field-body)
85 (make-face 'date-field-body)
86 (emh-set-face-foreground 'date-field-body "blue violet")
87 (emh-make-face-bold 'date-field-body)
90 (or (find-face 'message-id-field-body)
92 (make-face 'message-id-field-body)
93 (emh-set-face-foreground 'message-id-field-body "royal blue")
94 (emh-make-face-bold 'message-id-field-body)
97 (or (find-face 'field-body)
99 (make-face 'field-body)
100 (emh-set-face-foreground 'field-body "dark green")
101 (emh-make-face-italic 'field-body)
104 (or (find-face 'field-name)
106 (make-face 'field-name)
107 (emh-set-face-foreground 'field-name "dark green")
108 (emh-make-face-bold 'field-name)
111 (defvar emh-header-face
112 '(("^From:" field-name from-field-body)
113 ("^Subject:" field-name subject-field-body)
114 ("^To:" field-name to-field-body)
115 ("^cc:" field-name cc-field-body)
116 ("^Reply-To:" field-name reply-to-field-body)
117 ("^.+-To:" field-name -to-field-body)
118 ("^Date:" field-name date-field-body)
119 ("^Message-Id:" field-name message-id-field-body)
120 (t field-name field-body)
123 (defun emh-highlight-header ()
124 (goto-char (point-min))
125 (while (looking-at "^[^:]+:")
126 (let* ((beg (match-beginning 0))
128 (end (std11-field-end))
129 (field-name (buffer-substring beg med))
131 (let ((rest emh-header-face))
133 (let* ((rule (car rest))
135 (if (and (stringp key)
136 (string-match key field-name))
137 (throw 'found (cdr rule))
139 (setq rest (cdr rest))
141 (cdr (assq t emh-header-face))
144 (overlay-put (make-overlay beg med) 'face (car rule))
145 (overlay-put (make-overlay med end) 'face (cadr rule))
156 ;;; emh-face.el ends here