;; 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 $
+;; Version: $Id: emh-face.el,v 0.5 1997-09-25 15:11:34 morioka Exp $
;; Keywords: header, highlighting
;; This file is part of emh.
;;; Code:
+(require 'emu)
+
+(defsubst emh-set-face-foreground (face color)
+ (condition-case err
+ (set-face-foreground face 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)
- (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)
+ (emh-set-face-foreground 'from-field-body "dark slate blue")
+ (emh-make-face-bold 'from-field-body)
))
(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)
+ (emh-set-face-foreground 'subject-field-body "violet red")
+ (emh-make-face-bold 'subject-field-body)
))
(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)
+ (emh-set-face-foreground 'to-field-body "red")
+ (emh-make-face-bold 'to-field-body)
))
(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")
- )
+ (emh-set-face-foreground 'cc-field-body "salmon")
+ (emh-make-face-bold 'cc-field-body)
))
-(or (find-face 'cc-field-name)
+
+(or (find-face 'reply-to-field-body)
(progn
- (copy-face 'cc-field-body 'cc-field-name)
- (make-face-bold 'cc-field-name nil 'no-error)
+ (make-face 'reply-to-field-body)
+ (emh-set-face-foreground 'reply-to-field-body "salmon")
+ (emh-make-face-bold 'reply-to-field-body)
))
(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)
+ (emh-set-face-foreground '-to-field-body "red")
))
(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)
+ (emh-set-face-foreground 'date-field-body "blue violet")
+ (emh-make-face-bold 'date-field-body)
))
(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)
+ (emh-set-face-foreground 'message-id-field-body "royal blue")
+ (emh-make-face-bold 'message-id-field-body)
))
(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)
+ (emh-set-face-foreground 'field-body "dark green")
+ (emh-make-face-italic 'field-body)
))
+
(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)
+ (emh-set-face-foreground 'field-name "dark green")
+ (emh-make-face-bold 'field-name)
))
(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)
+ '(("^From:" field-name from-field-body)
+ ("^Subject:" field-name subject-field-body)
+ ("^To:" field-name to-field-body)
+ ("^cc:" field-name cc-field-body)
+ ("^Reply-To:" field-name reply-to-field-body)
+ ("^.+-To:" field-name -to-field-body)
+ ("^Date:" field-name date-field-body)
+ ("^Message-Id:" field-name message-id-field-body)
+ (t field-name field-body)
))
(defun emh-highlight-header ()
(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)
))
projects / elisp / emh.git / blobdiff