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