release.

[elisp/emh.git] / emh-face.el

diff --git a/emh-face.el b/emh-face.el
index d122a20..f37af61 100644 (file)
--- a/emh-face.el
+++ b/emh-face.el
@@ -1,10 +1,9 @@
 ;;; emh-face.el --- header highlighting in emh.
 
-;; Copyright (C) 1997 MORIOKA Tomohiko
+;; Copyright (C) 1997,2000 Free Software Foundation, Inc.
 
-;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; Author: MORIOKA Tomohiko <tomo@m17n.org>
 ;; Created: 1997/3/4
-;; Version: $Id: emh-face.el,v 0.2 1997-03-14 05:30:33 morioka Exp $
 ;; Keywords: header, highlighting
 
 ;; This file is part of emh.
@@ -26,47 +25,53 @@
 
 ;;; Code:
 
-(require 'emu)
+(require 'emh-def)
+(require 'std11)
 
 (defsubst emh-set-face-foreground (face color)
-  (condition-case err
+  (condition-case nil
       (set-face-foreground face color)
-    (error (message "Color `%s' is not found." color))
-    ))
+    (error (message "Color `%s' is not found." color))))
+
+(defsubst emh-make-face-bold (face)
+  (set-face-font face (face-font 'bold)))
+
+(defsubst emh-make-face-italic (face)
+  (set-face-font face (face-font 'italic)))
 
 (or (find-face 'from-field-body)
     (progn
       (make-face 'from-field-body)
       (emh-set-face-foreground 'from-field-body "dark slate blue")
-      (make-face-bold 'from-field-body nil 'no-error)
+      (emh-make-face-bold 'from-field-body)
       ))
 
 (or (find-face 'subject-field-body)
     (progn
       (make-face 'subject-field-body)
       (emh-set-face-foreground 'subject-field-body "violet red")
-      (make-face-bold 'subject-field-body nil 'no-error)
+      (emh-make-face-bold 'subject-field-body)
       ))
 
 (or (find-face 'to-field-body)
     (progn
       (make-face 'to-field-body)
       (emh-set-face-foreground 'to-field-body "red")
-      (make-face-bold 'to-field-body nil 'no-error)
+      (emh-make-face-bold 'to-field-body)
       ))
 
 (or (find-face 'cc-field-body)
     (progn
       (make-face 'cc-field-body)
       (emh-set-face-foreground 'cc-field-body "salmon")
-      (make-face-bold 'cc-field-body nil 'no-error)
+      (emh-make-face-bold 'cc-field-body)
       ))
 
 (or (find-face 'reply-to-field-body)
     (progn
       (make-face 'reply-to-field-body)
       (emh-set-face-foreground 'reply-to-field-body "salmon")
-      (make-face-bold 'reply-to-field-body nil 'no-error)
+      (emh-make-face-bold 'reply-to-field-body)
       ))
 
 (or (find-face '-to-field-body)
@@ -79,28 +84,28 @@
     (progn
       (make-face 'date-field-body)
       (emh-set-face-foreground 'date-field-body "blue violet")
-      (make-face-bold 'date-field-body nil 'no-error)
+      (emh-make-face-bold 'date-field-body)
       ))
 
 (or (find-face 'message-id-field-body)
     (progn
       (make-face 'message-id-field-body)
       (emh-set-face-foreground 'message-id-field-body "royal blue")
-      (make-face-bold 'message-id-field-body nil 'no-error)
+      (emh-make-face-bold 'message-id-field-body)
       ))
 
 (or (find-face 'field-body)
     (progn
       (make-face 'field-body)
       (emh-set-face-foreground 'field-body "dark green")
-      (make-face-italic 'field-body nil 'no-error)
+      (emh-make-face-italic 'field-body)
       ))
 
 (or (find-face 'field-name)
     (progn
       (make-face 'field-name)
       (emh-set-face-foreground 'field-name "dark green")
-      (make-face-bold 'field-name nil 'no-error)
+      (emh-make-face-bold 'field-name)
       ))
 
 (defvar emh-header-face
@@ -122,17 +127,22 @@
           (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)
-                         )))
+          (rule (catch 'found
+                  (let ((rest emh-header-face))
+                    (while rest
+                      (let* ((rule (car rest))
+                             (key (car rule)))
+                        (if (and (stringp key)
+                                 (string-match key field-name))
+                            (throw 'found (cdr rule))
+                          ))
+                      (setq rest (cdr rest))
+                      )
+                    (cdr (assq t emh-header-face))
+                    )))
           )
       (overlay-put (make-overlay beg med) 'face (car rule))
-      (overlay-put (make-overlay med end) 'face (second rule))
+      (overlay-put (make-overlay med end) 'face (cadr rule))
       )
     (forward-char)
     ))