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-vm-hilite.el < prev    next >
Encoding:
Text File  |  1991-11-20  |  6.0 KB  |  168 lines
  1. ;*****************************************************************************
  2. ;
  3. ; Filename:    tek-vm-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 messages displayed by the VM
  26. ;        mailer under epoch.
  27. ;
  28. ;        Button styles may be customised by means of X11 resources.
  29. ;        The resource names to use are "VM-from" and
  30. ;        "VM-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-vm-hilite.el,v 1.5 1991/11/21 02:56:58 kwood Exp $
  38.  
  39. (provide 'tek-vm-hilite)
  40. (require 'epoch-running)
  41.  
  42. (if running-epoch
  43.     (progn
  44.       
  45.       (require 'tek-style-utils)
  46.  
  47.       (defvar tek-vm-from-foreground "blue3"
  48.     "\
  49. Foreground color used to highlight From: fields in VM 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-vm-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-vm-from-foreground)
  58.         (tek-build-style "VM-from"
  59.                  nil nil
  60.                  tek-vm-from-foreground (background)
  61.                  (background) (foreground))
  62.       ; Otherwise, define the style to use a different font.
  63.       (tek-build-style "VM-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 mail messages
  70. displayed by VM.")
  71.  
  72.  
  73.       (defvar tek-vm-subject-foreground "red3"
  74.     "\
  75. Foreground color used to highlight Subject: fields in VM 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-vm-subject-underline "red3"
  81.     "\
  82. Foreground color used to underline Subject: fields in VM 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-vm-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-vm-subject-underline
  92.             tek-vm-subject-foreground))
  93.         (tek-build-style "VM-subject" nil nil
  94.                  tek-vm-subject-foreground (background)
  95.                  (background) (foreground)
  96.                  tek-vm-subject-underline)
  97.       (tek-build-style "VM-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 mail messages
  106. displayed by VM.")
  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-vm-from-style tek-vm-from-styleorattribute
  115.           "\
  116. Style used for displaying From: fields in mail messages displayed
  117. by VM when attributes are used to mark buttons.")
  118.  
  119.         ; Modify the variable used with add-button to be an attribute
  120.         (setq tek-vm-from-styleorattribute (reserve-attribute))
  121.  
  122.         ;Bind the from-style to the from-attribute
  123.         (set-attribute-style tek-vm-from-styleorattribute
  124.                  tek-vm-from-style)
  125.  
  126.         (defvar tek-vm-subject-style tek-vm-subject-styleorattribute
  127.           "\
  128. Style used for displaying Subject: fields in mail messages displayed
  129. by VM when attributes are used to mark buttons.")
  130.  
  131.         ; Modify the variable used with add-button to be an attribute
  132.         (setq tek-vm-subject-styleorattribute (reserve-attribute))
  133.  
  134.         ;Bind the subject-style to the subject-attribute
  135.         (set-attribute-style tek-vm-subject-styleorattribute
  136.                  tek-vm-subject-style)
  137.         ))
  138.  
  139.  
  140.       ; Define the highlighting function. Basically just redefine the
  141.       ; standard VM function so it uses epoch buttons.
  142.       (defun vm-highlight-headers (message window)
  143.     "\
  144. Highlight From: and Subject: fields in mail messages displayed by
  145. VM."
  146.     (let ((debug-on-error t))
  147.           (save-excursion
  148.            ;; As of v18.52, this call to save-window-excursion is needed!
  149.            ;; Somehow window point can get fouled in here, and drag the
  150.            ;; buffer point along with it.  This problem only manifests
  151.            ;; itself when operating VM from the summary buffer, subsequent
  152.            ;; to using vm-beginning-of-message or vm-end-of-message.
  153.            ;; After running a next or previous message command, point
  154.            ;; somehow ends up at the end of the message.
  155.           (save-window-excursion
  156.          (progn
  157.            (clear-buttons)
  158.            (goto-char (point-min))
  159.            (if (re-search-forward "^From: \\(.*\\)" nil t)
  160.                (add-button (match-beginning 1) (match-end 1)
  161.                    tek-vm-from-styleorattribute))
  162.            (goto-char (point-min))
  163.            (if (re-search-forward "^Subject: \\(.*\\)" nil t)
  164.                (add-button (match-beginning 1) (match-end 1)
  165.                    tek-vm-subject-styleorattribute))
  166.            )))))
  167.       )) ; end: running-epoch test
  168.