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-gnus-highlight.el < prev    next >
Encoding:
Text File  |  1992-08-20  |  5.9 KB  |  170 lines
  1. ;;*****************************************************************************
  2. ;;
  3. ;; Filename:    tek-gnus-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. ;;
  24. ;; Description:    Highlight fields in articles displayed by the GNUS
  25. ;;        newsreader under epoch.
  26. ;;
  27. ;;        Button styles may be customised by means of X11 resources.
  28. ;;        The resource names to use are "gnus-from" and
  29. ;;        "gnus-subject". See the file tek-style-utils.el for details.
  30. ;;
  31. ;;        See the INSTALL file that comes with this package for
  32. ;;        installation details.
  33. ;;
  34. ;;*****************************************************************************
  35.  
  36. ;; $Id: tek-gnus-highlight.el,v 1.8 1992/08/18 04:13:31 rwhitby Rel $
  37.  
  38. (if (boundp 'epoch::version)
  39.     (progn
  40.       
  41.       (require 'tek-style-utils)
  42.  
  43.       (defvar tek-gnus-from-foreground "blue3"
  44.     "\
  45. Foreground color used to highlight From: fields in GNUS if no value is
  46. defined in the X11 resources and the display device supports color. On
  47. monochrome screens a different font is used in place of the different
  48. color.")
  49.  
  50.       (defvar tek-gnus-from-styleorattribute
  51.     ;; If the display supports multiple colors and a default color
  52.     ;; is specified, define the style to use a different color.
  53.     (if (and (> (number-of-colors) 2) tek-gnus-from-foreground)
  54.         (tek-build-style "gnus-from" nil nil
  55.                  tek-gnus-from-foreground (background)
  56.                  (background) (foreground))
  57.       ;; Otherwise, define the style to use a different font.
  58.       (tek-build-style "gnus-from" nil
  59.                (or tek-italic-bold-fixed-font
  60.                    tek-bold-fixed-font
  61.                    tek-italic-fixed-font)
  62.                (foreground) (background)
  63.                (background) (foreground)))
  64.     "\
  65. Style or attribute used to display From: fields in news articles
  66. displayed by GNUS.")
  67.  
  68.  
  69.       (defvar tek-gnus-subject-foreground "red3"
  70.     "\
  71. Foreground color used to highlight Subject: fields in GNUS if no value is
  72. defined in the X11 resources and the display device supports color. On
  73. monochrome screens a different font is used in place of the different
  74. color.")
  75.  
  76.       (defvar tek-gnus-subject-underline "red3"
  77.     "\
  78. Foreground color used to underline Subject: fields in GNUS if no value is
  79. defined in the X11 resources and the display device supports color. On
  80. monochrome screens a different font is used in place of the different
  81. color.")
  82.  
  83.       (defvar tek-gnus-subject-styleorattribute
  84.     ;; If the display supports multiple colors and a default color
  85.     ;; is specified, define the style to use a different color.
  86.     (if(and (> (number-of-colors) 2)
  87.         (or tek-gnus-subject-underline
  88.             tek-gnus-subject-foreground))
  89.         (tek-build-style "gnus-subject" nil nil
  90.                  tek-gnus-subject-foreground (background)
  91.                  (background) (foreground)
  92.                  tek-gnus-subject-underline)
  93.       (tek-build-style "gnus-subject" nil
  94.                (or tek-bold-fixed-font
  95.                    tek-italic-bold-fixed-font
  96.                    tek-italic-fixed-font)
  97.                (foreground) (background)
  98.                (background) (foreground)
  99.                (foreground)))
  100.     "\
  101. Style or attribute used to display Subject: fields in news articles
  102. displayed by GNUS.")
  103.  
  104.  
  105.       ;; Select V3 or V4 zone behaviour
  106.       (if tek-highlight-use-attributes
  107.       (progn
  108.         ;; Do things the old way - using attributes.
  109.       
  110.         (defvar tek-gnus-from-style tek-gnus-from-styleorattribute
  111.           "\
  112. Style used for displaying From: fields in news articles displayed
  113. by GNUS when attributes are used to mark zones.")
  114.  
  115.         ;; Modify the variable used with add-zone to be an attribute
  116.         (setq tek-gnus-from-styleorattribute (reserve-attribute))
  117.  
  118.         ;;Bind the from-style to the from-attribute
  119.         (set-attribute-style tek-gnus-from-styleorattribute
  120.                  tek-gnus-from-style)
  121.  
  122.         (defvar tek-gnus-subject-style tek-gnus-subject-styleorattribute
  123.           "\
  124. Style used for displaying Subject: fields in news articles displayed
  125. by GNUS when attributes are used to mark zones.")
  126.         
  127.         ;; Modify the variable used with add-zone to be an attribute
  128.         (setq tek-gnus-subject-styleorattribute (reserve-attribute))
  129.  
  130.         ;;Bind the subject-style to the subject-attribute
  131.         (set-attribute-style tek-gnus-subject-styleorattribute
  132.                  tek-gnus-subject-style)
  133.  
  134.         ))
  135.  
  136.  
  137.       ;; Define the highlighting function
  138.       (defun tek-article-highlight ()
  139.     "\
  140. Highlight From: and Subject: fields in news articles displayed by
  141. GNUS."
  142.     (let (
  143.           (starting-buffer (current-buffer))
  144.           )
  145.       (set-buffer gnus-Article-buffer)
  146.       (save-excursion
  147.         (clear-zones)
  148.         (goto-char (point-min))
  149.         (if (re-search-forward "^From: \\(.*\\)" nil t)
  150.         (add-zone (match-beginning 1) (match-end 1)
  151.                 tek-gnus-from-styleorattribute))
  152.         (goto-char (point-min))
  153.         (if (re-search-forward "^Subject: \\(.*\\)" nil t)
  154.         (add-zone (match-beginning 1) (match-end 1)
  155.                 tek-gnus-subject-styleorattribute))
  156.         )
  157.       (set-buffer starting-buffer)))
  158.  
  159.  
  160.       ;; Set up the hook to run the highlighting function after displaying
  161.       ;; each article. Have to explicitly set the variable to an assumed
  162.       ;; value, since the default GNUS setup doesn't initialise it to
  163.       ;; a proper list of hook functions.
  164.       (setq gnus-Select-article-hook (list 'gnus-Subject-show-thread
  165.                        'tek-article-highlight))
  166.       
  167.       )) ;; end: running-epoch test
  168.  
  169. (provide 'tek-gnus-highlight)
  170.