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-vm-highlight.el < prev    next >
Encoding:
Text File  |  1992-08-20  |  6.0 KB  |  166 lines
  1. ;;*****************************************************************************
  2. ;;
  3. ;; Filename:    tek-vm-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 messages displayed by the VM
  25. ;;        mailer under epoch.
  26. ;;
  27. ;;        Button styles may be customised by means of X11 resources.
  28. ;;        The resource names to use are "VM-from" and
  29. ;;        "VM-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-vm-highlight.el,v 1.8 1992/08/18 04:14:35 rwhitby Rel $
  37.  
  38. (if (boundp 'epoch::version)
  39.     (progn
  40.       
  41.       (require 'tek-style-utils)
  42.  
  43.       (defvar tek-vm-from-foreground "blue3"
  44.     "\
  45. Foreground color used to highlight From: fields in VM 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-vm-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-vm-from-foreground)
  54.         (tek-build-style "VM-from" nil nil
  55.                  tek-vm-from-foreground (background)
  56.                  (background) (foreground))
  57.       ;; Otherwise, define the style to use a different font.
  58.       (tek-build-style "VM-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 mail messages
  66. displayed by VM.")
  67.  
  68.  
  69.       (defvar tek-vm-subject-foreground "red3"
  70.     "\
  71. Foreground color used to highlight Subject: fields in VM 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-vm-subject-underline "red3"
  77.     "\
  78. Foreground color used to underline Subject: fields in VM 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-vm-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-vm-subject-underline
  88.             tek-vm-subject-foreground))
  89.         (tek-build-style "VM-subject" nil nil
  90.                  tek-vm-subject-foreground (background)
  91.                  (background) (foreground)
  92.                  tek-vm-subject-underline)
  93.       (tek-build-style "VM-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 mail messages
  102. displayed by VM.")
  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-vm-from-style tek-vm-from-styleorattribute
  111.           "\
  112. Style used for displaying From: fields in mail messages displayed
  113. by VM when attributes are used to mark zones.")
  114.  
  115.         ;; Modify the variable used with add-zone to be an attribute
  116.         (setq tek-vm-from-styleorattribute (reserve-attribute))
  117.  
  118.         ;;Bind the from-style to the from-attribute
  119.         (set-attribute-style tek-vm-from-styleorattribute
  120.                  tek-vm-from-style)
  121.  
  122.         (defvar tek-vm-subject-style tek-vm-subject-styleorattribute
  123.           "\
  124. Style used for displaying Subject: fields in mail messages displayed
  125. by VM when attributes are used to mark zones.")
  126.  
  127.         ;; Modify the variable used with add-zone to be an attribute
  128.         (setq tek-vm-subject-styleorattribute (reserve-attribute))
  129.  
  130.         ;;Bind the subject-style to the subject-attribute
  131.         (set-attribute-style tek-vm-subject-styleorattribute
  132.                  tek-vm-subject-style)
  133.         ))
  134.  
  135.  
  136.       ;; Define the highlighting function. Basically just redefine the
  137.       ;; standard VM function so it uses epoch zones.
  138.       (defun vm-highlight-headers (message window)
  139.     "\
  140. Highlight From: and Subject: fields in mail messages displayed by
  141. VM."
  142.     (let ((debug-on-error t))
  143.           (save-excursion
  144.            ;; As of v18.52, this call to save-window-excursion is needed!
  145.            ;; Somehow window point can get fouled in here, and drag the
  146.            ;; buffer point along with it.  This problem only manifests
  147.            ;; itself when operating VM from the summary buffer, subsequent
  148.            ;; to using vm-beginning-of-message or vm-end-of-message.
  149.            ;; After running a next or previous message command, point
  150.            ;; somehow ends up at the end of the message.
  151.           (save-window-excursion
  152.          (progn
  153.            (clear-zones)
  154.            (goto-char (point-min))
  155.            (if (re-search-forward "^From: \\(.*\\)" nil t)
  156.                (add-zone (match-beginning 1) (match-end 1)
  157.                    tek-vm-from-styleorattribute))
  158.            (goto-char (point-min))
  159.            (if (re-search-forward "^Subject: \\(.*\\)" nil t)
  160.                (add-zone (match-beginning 1) (match-end 1)
  161.                    tek-vm-subject-styleorattribute))
  162.            )))))
  163.       )) ;; end: running-epoch test
  164.  
  165. (provide 'tek-vm-highlight)
  166.