From a6e7b8f8b189fabaa3e48af92607725492e8534d Mon Sep 17 00:00:00 2001 From: morioka Date: Tue, 4 Mar 1997 20:17:52 +0000 Subject: [PATCH] *** empty log message *** --- emh-face.el | 176 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 176 insertions(+) create mode 100644 emh-face.el 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 +;; 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 -- 1.7.10.4