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-info-highlight.el < prev    next >
Encoding:
Text File  |  1992-08-20  |  4.5 KB  |  130 lines
  1. ;;*****************************************************************************
  2. ;;
  3. ;; Filename:    tek-info-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. ;; Original concept by:    David Carlton (carlton@linus.mitre.org or 
  25. ;;            carlton@husc9.harvard.edu).
  26. ;;
  27. ;; Description:    Epoch highlighting support for Dave Gillespie's "info-dg"
  28. ;;        info browser.
  29. ;;
  30. ;;        Button styles may be customised by means of X11 resources.
  31. ;;        The resource name to use is "info".
  32. ;;        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-info-highlight.el,v 1.7 1992/08/18 04:13:36 rwhitby Rel $
  40.  
  41. ;; Put the whole guts inside a test to get it to compile under emacs.
  42. (if (boundp 'epoch::version)
  43.     (progn
  44.       
  45.       (require 'tek-style-utils)
  46.  
  47.       ;; Regular expressions which should match all active areas in info
  48.       ;; pages.
  49.       (defvar tek-info-header-zone-regexp
  50.     "Up:\\|Next:\\|File:\\|Prev:\\|Previous:"
  51.     "Regexp used when searching the header for Info zones to highlight.")
  52.  
  53.       (defvar tek-info-zone-regexp
  54.     (format "\\*%s[ \n][^:]+::?\\|^\\* [^:]+::?" Info-footnote-tag)
  55.     "\
  56. Regexp used when searching for Info zones to highlight outside the header.")
  57.  
  58.       ;; Set up the highlighting attribute first
  59.       
  60.       (defvar tek-info-zone-foreground "blue"
  61.     "\
  62. Foreground color used for info zones if no value is defined in the
  63. X11 resources and the display device supports color. On monochrome
  64. screens a different font is used in place of the different color.")
  65.  
  66.       (defvar tek-info-zone-styleorattribute
  67.     ;; If the display supports multiple colors and a default color
  68.     ;; is specified, define the style to use a different color.
  69.     (if (and (> (number-of-colors) 2) tek-info-zone-foreground)
  70.         (tek-build-style "info" nil nil
  71.                  tek-info-zone-foreground (background)
  72.                  (background) (foreground))
  73.       ;; Otherwise, define the style to use a different font.
  74.       (tek-build-style "info" nil (or tek-bold-fixed-font
  75.                       tek-italic-bold-fixed-font
  76.                       tek-italic-fixed-font)
  77.                (foreground) (background)
  78.                (background) (foreground)))
  79.     "Style or attribute used to display characters in info zones.")
  80.  
  81.  
  82.       ;; Select V3 or V4 zone behaviour
  83.       (if tek-highlight-use-attributes
  84.       (progn
  85.         ;; Do things the old way
  86.       
  87.         (defvar tek-info-zone-style tek-info-zone-styleorattribute
  88.           "\
  89. Style used for displaying info zones when attributes are
  90. used to mark zones.")
  91.  
  92.         ;; Modify the variable used with add-zone to be an attribute
  93.         (setq tek-info-zone-styleorattribute (reserve-attribute))
  94.  
  95.         ;;Bind the info style to the info attribute
  96.         (set-attribute-style tek-info-zone-styleorattribute
  97.                  tek-info-zone-style)
  98.         ))
  99.  
  100.  
  101.       (defun tek-info-highlight ()
  102.     "Setup all zones in an info-node."
  103.     (clear-zones)
  104.     (save-excursion
  105.       ;; Set up header zones.
  106.       (goto-char (point-min))
  107.       (forward-line 1)
  108.       (let ((line2-start (point)))
  109.         (goto-char (point-min))
  110.         ;; Search for header zones will be bound by the start
  111.         ;; of the second line.
  112.         (while (re-search-forward tek-info-header-zone-regexp
  113.                       line2-start t)
  114.           (add-zone (match-beginning 0) (match-end 0)
  115.               tek-info-zone-styleorattribute)))
  116.       ;; Setup menu and cross-reference zones. Point should already
  117.       ;; be at the start of the second line in the buffer.
  118.       (while (re-search-forward tek-info-zone-regexp nil t)
  119.         (if (not (string-equal
  120.               (buffer-substring (match-beginning 0)
  121.                     (match-end 0))
  122.               "* Menu:"))
  123.         (add-zone (match-beginning 0) (match-end 0)
  124.                 tek-info-zone-styleorattribute)))))
  125.  
  126.       
  127.       )) ;; end: running-epoch test
  128.  
  129. (provide 'tek-info-highlight)
  130.