home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / epoch / tek-epoch-stuff / tek-mh-e-hilite.el < prev    next >
Encoding:
Text File  |  1991-12-11  |  5.7 KB  |  169 lines
  1. ;*****************************************************************************
  2. ;
  3. ; Filename:    tek-mh-e-hilite.el
  4. ;
  5. ; Copyright (C) 1991  Ken Wood
  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. ; Author:        Ken Wood, <kwood@austek.oz.au>
  22. ; Organisation:        Austek Microsystems Pty Ltd, Australia.
  23. ; Based on modifications to tek-gnus-hilite.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-hilite.el,v 1.3 1991/12/12 05:41:37 kwood Exp $
  40.  
  41. (provide 'tek-mh-e-hilite)
  42. (require 'epoch-running)
  43.  
  44. (if running-epoch
  45.     (progn
  46.       
  47.       (require 'tek-style-utils)
  48.  
  49.       (defvar tek-mh-e-from-foreground "blue3"
  50.     "\
  51. Foreground color used to highlight From: fields in mh-e if no value is
  52. defined in the X11 resources and the display device supports color. On
  53. monochrome screens a different font is used in place of the different
  54. color.")
  55.  
  56.       (defvar tek-mh-e-from-styleorattribute
  57.     ; If the display supports multiple colors and a default color
  58.     ; is specified, define the style to use a different color.
  59.     (if (and (> (number-of-colors) 2) tek-mh-e-from-foreground)
  60.         (tek-build-style "mh-e-from"
  61.                  nil nil
  62.                  tek-mh-e-from-foreground (background)
  63.                  (background) (foreground))
  64.       ; Otherwise, define the style to use a different font.
  65.       (tek-build-style "mh-e-from" nil (or tek-italic-bold-fixed-font
  66.                          tek-bold-fixed-font
  67.                          tek-italic-fixed-font)
  68.                (foreground) (background)
  69.                (background) (foreground)))
  70.     "\
  71. Style or attribute used to display From: fields in mail messages
  72. displayed by mh-e.")
  73.  
  74.  
  75.       (defvar tek-mh-e-subject-foreground "red3"
  76.     "\
  77. Foreground color used to highlight Subject: fields in mh-e if no value is
  78. defined in the X11 resources and the display device supports color. On
  79. monochrome screens a different font is used in place of the different
  80. color.")
  81.  
  82.       (defvar tek-mh-e-subject-underline "red3"
  83.     "\
  84. Foreground color used to underline Subject: fields in mh-e if no value is
  85. defined in the X11 resources and the display device supports color. On
  86. monochrome screens a different font is used in place of the different
  87. color.")
  88.  
  89.       (defvar tek-mh-e-subject-styleorattribute
  90.     ; If the display supports multiple colors and a default color
  91.     ; is specified, define the style to use a different color.
  92.     (if(and (> (number-of-colors) 2)
  93.         (or tek-mh-e-subject-underline
  94.             tek-mh-e-subject-foreground))
  95.         (tek-build-style "mh-e-subject" nil nil
  96.                  tek-mh-e-subject-foreground (background)
  97.                  (background) (foreground)
  98.                  tek-mh-e-subject-underline)
  99.       (tek-build-style "mh-e-subject" nil
  100.                (or tek-bold-fixed-font
  101.                    tek-italic-bold-fixed-font
  102.                    tek-italic-fixed-font)
  103.                (foreground) (background)
  104.                (background) (foreground)
  105.                (foreground)))
  106.     "\
  107. Style or attribute used to display Subject: fields in mail messages
  108. displayed by mh-e.")
  109.  
  110.  
  111.       ; Select V3 or V4 button behaviour
  112.       (if tek-highlight-use-attributes
  113.       (progn
  114.         ; Do things the old way - using attributes.
  115.       
  116.         (defvar tek-mh-e-from-style tek-mh-e-from-styleorattribute
  117.           "\
  118. Style used for displaying From: fields in mail messages displayed
  119. by mh-e when attributes are used to mark buttons.")
  120.         
  121.         ; Modify the variable used with add-button to be an attribute
  122.         (setq tek-mh-e-from-styleorattribute (reserve-attribute))
  123.         
  124.         ;Bind the from-style to the from-attribute
  125.         (set-attribute-style tek-mh-e-from-styleorattribute
  126.                  tek-mh-e-from-style)
  127.  
  128.         (defvar tek-mh-e-subject-style tek-mh-e-subject-styleorattribute
  129.           "\
  130. Style used for displaying Subject: fields in mail messages displayed
  131. by mh-e when attributes are used to mark buttons.")
  132.  
  133.         ; Modify the variable used with add-button to be an attribute
  134.         (setq tek-mh-e-subject-styleorattribute (reserve-attribute))
  135.  
  136.         ;Bind the subject-style to the subject-attribute
  137.         (set-attribute-style tek-mh-e-subject-styleorattribute
  138.                  tek-mh-e-subject-style)
  139.         ))
  140.  
  141.  
  142.       (defun tek-mh-e-hilight ()
  143.     "\
  144. Highlight From: and Subject: fields in mail messages displayed by
  145. mh-e."
  146.     (let (
  147.           (starting-buffer (current-buffer))
  148.           )
  149.       (set-buffer mh-show-buffer)
  150.       (save-excursion
  151.         (clear-buttons)
  152.         (goto-char (point-min))
  153.         (if (re-search-forward "^From: \\(.*\\)" nil t)
  154.         (add-button (match-beginning 1) (match-end 1)
  155.                 tek-mh-e-from-styleorattribute))
  156.         (goto-char (point-min))
  157.         (if (re-search-forward "^Subject: \\(.*\\)" nil t)
  158.         (add-button (match-beginning 1) (match-end 1)
  159.                 tek-mh-e-subject-styleorattribute))
  160.         )
  161.       (set-buffer starting-buffer)))
  162.  
  163.  
  164.       ; Set up the hook to run the highlighting function after displaying
  165.       ; each message.
  166.       (postpend-unique-hook 'mh-Select-letter-hook 'tek-mh-e-hilight)
  167.       
  168.       )) ; end: running-epoch test
  169.