home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / epoch / tek-highlight-2.0 / tek-mh-e-highlight.el < prev    next >
Encoding:
Text File  |  1992-08-20  |  5.8 KB  |  168 lines
  1. ;;*****************************************************************************
  2. ;;
  3. ;; Filename:    tek-mh-e-highlight.el
  4. ;;
  5. ;; Copyright (C) 1992  Rod Whitby
  6. ;;
  7. ;; This program is free software; you can redistribute it and/or modify
  8. ;; it under the terms of the GNU General Public License as published by
  9. ;; the Free Software Foundation; either version 1, or (at your option)
  10. ;; any later version.
  11. ;;
  12. ;; This program is distributed in the hope that it will be useful,
  13. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  14. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15. ;; GNU General Public License for more details.
  16. ;;
  17. ;; You should have received a copy of the GNU General Public License
  18. ;; along with this program; if not, write to the Free Software
  19. ;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  20. ;;
  21. ;; Modified by:        Rod Whitby, <rwhitby@research.canon.oz.au>
  22. ;; Author:        Ken Wood, <kwood@austek.oz.au>
  23. ;; Based on modifications to tek-gnus-highlight.el by M. Burgett
  24. ;;    (burgett@adobe.com), 2 Nov 91.
  25. ;;
  26. ;;
  27. ;; Description:    Highlight fields in messages displayed by the mh-e
  28. ;;        mailer under epoch.
  29. ;;
  30. ;;        Button styles may be customised by means of X11 resources.
  31. ;;        The resource names to use are "mh-e-from" and
  32. ;;        "mh-e-subject". See the file tek-style-utils.el for details.
  33. ;;
  34. ;;        See the INSTALL file that comes with this package for
  35. ;;        installation details.
  36. ;;
  37. ;;*****************************************************************************
  38.  
  39. ;; $Id: tek-mh-e-highlight.el,v 1.5 1992/08/18 04:14:06 rwhitby Rel $
  40.  
  41. (if (boundp 'epoch::version)
  42.     (progn
  43.       
  44.       (require 'tek-style-utils)
  45.  
  46.       (defvar tek-mh-e-from-foreground "blue3"
  47.     "\
  48. Foreground color used to highlight From: fields in mh-e if no value is
  49. defined in the X11 resources and the display device supports color. On
  50. monochrome screens a different font is used in place of the different
  51. color.")
  52.  
  53.       (defvar tek-mh-e-from-styleorattribute
  54.     ;; If the display supports multiple colors and a default color
  55.     ;; is specified, define the style to use a different color.
  56.     (if (and (> (number-of-colors) 2) tek-mh-e-from-foreground)
  57.         (tek-build-style "mh-e-from" nil nil
  58.                  tek-mh-e-from-foreground (background)
  59.                  (background) (foreground))
  60.       ;; Otherwise, define the style to use a different font.
  61.       (tek-build-style "mh-e-from" nil
  62.                (or tek-italic-bold-fixed-font
  63.                    tek-bold-fixed-font
  64.                    tek-italic-fixed-font)
  65.                (foreground) (background)
  66.                (background) (foreground)))
  67.     "\
  68. Style or attribute used to display From: fields in mail messages
  69. displayed by mh-e.")
  70.  
  71.  
  72.       (defvar tek-mh-e-subject-foreground "red3"
  73.     "\
  74. Foreground color used to highlight Subject: fields in mh-e if no value is
  75. defined in the X11 resources and the display device supports color. On
  76. monochrome screens a different font is used in place of the different
  77. color.")
  78.  
  79.       (defvar tek-mh-e-subject-underline "red3"
  80.     "\
  81. Foreground color used to underline Subject: fields in mh-e if no value is
  82. defined in the X11 resources and the display device supports color. On
  83. monochrome screens a different font is used in place of the different
  84. color.")
  85.  
  86.       (defvar tek-mh-e-subject-styleorattribute
  87.     ;; If the display supports multiple colors and a default color
  88.     ;; is specified, define the style to use a different color.
  89.     (if(and (> (number-of-colors) 2)
  90.         (or tek-mh-e-subject-underline
  91.             tek-mh-e-subject-foreground))
  92.         (tek-build-style "mh-e-subject" nil nil
  93.                  tek-mh-e-subject-foreground (background)
  94.                  (background) (foreground)
  95.                  tek-mh-e-subject-underline)
  96.       (tek-build-style "mh-e-subject" nil
  97.                (or tek-bold-fixed-font
  98.                    tek-italic-bold-fixed-font
  99.                    tek-italic-fixed-font)
  100.                (foreground) (background)
  101.                (background) (foreground)
  102.                (foreground)))
  103.     "\
  104. Style or attribute used to display Subject: fields in mail messages
  105. displayed by mh-e.")
  106.  
  107.  
  108.       ;; Select V3 or V4 button behaviour
  109.       (if tek-highlight-use-attributes
  110.       (progn
  111.         ;; Do things the old way - using attributes.
  112.       
  113.         (defvar tek-mh-e-from-style tek-mh-e-from-styleorattribute
  114.           "\
  115. Style used for displaying From: fields in mail messages displayed
  116. by mh-e when attributes are used to mark buttons.")
  117.         
  118.         ;; Modify the variable used with add-button to be an attribute
  119.         (setq tek-mh-e-from-styleorattribute (reserve-attribute))
  120.         
  121.         ;;Bind the from-style to the from-attribute
  122.         (set-attribute-style tek-mh-e-from-styleorattribute
  123.                  tek-mh-e-from-style)
  124.  
  125.         (defvar tek-mh-e-subject-style tek-mh-e-subject-styleorattribute
  126.           "\
  127. Style used for displaying Subject: fields in mail messages displayed
  128. by mh-e when attributes are used to mark buttons.")
  129.  
  130.         ;; Modify the variable used with add-button to be an attribute
  131.         (setq tek-mh-e-subject-styleorattribute (reserve-attribute))
  132.  
  133.         ;;Bind the subject-style to the subject-attribute
  134.         (set-attribute-style tek-mh-e-subject-styleorattribute
  135.                  tek-mh-e-subject-style)
  136.         ))
  137.  
  138.  
  139.       (defun tek-mh-e-highlight ()
  140.     "\
  141. Highlight From: and Subject: fields in mail messages displayed by
  142. mh-e."
  143.     (let (
  144.           (starting-buffer (current-buffer))
  145.           )
  146.       (set-buffer mh-show-buffer)
  147.       (save-excursion
  148.         (clear-buttons)
  149.         (goto-char (point-min))
  150.         (if (re-search-forward "^From: \\(.*\\)" nil t)
  151.         (add-button (match-beginning 1) (match-end 1)
  152.                 tek-mh-e-from-styleorattribute))
  153.         (goto-char (point-min))
  154.         (if (re-search-forward "^Subject: \\(.*\\)" nil t)
  155.         (add-button (match-beginning 1) (match-end 1)
  156.                 tek-mh-e-subject-styleorattribute))
  157.         )
  158.       (set-buffer starting-buffer)))
  159.  
  160.  
  161.       ;; Set up the hook to run the highlighting function after displaying
  162.       ;; each message.
  163.       (postpend-unique-hook 'mh-Select-letter-hook 'tek-mh-e-highlight)
  164.       
  165.       )) ;; end: running-epoch test
  166.  
  167. (provide 'tek-mh-e-highlight)
  168.