emh-face.el

   1 ;;; emh-face.el --- header highlighting in emh.
   2
   3 ;; Copyright (C) 1997 MORIOKA Tomohiko
   4
   5 ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
   6 ;; Created: 1997/3/4
   7 ;; Version: $Id: emh-face.el,v 0.5 1997-09-25 15:11:34 morioka Exp $
   8 ;; Keywords: header, highlighting
   9
  10 ;; This file is part of emh.
  11
  12 ;; This program is free software; you can redistribute it and/or
  13 ;; modify it under the terms of the GNU General Public License as
  14 ;; published by the Free Software Foundation; either version 2, or (at
  15 ;; your option) any later version.
  16
  17 ;; This program is distributed in the hope that it will be useful, but
  18 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  20 ;; General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  25 ;; Boston, MA 02111-1307, USA.
  26
  27 ;;; Code:
  28
  29 (require 'emu)
  30
  31 (defsubst emh-set-face-foreground (face color)
  32   (condition-case err
  33       (set-face-foreground face color)
  34     (error (message "Color `%s' is not found." color))
  35     ))
  36
  37 (defsubst emh-make-face-bold (face)
  38   (set-face-font face (face-font 'bold))
  39   )
  40
  41 (defsubst emh-make-face-italic (face)
  42   (set-face-font face (face-font 'italic))
  43   )
  44
  45 (or (find-face 'from-field-body)
  46     (progn
  47       (make-face 'from-field-body)
  48       (emh-set-face-foreground 'from-field-body "dark slate blue")
  49       (emh-make-face-bold 'from-field-body)
  50       ))
  51
  52 (or (find-face 'subject-field-body)
  53     (progn
  54       (make-face 'subject-field-body)
  55       (emh-set-face-foreground 'subject-field-body "violet red")
  56       (emh-make-face-bold 'subject-field-body)
  57       ))
  58
  59 (or (find-face 'to-field-body)
  60     (progn
  61       (make-face 'to-field-body)
  62       (emh-set-face-foreground 'to-field-body "red")
  63       (emh-make-face-bold 'to-field-body)
  64       ))
  65
  66 (or (find-face 'cc-field-body)
  67     (progn
  68       (make-face 'cc-field-body)
  69       (emh-set-face-foreground 'cc-field-body "salmon")
  70       (emh-make-face-bold 'cc-field-body)
  71       ))
  72
  73 (or (find-face 'reply-to-field-body)
  74     (progn
  75       (make-face 'reply-to-field-body)
  76       (emh-set-face-foreground 'reply-to-field-body "salmon")
  77       (emh-make-face-bold 'reply-to-field-body)
  78       ))
  79
  80 (or (find-face '-to-field-body)
  81     (progn
  82       (make-face '-to-field-body)
  83       (emh-set-face-foreground '-to-field-body "red")
  84       ))
  85
  86 (or (find-face 'date-field-body)
  87     (progn
  88       (make-face 'date-field-body)
  89       (emh-set-face-foreground 'date-field-body "blue violet")
  90       (emh-make-face-bold 'date-field-body)
  91       ))
  92
  93 (or (find-face 'message-id-field-body)
  94     (progn
  95       (make-face 'message-id-field-body)
  96       (emh-set-face-foreground 'message-id-field-body "royal blue")
  97       (emh-make-face-bold 'message-id-field-body)
  98       ))
  99
 100 (or (find-face 'field-body)
 101     (progn
 102       (make-face 'field-body)
 103       (emh-set-face-foreground 'field-body "dark green")
 104       (emh-make-face-italic 'field-body)
 105       ))
 106
 107 (or (find-face 'field-name)
 108     (progn
 109       (make-face 'field-name)
 110       (emh-set-face-foreground 'field-name "dark green")
 111       (emh-make-face-bold 'field-name)
 112       ))
 113
 114 (defvar emh-header-face
 115   '(("^From:"           field-name      from-field-body)
 116     ("^Subject:"        field-name      subject-field-body)
 117     ("^To:"             field-name      to-field-body)
 118     ("^cc:"             field-name      cc-field-body)
 119     ("^Reply-To:"       field-name      reply-to-field-body)
 120     ("^.+-To:"          field-name      -to-field-body)
 121     ("^Date:"           field-name      date-field-body)
 122     ("^Message-Id:"     field-name      message-id-field-body)
 123     (t                  field-name      field-body)
 124     ))
 125
 126 (defun emh-highlight-header ()
 127   (goto-char (point-min))
 128   (while (looking-at "^[^:]+:")
 129     (let* ((beg (match-beginning 0))
 130            (med (match-end 0))
 131            (end (std11-field-end))
 132            (field-name (buffer-substring beg med))
 133            (rule (catch 'found
 134                    (let ((rest emh-header-face))
 135                      (while rest
 136                        (let* ((rule (car rest))
 137                               (key (car rule)))
 138                          (if (and (stringp key)
 139                                   (string-match key field-name))
 140                              (throw 'found (cdr rule))
 141                            ))
 142                        (setq rest (cdr rest))
 143                        )
 144                      (cdr (assq t emh-header-face))
 145                      )))
 146            )
 147       (overlay-put (make-overlay beg med) 'face (car rule))
 148       (overlay-put (make-overlay med end) 'face (cadr rule))
 149       )
 150     (forward-char)
 151     ))
 152
 153
 154 ;;; @ end
 155 ;;;
 156
 157 (provide 'emh-face)
 158
 159 ;;; emh-face.el ends here